#lang htdp/isl+ (require racket/list) (require "provide.rkt") (provide (struct-out graph) find-shortest-path-to-cond) ;; a graph is: ;; (make-graph (listof X) (X -> (listof X)) (X X -> boolean)) (define-struct graph (nodes neighbor same-node?)) ; A ; / ; / ; B C ; |\ /| ; | \/ | ; D E F ; \ | / ; \|/ ; G ; (arrows pointing down) (define mygraph (make-graph '(a b c d e f g) (lambda (node) (cond [(symbol=? node 'a) '(b)] [(symbol=? node 'b) '(d e)] [(symbol=? node 'c) '(e f)] [(member node '(d e f)) '(g)] [(symbol=? node 'g) '()])) symbol=?)) ; find-path : graph X X -> list-of-X or false ; returns path between origin and dest if exists, otherwise false (define (find-path g origin dest) (find-path-acc g origin dest empty)) ; Consider: ; A --------> E ; \ / ; B->C-->D ; assume ((graph-neighbor g) 'A) => '(B E) ; what is (find-path g 'A 'E) ? ; find-path-acc : graph (define (find-path-acc g origin dest seen-so-far) (cond [((graph-same-node? g) origin dest) (list dest)] [(already-seen? g origin seen-so-far) false] [else (maybe-cons origin (find-path/list g ((graph-neighbor g) origin) dest (cons origin seen-so-far)))])) ; find-path/list : graph list-of-X X -> list-of-X or false ; returns a path from any nodes in list to dest or false if none exists (define (find-path/list graph origins dest seen-so-far) (cond [(empty? origins) false] [else (pick-one (find-path-acc graph (first origins) dest seen-so-far) (find-path/list graph (rest origins) dest seen-so-far))]) ) (check-expect (find-path mygraph 'a 'd) (list 'a 'b 'd)) (check-expect (find-path mygraph 'a 'c) false) ;pick-one : (list-of-X or false) (list-of-X or false) -> list-of-X or false (define (pick-one a b) (cond [(boolean? a) b] [else a] )) (define a-graph (make-graph '(x y z) (lambda (x) (cond [(symbol=? x 'x) '(y)] [(symbol=? x 'y) '(x)] [(symbol=? x 'z) '()])) symbol=?)) (check-expect (find-path a-graph 'x 'z) false) (check-expect (find-path a-graph 'x 'y) (list 'x 'y)) ;; maybe-cons : X (list-of-X or false) -> list-of-X or false ; returns false if second arg false, otherwise list with symbol pre-pended (define (maybe-cons a b) (cond [(boolean? b) b] [else (cons a b)])) ; already-seen? graph symbols list-of-symbols -> boolean ; determines whether node is in seen nodes according ; to graph-same-node function (define (already-seen? g node nodes) (cond [(empty? nodes) false] [else (or ((graph-same-node? g) (first nodes) node) (already-seen? g node (rest nodes)))])) (define multipathgraph (make-graph '(a b c d e f g) (lambda (node) (cond [(symbol=? node 'a) '(b c)] [(symbol=? node 'b) '(d e)] [(symbol=? node 'c) '(g)] [(member node '(d e f)) '(g)] [(symbol=? node 'g) '()])) symbol=?)) ; find-shortest-path : graph X X -> list-of-X or false ; returns a shortest path (i.e. one with fewest edges) from src to dest ; or false if no path exists (define (find-shortest-path g src dest) (find-shortest-path-helper g dest (list (list src)) empty)) ; find-shortest-path-helper : graph X X list-of-list-of-X list-of-X -> list-of-X or false ; returns a shortest path (i.e. one with fewest edges) from src to dest ; or false if no path exists, starting from agenda and skipping seen-nodes (define (find-shortest-path-helper g dest agenda seen-nodes) (cond [(empty? agenda) false] [else (local [(define path (first agenda)) (define path-end (last path))] (cond [((graph-same-node? g) path-end dest) path] [(already-seen? g path-end seen-nodes) (find-shortest-path-helper g dest (rest agenda) seen-nodes)] [else (find-shortest-path-helper g dest (append (rest agenda) (make-paths path ((graph-neighbor g) path-end))) (cons path-end seen-nodes))]))])) ; find-shortest-path-to-cond : graph X (X -> boolean) -> list-of-X or false ; returns a shortest path (i.e. one with fewest edges) from src to some node meeting condition ; or false if no path exists (define (find-shortest-path-to-cond g src dest?) (find-shortest-path-to-cond-helper g dest? (list (list src)) empty)) ; find-shortest-path-helper : graph X X list-of-list-of-X list-of-X -> list-of-X or false ; returns a shortest path (i.e. one with fewest edges) from src to dest ; or false if no path exists, starting from agenda and skipping seen-nodes (define (find-shortest-path-to-cond-helper g dest? agenda seen-nodes) (cond [(empty? agenda) false] [else (local [(define path (first agenda)) (define path-end (last path))] (cond [(dest? path-end) path] [(already-seen? g path-end seen-nodes) (find-shortest-path-to-cond-helper g dest? (rest agenda) seen-nodes)] [else (find-shortest-path-to-cond-helper g dest? (append (rest agenda) (make-paths path ((graph-neighbor g) path-end))) (cons path-end seen-nodes))]))])) (check-expect (find-shortest-path-to-cond mygraph 'a (lambda (x) (symbol=? x'd))) (list 'a 'b 'd)) ;make-paths : list-of-X list-of-X -> list-of-list-of-X ; returns all new paths through path then one of choices (define (make-paths path choices) (map (lambda (x) (append path (list x))) choices)) (check-expect (make-paths (list 'a 'b 'c) (list 'd 'e)) (list (list 'a 'b 'c 'd) (list 'a 'b 'c 'e))) (check-expect (find-shortest-path mygraph 'a 'd) (list 'a 'b 'd)) (check-expect (find-shortest-path mygraph 'a 'c) false) (check-expect (find-shortest-path a-graph 'x 'z) false) (check-expect (find-shortest-path multipathgraph 'a 'g) (list 'a 'c 'g)) (check-expect (find-path multipathgraph 'a 'g) (list 'a 'b 'd 'g))