Why is it that wrong return for bst scheme - scheme

I want to create a bst, but my result always get root and null, I can not find a reason, need help, thanks
like so
(struct tree-node (val left right) #:transparent)
(define (tree-add tree value)
(if (null? tree)
(tree-node value null null)
(let ([x (tree-node-val tree)])
(cond
[(= value x) tree]
[(< value x)
(tree-add (tree-node-left tree) value)]
[(> value x)
(tree-add (tree-node-right tree) value)])
tree)))

Test your code with some numbers and see, what kind of result is returned. Your code returns:
tree if the inserted number is equal to (tree-node-val tree)
(tree-node value null null) if the inserted number wasn't in the tree
But you probably want to return the full structure, with the new number inserted. So, in each recursive step, you have to create tree-node, which will have the same values as the current node:
(tree-node (tree-node-val tree)
(tree-node-left tree)
(tree-node-right tree))
, but its left/right node will be different (the following code is for situation, when you insert a number into a left node of the tree):
(tree-node (tree-node-val tree)
(tree-add (tree-node-left tree) value)
(tree-node-right tree))
Full code:
(struct tree-node (val left right) #:transparent)
(define (tree-add tree value)
(if (null? tree)
(tree-node value null null)
(let ([x (tree-node-val tree)])
(cond
[(= value x) tree]
[(< value x)
(tree-node x
(tree-add (tree-node-left tree) value)
(tree-node-right tree))]
[(> value x)
(tree-node x
(tree-node-left tree)
(tree-add (tree-node-right tree) value))]))))
Examples:
> (tree-add (tree-add (tree-add (tree-add '() 3) 4) 2) 1)
(tree-node 3 (tree-node 2 (tree-node 1 '() '()) '()) (tree-node 4 '() '()))
> (foldl (lambda (n tree) (tree-add tree n))
'() '(3 1 2 4 5))
(tree-node
3
(tree-node 1 '() (tree-node 2 '() '()))
(tree-node 4 '() (tree-node 5 '() '())))

Related

When I doing tree-depth function, it got a mistake

I got a error, when I run it always say:
tree-node-left: contract violation
expected: tree-node?
given: '()
(struct tree-node (val left right) #:transparent)
(define (tree-depth tree)
(if (empty-tree? tree) 0
(+ 1 (max (tree-depth (tree-node-left tree))
(tree-depth (tree-node-right tree))))))
For context, this question is follow-up of: Why is it that wrong return for bst scheme
If you don't have to use (struct empty-tree () #:transparent), I would represent an empty tree as an empty list, as I already did in the previous answer. With that, you can rewrite tree-depth this way:
(define (tree-depth tree)
(if (empty? tree) 0
(add1 (max (tree-depth (tree-node-left tree))
(tree-depth (tree-node-right tree))))))
Test:
> (tree-depth (tree-add (tree-add (tree-add (tree-add '() 3) 4) 2) 1))
3
> (tree-depth (tree-add '() 3))
1
If you do want to use the empty-tree type, use that and not the empty list in your tree:
(define (leaf v) (tree-node v (empty-tree) (empty-tree)))
(define a-tree
(tree-node 3 (tree-node 2 (leaf 1) (empty-tree))
(leaf 4)))
> (tree-depth a-tree)
3

AVL trees in scheme

I'm trying to implement an AVL tree in Scheme. My approach to this task was to initially make an initial tree representation and progressively implement AVL properties after completing so. I've tried to implement it as such and it won't work because I keep getting an undefined identifier error for both my rotation and deletion functions. Could anyone help me decipher this or aid in my implementation of an AVL tree? My code is as follows:
(define (make-tree value left right)
(list value left right))
(define (key tree)
(car tree))
(define (left-tree tree)
(cadr tree))
(define (right-tree tree)
(caddr tree))
(define (make-leaf key) (list key '() '()))
(define (empty-tree) '())
(define (isEmpty? tree)
(null? tree))
(define (size tree)
(cond ((isEmpty? tree) 0)
(else (+ 1 (size (left-tree tree))
(size (right-tree tree))))))
(define (height tree)
(cond ((isEmpty? tree) 0)
(else (+ 1 (max (height (right-tree tree))
(height (left-tree tree)))))))
(define (isValid? val left-tree right-tree)
(and (>= val left-tree)
(< val right-tree)))
(define (isLeaf? tree)
(and (isEmpty? (left-tree tree))
(isEmpty? (right-tree tree))))
(define (delete tree val)
(cond ((isEmpty? tree) (empty-tree))
((= val (key tree)) (remove-root tree))
((< val (key tree))
(make-tree (key tree) (delete (left tree) val) (right tree)))
((> val (val tree)) (make-tree (key tree)
(right tree)
(delete (right tree) val)))))
(define (delete-root tree)
(cond ((isLeaf? tree) (empty-tree))
; If one child exists then return that child and its descendants
((isEmpty? (left tree)) (right tree))
((isEmpty? (right tree)) (left tree))
;Two children exists
(else (let* ((new-value (key (leftmost-child (right tree))))
(new-right-tree (delete (right tree) new-value)))
(make-tree new-value (left-tree tree) new-right-tree)))))
;Inserts a value into a tree
;Does not obey AVL properties
(define (insert value tree)
(cond ((isEmpty? tree) (list value () ()))
((= value (key tree)) tree) ;Value is in tree
((< value (key tree))
(list (key tree) (insert value (left-tree tree)) (right-tree tree)))
(else (list (key tree) (left-tree tree) (insert value (right-tree tree))))))
;Returns the leftmost-child of an input tree
(define (leftmost-child tree)
(cond ((isEmpty? tree) empty-tree)
((isEmpty? (left-tree tree)) tree)
(else (leftmost-child (left-tree tree)))))
;Makes a tree from an input list
(define (list-to-tree list-in)
(define (list-to-tree-helper list-in tree)
(cond ((null? list-in) tree)
(else (list-to-tree-helper (cdr list-in)
(insert (car list-in) tree)))))
(list-to-tree-helper list-in ()))
;Checks if the heights of the left and right subtrees are equal
(define (isBalanced? tree)
(cond ((isEmpty? tree) #t)
(else (and (= (height (left-tree tree))
(height (right-tree tree)))
(= (isBalanced? (left-tree tree))
(isBalanced? (right-tree tree)))))))
;left rotation
(define (rotate-left tree)
(cond ((isEmpty? tree) tree)
(else (make-tree (key tree)
(left (left tree))
(make-tree (key tree) (right (left tree) (right tree))))))
;right rotation
(define (rotate-right tree)
(cond ((isEmpty? tree) tree)
(else (make-tree (key (right tree))
(make-tree (key tree) (left tree) (left (right tree)))
(right (right tree))))))
;right-left
(define (rotate-right-left tree)
(cond ((isEmpty? tree) tree)
(else (make-tree (key (left (right tree)))
(make-tree (key tree) (left tree) (left (left (right tree))))
(make-tree (key (right tree)) (right (left (right tree))) (right (right tree)))))))
;left-right
(define (rotate-left-right tree)
(cond ((isEmpty? tree) tree)
(else (make-tree (key (right (left tree)))
(make-tree (key (left tree)) (left (left tree)) (left (right (left tree))))
(make-tree (key tree) (right (right (left tree))) (right tree))))))
;Avl-tree factor
(define (avl-factor tree)
(- (height (left tree)) (height (right tree))))
;Balance tree according to avl tree properties:
;|h_l - h_r| = -2 < h < 2
(define (avl-balance tree)
(let ((factor (avl-factor tree)))
(cond ((= factor -2)
;left tree is bigger
(cond ((> (factor (left tree)) 0) (rotate-left-right tree))
(else (rotate-left tree))))
((= factor 2)
;right tree is bigger
(cond ((< (factor (right tree)) 0) (rotate-right-left tree))
(else (rotate-right tree))))
(else tree))))
;(list-to-tree '(4 2 6 8 1 7))
;(define my-tree (make-tree 5 () () ))
(define my-tree (list-to-tree '(4 2 6 8 1 7)))
(isEmpty? my-tree)
(size my-tree)
(height my-tree)
(isLeaf? my-tree)
;Does not work
;(delete 6 my-tree)
;(delete 4 my-tree)
;(delete 7 my-tree)
;does not work
;(delete-root my-tree)
(leftmost-child my-tree)
(rotate-right my-tree)

CPSed binary tree traversal doesn't work as expected

My recursive version looks like
(struct node (val left right) #:transparent)
(define t3 (node 3 '() '()))
(define t4 (node 4 '() '()))
(define t5 (node 5 '() '()))
(define t2 (node 2 t4 t5))
(define t1 (node 1 t2 t3))
;
; ----- 1 -----
; | |
; -- 2 -- 3
;| |
;4 5
(define (countv tree)
(if (null? tree)
0
(+ (node-val tree)
(countv (node-left tree))
(countv (node-right tree)))))
(countv t1)
And CPSed version
(define (countk tree k)
(if (null? tree)
(k 0)
(countk (node-left tree)
(λ (lval)
(countk (node-right tree)
(λ (rval)
(+ (node-val tree) lval rval)))))))
(countk t1 (λ (x) (node-val x)))
The result of countv was 15 as expected, while countk got 4.
You forgot to pass the recursive result to the continuation:
(define (countk tree k)
(if (null? tree)
(k 0)
(countk (node-left tree)
(λ (lval)
(countk (node-right tree)
(λ (rval)
(k (+ (node-val tree) lval rval))))))))
^
Here
Once you remember that, you'll get a runtime error since the result isn't a tree.
This didn't happen in your code because your initial continuation was never applied to anything.
You should call it like this instead:
(countk t1 (λ (x) x))

Scheme remove left and right children if they are null

I am trying to write scheme code (DrRaket or MIT) that remove left and right children if they are null.
;;definition of make-tree;;
(define (make-tree entry left right)
(list entry left right))
;;input tree;;
(define tree (8 (5 (2 () ()) (4 () ())) (3 () (10 () ()))))
if I do (print tree) suppose to change the input tree to
;;expected output;;
(8 (5 (2)(4)) (3 () (10)))
;;
(define (print tree)
(cond ((and (null? (cadr tree)) (null? (caddr tree)))
(cons (car tree) '())
(make-tree (car tree) (cadr tree) (caddr tree))
(print tree)
)))
But I get linefeed after attempting (print tree). Could someone help me get the expected output?
In reply to soegaard 33's solution
(define (prune tree)
(cond tree
((list x '() '()) (list x))
((list x left '()) (list (prune left) (list x)))
((list x '() right) (list (list x) (prune right)))
((list x left right) (make-tree x (prune left) (prune right)))))
Output
Welcome to DrRacket, version 6.1.1 [3m].
Language: R5RS; memory limit: 128 MB.
. tree: bad syntax in: tree
>
This solution uses match from Racket.
(define (prune tree)
(match tree
[(list x '() '()) (list x)]
[(list x left '()) (list (prune left) (list x))]
[(list x '() right) (list (list x) (prune right))]
[(list x left right) (make-tree x (prune left) (prune right))]))
The tree has four different shapes.
Each clause handles a different shape.
If you can't use match change it to a cond with four cases.
Update:
(match tree
((list x '() '()) (list x))
...
...)
becomes
(cond
((and (list? tree)
(null? (cadr tree)) ; the second element is '()
(null? (caddr tree))) ; the third element is '()
(list x))
...
...)

count duplicate value in a tree scheme

i'm attempting to count duplicate in a tree. i'm attaching a picture for a better illustration. I'm on the wrong track i have no where to go.
Here is what i did
(define (arbre-insere valeur arbre)
(cond ((null? arbre) (list (cons valeur 1) '() '()))
((< valeur(car arbre))
(list (cons (car arbre) count)
(arbre-insere valeur (cadr arbre))
(caddr arbre)))
(> valeur(car arbre) (list cons ((car arbre) count) (cadr arbre)
(arbre-insere valeur (caddr arbre) )))
(else
)
))][1]
Here is a sketch, where ... and stuff in <...> is meant to be filled out by you.
(define leaf '())
; leaf? : tree -> boolean
; return #t if the tree is a leaf,
; #f otherwise
(define (leaf? tree)
(null? leaf?))
; value : tree -> element
; return the root element of the tree
(define (value tree)
...)
; count : tree -> integer
; return the count of the root element of tree
(define (count tree)
...)
; left : tree -> tree
; return the left subtree of tree
(define (left tree)
...)
; right : tree -> tree
; return the right subtree of tree
(define (right tree)
...)
; make-node : value integer tree tree
; construct tree from a value and count,
; left is a tree whose elements are smaller than value
; right is a tree whose elements are greater than value
(define (make-node value count left right)
(list left (cons value count) right))
; tree-insert : value tree -> tree
(define (tree-insert v t)
(cond
[(leaf? t) (make-tree v 1 leaf leaf)]
[(= v (value t)) (make-tree v <old-count+1> (left t) (right t))]
[(< v (value t)) (make-tree v (make-node (value t) (count t)
(insert-tree v (left t)) r))]
[(> v (value t)) <???>]
[else (error 'tree-insert "an unexpected error occurred")]))

Resources