Im trying to implement Depth First Search in Scheme, but I can only get it to partially work.
This is my code:
(define (depth-first-search graph node neighbour path dest)
(cond ((null? neighbour) #f)
((equal? node dest) path)
((member (car neighbour) path) (depth-first-search graph node (cdr neighbour) path dest))
((memq (car neighbour) (car graph)) (depth-first-search (cdr graph) (car neighbour) (memq (car neighbour) (car graph)) (append path (list (car neighbour))) dest))
(else depth-first-search (cdr graph) path dest)))
And this is my graph, data structure:
(define complete-graph
'((a b c d e)
(b a c)
(c a b f)
(d a e h)
(e a d)
(f c g i)
(g f h i j)
(h d g j)
(i f g j)
(j g h i)))
This is how I call the procedure:
(depth-first-search complete-graph (caar complete-graph) (cdar complete-graph) (list (caar complete-graph)) 'd)
To procedure shoud return the full path frome the start-node to the dest(ination) as a list, but it only seems to work with some start and destination nodes. If I start with 'a and 'c, it returns the right list '(a b c), but if I try with 'a and 'd, I get #f in return. So it probably is something wrong with the backtracking in the algorithm. But I have looked at the code for too long, and I really can't find the problem..
Assuming node 'a has children '(b c d e), node 'b has children '(a c), node ... First you need a function that expands a node to its children.
(define (expand graph node)
(let ((c (assq node graph)))
(if c (cdr c) '())))
Second: you have to remember all visited nodes. In general hat is different from the path (maybe it does not matter in this example). Third: you need to remember all nodes you want to visit (result from the node expansion process). So define a helper function
(define (dfs* graph visited border path dest)
If there are no nodes left to visit, then no road exist.
(cond ((null? border) #f)
If the first element in border is equal to our destination, then we are happy
((eq? (car border) dest) (cons (car border) path))
Lets check all visited nodes. If the first node in border was visited before then proceed without node expansion
((memq (car border) visited)
(dfs* graph visited (cdr border) path dest))
Otherwise expand the first node of border
(else (dfs* graph
(cons (car border) visited)
(append (expand graph (car border)) (cdr border))
(cons (car border) path)
dest))))
Call that helper function with starting values for visited, border and path:
(define (dfs graph src dst)
(dfs* graph '() (list src) '() dst)
For breath first search: append the expanded node at the end of border
Edit:
a) visited and path are the same, you can drop one of them
b) the path is returned in reverse order
c) The procedure is not correct, path contains all visited nodes. But a post processing of the result of dfs* will do the job.
You don't want to change the graph as you do the depth-first search, just the current node. If you want to do things purely functionally, have your function look like:
(define (depth-first-search graph node dest path)
(let dfs ((node node) (path path))
(let ((recur (lambda (node) (dfs node (cons node path)))))
; Write code here
; Recursive calls should use recur, not dfs or depth-first-search
...)))
(returning a path or #f as the result). You can use ormap (in Racket or SRFI-1) to iterate through all neighbors of a node, returning the first value that is not #f.
Related
How would we go about implementing get the shortest path between the start vertex and the end vertex?
The program should return a list of edges (shortest path) using BFS.
(define (new-paths path node net)
(map (lambda (n) (cons n path)) (cdr (assoc node net))))
(define (shortest-path start end net)
(bfs end (list (list start)) net))
;; Breadth-first search
(define (bfs end queue net)
(display queue) (newline) (newline) ; entertainment
(if (null? queue)
'()
(let ((path (car queue)))
(let ((node (car path)))
(if (equal? node end) ;; Graham used CL eql
(reverse path)
(bfs end
(append (cdr queue)
(new-paths path node net))
net))))))
I came up with but this does not seem to work. Can someone provide an implementation in a purely functional way?
In the form (get-shortest-path vertices edges src dest)
An example of the call would be
(get-shortest-path '(a b c d) (cons (cons a b) (cons b c) (cons c d)) 'a 'c)
; Get the shortest path between a and c
Given an s-expression '((a . b) . (c . d)) and a list '(e f g h), how can I traverse the s-expression create an s-expression with the same shape, but with elements taken from the list? E.g., for the s-expression and list above, the result would be '((e . f) g . h)?
Traversing a tree of pairs in left to right order isn't particularly difficult, as car and cdr let you get to both sides, and cons can put things back together. The tricky part in a problem like this is that to "replace" elements in the right hand side of a tree, you need to know how many of the available inputs you used when processing the left hand side of the tree. So, here's a procedure reshape that takes a template (a tree with the shape that you want) and a list of elements to use in the new tree. It returns as multiple values the new tree and any remaining elements from the list. This means that in the recursive calls for a pair, you can easily obtain both the new left and right subtrees, along with the remaining elements.
(define (reshape template list)
;; Creates a tree shaped like TEMPLATE, but with
;; elements taken from LIST. Returns two values:
;; the new tree, and a list of any remaining
;; elements from LIST.
(if (not (pair? template))
(values (first list) (rest list))
(let-values (((left list) (reshape (car template) list)))
(let-values (((right list) (reshape (cdr template) list)))
(values (cons left right) list)))))
(reshape '((a . b) . (c . d)) '(e f g h))
;=> ((e . f) g . h)
;=> ()
(reshape '((a . b) . (c . d)) '(e f g h i j k))
;=> ((e . f) g . h)
;=> (i j k) ; leftovers
I'll assume that you want to create a new s-expression with the same shape of the s-expression given as the first parameter, but with the elements of the list from the second parameter.
If that's right, here's one possible solution using a list to save the point where we are in the replacement list and Racket's begin0 to keep the list updated (if that's not available in you interpreter use a let, as suggested by Chris and Joshua in the comments):
(define (transform sexp lst)
(let loop ((sexp sexp)) ; the s-expression list to be traversed
(cond ((null? sexp) '()) ; if it's empty, we're finished
((not (pair? sexp)) ; if it's an atom
(begin0 ; then (alternatively: use a `let`)
(car lst) ; return first element in replacements list
(set! lst (cdr lst)))) ; and update replacements to next element
(else ; otherwise advance recursion
(cons (loop (car sexp)) ; over both the `car` part of input
(loop (cdr sexp))))))) ; and the `cdr` part
For example:
(transform '((a . b) . (c . d)) '(e f g h))
=> '((e . f) g . h)
(transform '((a . b) (c d (x y) . z) . t) '(e f g h i j k m))
=> '((e . f) (g h (i j) . k) . m)
The solution is similar to my previous answer:
(define (transform sxp lst)
(let loop ((sxp sxp))
(cond ((null? sxp) sxp)
((pair? sxp) (cons (loop (car sxp)) (loop (cdr sxp))))
(else (begin0 (car lst) (set! lst (cdr lst)))))))
then
> (transform '((a . b) . (c . d)) '(e f g h))
'((e . f) g . h)
can someone please explain why i have the error:
map: contract violation
expected: list?
given: 'e3
argument position: 2nd
other arguments...:
#<procedure>
in the code below???
My expected output is: '(e4 e5 e0)
I'm trying to use the depth first search algorithm to find the path between 2 nodes, the code is:
#lang racket
(define successors ; finding successor of a node in graph
(lambda (node graph)
(let ((val (assq node graph)))
(if val
(cdr val)
'()))))
(define make-task cons)
(define task-node car)
(define task-path cdr)
(define same-node? eq?)
(define linked ; function to find the path between 2 nodes in a graph
(lambda (start end graph) ; begin, end: nodes graph: a graph
(define handle-node
(lambda (node path todo seen)
(if (same-node? node end)
(reverse (cons node path))
(if (assq node path)
(process-todo todo seen)
(process-todo (append (map (lambda (successor)
(make-task successor
(cons node
path)))
(successors node
graph))
todo)
(cons node seen))))))
(define process-todo
(lambda (todo seen)
(if (null? todo)
#f
(let ((task (car todo)))
(handle-node (task-node task) ;;; node
(task-path task) ;;; path
((lambda (x y) (cdr y)) task todo) ;;; rest to do
seen)))))
(handle-node start '() '() '())))
(linked 'e4 'e0 '((e1 . e0) (e2 . e1) (e3 . e2) (e4 . e3) (e4 . e5) (e5 . e0)))
Thank you very much!!
Your successor function has a 'type' error. The alternate of the if returns a list (actually '()) whereas the consequent of the if returns (cdr val) which is not a list (based on your input data). This is confirmed from the error message - a list? was expected but a symbol? was provided.
It looks like your graph representation is meant to be an association between the node name and a list of the connected node names. But your input data is not in that form! Try:
'((e1 e0) (e2 e1) ...)
By the way, successor is written idiomatically as:
(define (successor node graph)
(cond ((assq node graph) => cdr)
(else '())))
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.
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.