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))
Related
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
I have following list of connections:
(define routelist
(list
(list'a 'b)
(list'a 'c)
(list'b 'e)
(list'b 'f)
(list'b 'c)
(list'a 'd)
(list'e 'f)
(list'f 'g)))
Routes between 'a and 'g are to be found. This page shows a solution in Prolog: http://www.anselm.edu/homepage/mmalita/culpro/graf1.html
I could manage following solution, though it is iterative:
(define (mainpath routelist start end (outl '()))
(if (equal? start end)
(println "Same start and end points.")
(for ((item routelist))
(when (equal? start (list-ref item 0))
(set! outl (cons start outl))
(if (equal? end (list-ref item 1))
(begin
; PATH FOUND:
(set! outl (cons end outl))
(println (reverse outl)))
(begin
(mainpath (rest routelist) (list-ref item 1) end outl)
(set! outl (rest outl))))))))
(mainpath routelist 'a 'g)
Output:
'(a b e f g)
'(a b f g)
How can a functional solution be achieved in Racket?
Here is a very simple solution:
(define (mainpath routelist start end)
(define (neighbors node)
(map second (filter (lambda (x) (eq? (first x) node)) routelist)))
(define (visit node visited)
(when (not (member node visited))
(when (eq? node end)
(println (reverse (cons node visited))))
(let ((new-visited (cons node visited)))
(map (lambda (x) (visit x new-visited)) (neighbors node)))))
(visit start '())
"No more paths")
This recursive function, that can manage also graphs with loops, keeps a list of nodes already visited along the current path and stops when it has visited all the nodes reachable from the start node. When the current node is the end node, the current path is printed.
Use DFS algorithm will be ok.
(define (mainpath routelist start end)
(letrec ([next-nodes (λ (node)
(for/list ([al routelist]
#:when (eq? node (first al)))
(second al)))]
[path (λ (node vlist)
(let ([new-list (cons node vlist)])
(when (eq? node end)
(println (reverse new-list)))
(for ([next (next-nodes node)]
#:unless (memq next vlist))
(path next new-list))))])
(path start '())))
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")]))
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))))))
I am trying to implement a breadth first (level) tree traversal. I'm very close, but I can't figure out how I'm getting duplicates. Any help is much appreciated. Thanks in advance.
JR
(define (atom? x)
(not (pair? x)))
;;Functions to manipulate a binary tree
(define (leaf? node) (atom? node))
(define (left node) (cadr node))
(define (right node) (caddr node))
(define (label node) (if (leaf? node) node (car node)))
;; Breadth First using queue
(define (breadth node)
(q 'enqueue! node) ;; Enqueue tree
(output 'enqueue! (label node)) ;; Output root
(helper node)
(output 'queue->list) ;; Output elements in queue
)
(define (helper node)
(if (not(q 'empty?)) ;; If queue is not empty
(begin
(if(not(leaf? node))
(begin
(q 'enqueue! (left node)) ;; left tree to q
(output 'enqueue! (label(left node))) ;; Output root of left tree
(q 'enqueue! (right node)) ;; Enqueue right tree to q
(output 'enqueue! (label(right node))) ;; Output root of right tree
))
(helper (q 'dequeue!)) ;; Dequeues 1st element in q
;; and recursively calls helper
)
)
)
(define (make-queue)
(let ((front '())
(back '()))
(lambda (msg . obj)
(cond ((eq? msg 'empty?) (null? front))
((eq? msg 'enqueue!)
(if (null? front)
(begin
(set! front obj)
(set! back obj))
(begin
(set-cdr! back obj)
(set! back obj))))
((eq? msg 'dequeue!)
(begin
(let ((val (car front)))
(set! front (cdr front))
val)))
((eq? msg 'queue->list) front)))))
(define q (make-queue))
(define output (make-queue))
(define tree '(A (B C D)(E (F G H) I)))
---------------------------------------------------------
Welcome to DrScheme, version 4.2.2 [3m].
Language: R5RS; memory limit: 128 megabytes.
> (breadth tree)
(a b e b e c d f i c d f i g h g h) ;; Should be (a b e c d f i g h)
>
Since it's homework, I'll just give a hint: rewrite helper to take no arguments.