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.
Related
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 '())))
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'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 have the following recursive function in Lisp
(defun f (item tree)
(when tree
(if (equal item (car tree)) tree
(if (and (listp (car tree))
(equal item (caar tree)))
(car tree)
(if (cdr tree)
(f item (cdr tree)))))))
This function receives a tree and an item to look for in its immediate leaves. If item is the car of any sublist, then it will return that sublist. That is,
(f 'c '(a b c)) => (c)
(f 'b '(a b c)) => (b c)
(f 'a '((a 1 2) b c)) => (a 1 2)
I've recently been informed that (Emacs Lisp) doesn't do tail recursion optimization, so I've been advised to turn this into a while loop. All of my training in Lisp has been in avoidance of loops like this. (I maintain that they are un-functional, but that's borderline pedantic.) I've made the following attempt for more conformative style:
(defun f (item tree)
(let ((p tree))
(while p
(cond
((equal item (car p)) p)
((and (listp (car p))
(equal item (caar p)))
(car tree))
(t (f item (cdr p))))
(setq p (cdr p)))))
I've shortened the function name for brevity/clarity, but do have a look at where it is being used if you are a power-user of emacs.
Your "iterative" solution is still recursing. It's also not returning the values found in the cond expression.
The following version sets a variable to the found result. Then the loop ends if a result has been found, so it can be returned.
(defun f (item tree)
(let ((p tree)
(result nil))
(while (and p (null result))
(cond ((equal item (car p)) (setq result p))
((and (listp (car p))
(equal item (caar p)))
(setq result (car tree)))
(t (setq p (cdr p)))))
result))
I got a tree:
(A . ((C . ((D . nil)(E . nil)))
(B . ((F . nil)(G . nil)))))
I want to transform this tree into:
((A C D) (A C E) (A B F) (A B G))
I already implemented this function for doing so:
(defun tree->paths (tree &optional buff)
(labels ((recurse (follow-ups extended-list)
(if follow-ups
(append (list (tree->paths (car follow-ups) extended-list))
(recurse (cdr follow-ups) extended-list))
nil)))
(rstyu:aif (cdr tree)
(recurse it (append buff (list (car tree))))
(append buff (list (car tree))))))
But applying it results in:
(tree->paths '(A . ((C . ((D . nil) (E . nil)))
(B . ((F . nil) (G . nil))))))
=>
(((A C D) (A C E)) ((A B F) (A B G)))
I must be missing some kind of append/merge within the recursion but I am not seeing it.
You must remove the list in (append (list (tree->paths
The tree->paths returns a list of paths; so does recurse. So, they may be appended without wrapping in a list call.
Here, I've tried to rewrite it so that it would work linearly (because your original function would exhaust stack space). However, while doing so, I've discovered something, which you might consider in general re' your original idea:
(defun tree-to-paths (tree)
(loop with node = tree
with trackback = nil
with result = nil
with head = nil
with head-trackback = nil
while (or node trackback) do
(cond
((null node)
(setf node (car trackback)
trackback (cdr trackback)
result (cons head result)
head (car head-trackback)
head-trackback (cdr head-trackback)))
((consp (car node))
(setf trackback (cons (cdr node) trackback)
head-trackback (cons head head-trackback)
head (copy-list head)
node (car node)))
(t (setf head (cons (car node) head)
node (cdr node))))
finally (return (nreverse (mapcar #'nreverse result)))))
In your example data the result you want to receive seems intuitively correct, but you can think of it also as if there were more paths, such as for example:
A -> C -> NIL - From looking at your data, this result seems redundant, but in general, you may want to have these results too / it would be hard to filter them all out in general.
I started over and chose the reverse approach by going leaf to root instead of root to leaf as I tried in the question:
(defun tree->paths2 (tree)
(labels ((recurse (follow-ups)
(if follow-ups
(append (tree->paths2 (car follow-ups))
(recurse (cdr follow-ups)))
nil)))
(rstyu:aif (cdr tree)
(mapcar #'(lambda(arg)
(cons (car tree) arg))
(recurse it))
(list tree))))
(tree->paths2 '(A . ((C . ((D . nil) (E . nil)))
(B . ((F . nil) (G . nil))))))
=>
((A C D) (A C E) (A B F) (A B G))
But if there is a way to fix my first approach I'd prefer to accept such fix as an answer.