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
Related
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 '() '())))
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)
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))
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))
...
...)
I get NZEC with the following code for INVCNT
; for lists of length > 2 inversions are the same as the number of elements
; against which the first is greater + the inversions of the remaining
(define (inversions l)
(cond ((< (length l) 2) 0)
(else (+ (length (filter (lambda (x) (> (car l) x)) (cdr l)))
(inversions (cdr l))))))
(use-modules (ice-9 rdelim))
(define (call-n-times proc n)
(if (= 0 n)
'()
(cons (proc) (call-n-times proc (- n 1)))))
(define (solve)
(write-line (inversions (call-n-times read (read)))))
(call-n-times solve (read))
Any hints, please?
Filtering accross a very long list can run you into the maximum recusion error (specs say up to ten million) Instead of using '(length (filter ...' use a fold
(define (inversion L)
(let loop ((accumulator 0) (L L))
(if (null? L)
accumulator
(loop
(+ accumulator
(fold
(lambda (init next)
(if (> (car l) next)
(+ init 1)
init))
0
(cdr L)))
(cdr L)))))
Second though this would be easier to read pulling out that fold into it's own function
(define (inversions-from-car L)
(fold
(lambda (init next)
(if (> (car l) next)
(+ init 1)
init))
0
(cdr L)))
(define (inversion L)
(let loop ((accumulator 0) (L L))
(if (null? L)
accumulator
(loop
(+ accumulator
(inversions-from-car L)
(cdr L)))))
This looks like a good problem to play with data structures, because as written, it's n^2 complexity.
I think you can get it down to n(log n)
Say create a sorted tree on the list of value paired with the # of nodes to the left.
for this set
'(2 3 8 6 1) -> '(1 2 3 6 8) ->
(*tree (*entry 3 2 2)
(*tree (*entry 2 1 1)
(*tree (*entry 1 0 1)
()
())
())
(*tree (*entry 8 1 1)
(*tree (*entry 6 0 1)
()
())
()))
*tree and *entry are just type-tage
*tree should have an entry, a left and a right
*entry should have a value, #left, and number)
Start by finding the the FIRST in the orginal list with a zero accumulator
'(2 3 8 6 1)
If the value of the enrty matched to FIRST, add #left to the accumulator
If the value is entry is more than FIRST recurse on the left branch of the tree with accumulator
If the value of the entry is less then FIRST , recurse on the right branch with #left added to the accumulator
If it's a null-tree throw an error
Then you need to update the tree.
If the value of the entry equal to FIRST, mutate the entry to reduce the number by one
If the value is entry is more then FIRST, mutate the entry toreduce #left by one and recurse on the left branch
If the value of the entry is less than first , recurse on the right branch
If it's a null-tree throw an error
You can combine these rules into a single traversal
Additionally add the rule that if #left is 0 and number is zero, then if the right branch is null mutate this tree to the empty-tree else the right-branch.
Here's a rough (untested version of the idea)
(define (rev-sorted-list->count-list L) ;;sort should be resverse of
;; final desired order
(let loop ((value (car L)) (count 1) (L (cdr L)) (acc '()))
(cond ((null? L) '())
((= value (car l))
(loop value (+ 1 count) (cdr L) acc))
(else
(loop (car l) 1 (cdr L) (cons (cons value count) acc))))))
(define (make-tree count c-L)
(let* ((middle (ceiling (+ 1 count) 2))
(left-count (- middle 1))
(right-count (-count middle))
(left (if (= 0 left-count)
null-tree
(make-tree left-count c-L)))
(entry+right
(let loop ((index 1) (L c-L))
(if (= index middle)
L
(loop (+ 1 index) (cdr L)))))
(entry
(make-entry
(caar entry+right)
left-count
(cdar entry+right))))
(build-tree
entry
left
(if (= 0 right-count)
null-tree
(make-tree right-count (cdr entry+right))))))
;;form left branches from starting points
;;;form right from stopping points
;;never mutating c-L or copies
;;if count = 0 then null tree
(define (build-tree entry left right)
(list '*tree entry left right)
(define (entry tree)
(cadr tree)
(define (left-branch tree)
(caddr tree))
(define (right-branch tree)
(cadddr tree))
(define null-tree (list '*tree '()))
(define (null-tree? tree)
(null? (entry tree)))
(define (make-entry value Nleft count)
(let ((vec (make-vector 3)))
(begin (vector-set! vec 0 value)
(vector-set! vec 1 Nleft)
(vector-set! vec 2 count)
vec)))
;;might meessage passing function here
(define (entry-value entry)
(vector-ref entry 0))
(define (entry-Nleft entry)
(vector-ref entry 1))
(define (entry-Nleft-set! entry int)
(vector-set! entry 1 int))
(define (entry-count entry)
(vector-ref entry 2))
(define (entry-count-set! entry int)
(vector-set! entry 2 int))
(define (inversions! Test-List Search-Tree)
(let loop ((acc 0) (L Test-list) (T Search-tree))
(cond ((null? L) acc)
((null-tree? T) (error "null tree "
"in inner loop of inversion!"))
((= (car L) (entry-value (entry T)))
(entry-count-set! (entry T)
(- (entry-count (entry T)) 1))
(if (and (= 0 (entry-count (entry T)))
(= 0 (entry-Nleft (entry T))))
(set-cdr! T (right-branch T))
'skip)
(loop (+ acc (entry-Nleft (entry T)))
(cdr L)
Search-tree))
((< (car L) (entry-value (entry T)))
(entry-Nleft-set! (entry T)
(- (entry-Nleft (entry T)) 1))
(loop acc L (left-branch T)))
((> (car L) (entry-value (entry T)))
(loop (+ acc (entry-Nleft (entry T)))
L
(right-branch T))))))