car: contract violation expected: pair? given: () during remove in binary search tree - scheme

I don't understand how I am getting a contract violation. It seems when I create a bst it doesnt make 2 empty lists it just has ().
This is my remove method:
;Returns the binary search tree representing bst after removing x where f and g are predicates as defined in bst-contains.
(define (bst-remove bst f g x)
;if empty return empty
(cond ((empty? bst) (bst-create-empty)))
;else if equal then check right if right is empty then pull from left
(cond ((g (car bst) x) (cond ((empty? (caddr bst)) (cond ((empty? (cadr bst)) (bst-create-empty))
(else (car(cadr bst)))))
;if right isnt empty then remove from left
(else(bst-create (bst-max-right (caddr bst)) (cadr bst) (bst-remove (caddr bst) f g (bst-max-right (caddr bst)))))))
(else (bst-create (car bst) (bst-remove (cadr bst) f g x) (bst-remove (caddr bst) f g x)))))
My bst-create and bst-create-empty:
;Returns an empty binary search tree.
(define (bst-create-empty)
'())
;Returns a binary search tree having the specified root value, with left-subtree left and right-subtree right.
(define (bst-create root left right)
(list root left right))
The code I give it is
(bst-remove (bst-create 5 (bst-create 6 (bst-create-empty) (bst-create-empty)) (bst-create 4 (bst-create-empty) (bst-create-empty))) < = 6)
The error i get is car: contract violation expected: pair? given: ()

You have got Scheme and especially cond all wrong. If you in a body of a procedure have two statements like:
(define (test lst)
first-expression
tail-expression)
It is obvious that the tail-expression will follow the evaluation and discarding of any result of the first-expression. Also unless first-expression has side effects it is dead code. Your cond expressions (cond ((empty? bst) (bst-create-empty))) is dead code since no matter what the outcome is it will never be a part of the result since Scheme will evaluate the second cond unconditionally. It does (car bst) which throws the error.
The correct way to have multiple returns are by one expression:
(cond
(test1 consequent1)
(test2 consequent2)
(test3 consequent3)
(else alternative))
Needless to say all the previous tests are negative so if test3 is true, then you know that test1 and test2 both had negative results. You also know that if consequent1 is evaluated no other terms or tests gets evaluated. It stops at the first prositive.
In you specific case the code could have looked like this:
(define (bst-remove bst f g x)
(cond ((empty? bst)
(bst-create-empty))
((not (g (car bst) x))
(bst-create (car bst) (bst-remove (cadr bst) f g x) (bst-remove (caddr bst) f g x)))
((not (empty? (caddr bst)))
(bst-create (bst-max-right (caddr bst)) (cadr bst) (bst-remove (caddr bst) f g (bst-max-right (caddr bst)))))
((empty? (cadr bst))
(bst-create-empty))
(else
(caadr bst))))
Using nested if works too, but it makes harder to read code just like your nested cond. Notice that I negated some of the tests since they only have one alternative but several tests in its consequent. By negating I could have one consequent and continue testing for the other cases in the same cond.

You refer to your second cond as an else if in your comment, but it's not an else-if, it's just an if. That is, you check the second condition even if the first one was true, in which case the car part of the condition causes this error.
To fix this, you should make both conditions part of a single cond, in which case it will actually act like an else if.

It looks like you've misunderstood cond, or possibly Scheme in general.
The result of a function application is the value of the last expression in the function's body (the only reason for having more than one is if you're doing something that has a side effect), and cond expressions are evaluated in exactly the same way as other Scheme expressions.
So the expression (cond ((empty? bst) (bst-create-empty))) does not return an empty tree, it is evaluated and produces an empty tree, and that tree is discarded.
Then evaluation continues with the next cond, which is a bad idea when the tree is empty.
A further problem is that the function should produce a tree, but (car (cadr bst)) wouldn't.
If you define a few useful accessor functions:
(define bst-value car)
(define bst-left cadr)
(define bst-right caddr)
then these lines are more obviously wrong:
(cond ((empty? (bst-left bst)) (bst-create-empty))
(else (bst-value (bst-left bst)))))
Fixing it, it becomes (reasonably) clear that the entire expression
(cond ((empty? (bst-left bst)) (bst-create-empty))
(else (bst-left bst))))
is equivalent to
(bst-left bst)
Now you have
(cond ((empty? (bst-right bst)) (bst-left bst))
( else make a tree...
But there's a lack of symmetry here; surely, if the left subtree is empty, the result should be the entire right subtree in a similar way.
So,
(cond ((empty? (bst-right bst)) (bst-left bst))
(empty? (bst-left bst)) (bst-right bst))
( else make a tree...
But now we can spot another problem: even in these cases, we need to recurse into the subtrees before we're done.
I'll digress here because too many accessor repetitions and conds makes code pretty unreadable.
Using a couple of lets (and getting rid of the unused f parameter), I ended up with this:
(define (bst-remove tree g x)
(if (empty? tree)
(bst-create-empty)
;; If the tree isn't empty, we need to recurse.
;; This work is identical for all the cases below, so
;; lift it up here.
(let ([new-left (bst-remove (bst-left tree) g x)]
[new-right (bst-remove (bst-right tree) g x)])
;; Build an appropriate tree with the new subtrees.
(if (g (bst-value tree) x)
(cond [(empty? new-left) new-right] ;; If either new subtree is empty,
[(empty? new-right) new-left] ;; use the other.
;; The complicated case. Get the new node value from the
;; right subtree and remove it from there before using it.
[else (let ([new-value (bst-max-right new-right)])
(bst-create new-value
new-left
(bst-remove new-right g new-value)))])
;; The straightforward case.
(bst-create (bst-value tree)
new-left
new-right)))))

Related

Scheme Binary Search Tree Adding Elements

To begin, I wanted to write a function that:
Takes in:
A list of natural numbers, (list 2 6 1 23...) that could have repeating elements called "lst"
A random binary search tree called "bst"
Outputs:
An updated binary tree that adds every number on the list to it
Code
(define (recurse-lst bst lst)
(cond [(empty? roster) empty]
[(empty? lst) empty]
[else (recurse-lst (bst-add bst (first lst)) (rest lst))]))
; helper function
(define (bst-add bst sublst)
(cond [(empty? bst) (make-node (first sublst) empty empty)]
[(< (first sublst) (node-key bst))
(make-node (node-key bst)
(bst-add (node-left bst) (first sublst))
(node-right bst))]
[else
(make-node (node-key bst) (node-left bst)
(bst-add (node-right bst) (first sublst)))]))
Problem
I'm currently trying to get this working for nested lists; for example (list (list 1) (list 2)...), with each sub-list only having one element in them. However, it seems that it does not work and (first sublst) in bst-add turns the sublst into a number, like (first 1).
I think I've had similar bugs in other pieces of code before, but I cannot recall when and what it was.
right now you have
(define (recurse-lst bst lst)
(cond [(empty? roster)
....
"lst".
"roster".
you need always to include your error messages in the posts on SO.
next. you call (bst-add bst (first lst)) so the second argument in that call is already a number. yet in the definition of bst-add you name second parameter as "sublst" and treat it as a list. no need to take first again. and in fact taking first of a number is an error.

how do you sum tree in scheme

;; A [BT X] is one of
;; - 'leaf
;; - (make-node X [BT X] [BT X])
(define-struct node (val left right))
;; interpretation: represents a node with a value
;; a left and right subtree
(define (tree-sum tree)
(cond
[(symbol=? tree 'leaf) ...] ;; the value remains same
[(node? tree)
(+ (tree-sum (node-val tree))
(tree-sum (node-left tree))
(tree-sum (node-right tree)))]))
not quite sure if i'm on the right track.
Normally, A pair tree is either
a leaf (not a pair), or
a pair, whose car and cdr values are pair-trees.
recursive summing procedure will have to deal with these two cases:
a numbers, i.e., leaves of a tree of numbers, and
pairs, in which case it should sum the left and right subtrees, and add those sums together.
Therefore,
(define (pair-tree-sum pair-tree)
(cond
[(number? pair-tree)
pair-tree]
[else
(+ (pair-tree-sum (car pair-tree))
(pair-tree-sum (cdr pair-tree)))]))
You can split the function into two parts - one that converts the tree into a list of numbers, and another that just uses foldl with that list, and foldl has the advantage of automatically doing the summation as an accumulator.
(define (tree->list tree)
(if (pair? tree)
(append (tree->list (car tree))
(tree->list (cdr tree)))
(list tree)))
(define (tree-sum tree)
(foldl + 0 (tree->list tree)))
You first need to check if the tree is empty, then if its not a list, else you call the function sum to the car of the list, and add to the cdr of the list.
(define (sum tree)
(cond [(empty? tree) 0]
[(not (list? tree)) (if (number? tree) tree 0)]
[else (+ (sum (first tree)) (sum (rest tree)))]))

Scheme - How do I get each list in a list that's not made up of more lists

(define (walk-list lst fun) ;;walk-list(list, fun)
(if (not(null? lst)) ;;IF the list isn't NULL
(begin
(if (list? lst) ;;&& the list is actually a list , THEN{
(begin
(if (equal? (car lst) '()) ;;IF the first element in the list is empty
(fun lst) ;;THEN call the function on the list (funct is supose to get each word)
(if (not (null? lst)) ;;ELSE IF the first item isn't a list
(begin ;;{
(walk-list (car lst) fun) ;;walk-list((car lst),fun)
(walk-list (cdr lst) fun))))))))) ;;walk-list((cdr lst),fun)
(walk-list test-document display) ;;walk through the list with the given document
The will look something like this:
(define test-document '(
((h e l l o));;paragraph1
((t h i s)(i s)(t e s t));;paragraph2
))
I'm trying to get each individual word into the document have a function applied to it. Where is says (fun list). But the function is never called.
First off. begin is if you need to do more than one expression. The first expression then needs to have side effects or else it's just a waste of processing power.
Ie.
(begin
(display "hello") ; display is a side effect
(something-else))
When you don't have more than one expression begin isn't needed. if has 3 parts. They are:
(if predicate-expression ; turnas into something true or #f (the only false value)
consequent-expression ; when predicate-expression evalautes to anything but #f
alternative-expression) ; when predicate-expression evaluates to #f this is done
You should ident your code properly. Here is the code idented with DrRacket IDE, with reduncant begin removed and missing alternative-expressions added so you see where they return:
(define (walk-list lst fun) ;;walk-list(list, fun)
(if (not (null? lst)) ;;IF the list isn't NULL
(if (list? lst) ;; && the list is actually a list , THEN{
(if (equal? (car lst) '()) ;; IF the first element in the list is empty
(fun lst) ;; THEN call the function on the list (funct is supose to get each word)
(if (not (null? lst)) ;; ELSE IF the first item isn't a list
(begin ;; Here begin is needed
(walk-list (car lst) fun) ;; walk-list((car lst),fun)
(walk-list (cdr lst) fun)) ;; walk-list((cdr lst),fun)
'undfined-return-1)) ;; stop recursion, return undefined value
'undefined-return-2) ;; stop recursion, return undefined value
'undefined-return-3)) ;; stop recursion, return undefined value
So when does (fun lst) get called? Never! There is no () in any car in (((h e l l o))((t h i s) (i s) (t e s t))) and (equal? (car lst) '()) which is (null? (car lst)) will always be #f. Since we know (not (null? lst)) is #t so it will walk car and cdr where either 'undefined-return-2 or 'undefined-return-3 will be evaluated and the procedure stops when everything is visited and nothing processed.
You haven't shown what (walk-list test-document display) should have displayed but I make a wild guess that you want it for every element except pairs and null, thus I would have written this like this:
(accumulate-tree test-document display (lambda (a d) 'return) '())
accumulate-tree you'll find in this SICP handout. It demonstrates many uses for it as well. For completeness I'll supply it here:
(define (accumulate-tree tree term combiner null-value)
(cond ((null? tree) null-value)
((not (pair? tree)) (term tree))
(else (combiner
(accumulate-tree (car tree)
term
combiner
null-value)
(accumulate-tree (cdr tree)
term
combiner
null-value)))))
Judging from you code you are an Algol programmer learning your first Lisp. I advice you to look at the SICP videoes and book.

How do I ensure the empty list isn't printed (Scheme)?

I have this code:
(define graph `(A (B (C)) (D (E)) (C (E))))
(define (prog1 graph)
(let ([seen `()])
(define (sub g)
(cond
[(member (car g) seen) `()]
[else
(set! seen (cons (car g) seen))
(cond
[(null? (cdr g)) (list (car g))]
[else
(cons (car g) (map sub (cdr g)))])]))
(sub graph)))
It prints a connected graph where all the nodes appear once. However, if a node has already been visited I return the empty list `(). This causes a problem with the output and I don't know how to fix it:
When running (prog1 graph) The current output is: (A (B (C)) (D (E)) ())
However, I want the output to be (A (B (C)) (D (E)))
Any hint on how I can modify the code to achieve this would be great.
If the empty lists only occur at the topmost level in the list, you could filter them out. Replace the last line in your procedure with this:
(filter (negate null?) (sub graph))
Or simply this:
(remove '() (sub graph))
If the empty lists occur at any nesting level, you can apply the same idea (filtering out empty lists) recursively, at each step in the traversal.

Deleting an element from a BST in scheme

I can't seem to figure out how to delete an element from the BST. This is my code
(define remove (lambda (x t)
(if (< x (car t)) (list (car t) (remove x (cadr t)) (caddr t))
(if (> x (car t)) (list (car t) (cadr t) (remove x (caddr t)))
(if (not(and (null? (cadr t)) (null? (caddr t))))
(let ((r (minimum (caddr t)))) ((remove r t) (set-car! t r)))
(list '() (cadr t) (caddr t)))))))
Minimum returns the minimum value in the tree.
If I try to delete an element that's not a leaf, it goes into an infinite loop. How can I fix it?
I think your biggest problem lies in this section:
((remove r t) (set-car! t r))
You are removing r from t, but you should really be removing r from the right subtree of t. I'm not sure why you are using mutability/setting, either; I think it complicates things in what could easily be a non-side effecting function. I would try something like:
(list r (cadr t) (remove r (caddr t)))
I also have to admit that I'm a bit confused about your intent with the last line. What are you using the empty list for?
As an alternative, you can take a look here for the whole implementation of BST in scheme:
http://en.literateprograms.org/Binary_tree_(Scheme)
It is very well documented and would give you a bit of insight about the way you can structure the code to be easy to read and debug. Especially, it treats leaf and node (non-leaf) removals separately.

Resources