1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #reader(lib "" "lang")((modname |28.1|) (read-case-sensitive #t) (teachpacks ((lib "" "teachpack" "htdp") (lib "" "teachpack" "htdp") (lib "" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "" "teachpack" "htdp") (lib "" "teachpack" "htdp") (lib "" "teachpack" "htdp")))))
4 (define Graph1
5 '((A (B E))
6 (B (E F))
7 (C (D))
8 (D ())
9 (E (C F))
10 (F (D G))
11 (G ())))
12 (define Graph2
13 '((A (B E))
14 (B (E F))
15 (C (B D))
16 (D ())
17 (E (C F))
18 (F (D G))
19 (G ())))
22 ;A node is a symbol.
23 ;
24 ;A path is a list of the form
25 ;(cons no lon)
26 ;where no is a node and lon is a (listof nodes).
27 ;
28 ;A graph is either
29 ;1. empty or
30 ;2. (cons pa gr)
31 ;where pa is a path and gr is a graph.
33 ;find-route : node node graph -> (listof nodes) or false
34 ;Given dest, ori, and G, find a route from dest to ori in G and return is as a (listof nodes). The destination and origin are included in the (listof nodes). If no route is available, return false.
36 ;find-route/list : (listof nodes) node graph -> (listof nodes) or false
37 ;Given lo-ori (listof origins), dest, and G, produce a route from some node on lo-ori to dest in G. Return the route as a (listof nodes) or false if no route is available.
39 ;neighbors : node graph -> (listof nodes)
40 ;Given anode and G, find all the neighboring nodes of anode in G. If there are no neighboring nodes, return empty.
42 ;; assf : (X -> boolean) (listof (list X Y)) -> (list X Y) or false
43 ;; to find the first item on alop for whose first item p? holds
45 ;(find-route 'A 'G Graph)
46 ;(find-route 'C 'G Graph)
48 ;A node-path is a list
49 ;(cons no1 no2 lon)
50 ;where no1, no2 are nodes (representing the origin and destination, respectively), and lon is a (listof nodes) representing the route from the origin to the destination.
52 ;test-on-all-nodes : graph -> (listof (listof node-path))
53 ;Tests find-route for all possible pairs of nodes in G. We first generate all possible permutations of node pairs and we apply find-route to each node pair. We then return the resulting (listof node-paths), each node-path being a list containing the origin, destination, and the (listof nodes) taken to get from the origin to the destination.
55 ;find-route : node node graph -> (listof nodes) or false
57 ;extract-nodes : graph -> (listof nodes)
58 ;Extracts the nodes from G and returns them as a (listof nodes).
60 ;generate-pairs : (listof nodes) -> (listof (listof nodes))
61 ;Generates all possible pairs of nodes from alon and returns it as a (listof (listof nodes)), each element containing a pair of nodes.
63 ;generate-pairs : (listof nodes) (listof nodes) -> (listof (listof nodes))
64 ;Pair the first element of current-lon with the entire complete-lon, and repeat the process to return a (listof (listof nodes)), each element containing a pair of nodes, to give all possible pairings.
66 ;pair : node (listof nodes) -> (listof (listof nodes))
67 ;Given anode and alon, generate all possible pairs of anode with elements in alon.
69 ;remove : X (listof X) -> (listof X)
70 ;Given x and alox, removes the first instance of x in alox and returns the remaining list. If x is not present in alox, simply returns alox.
72 (define (find-route ori dest G)
73 (cond
74 [(symbol=? ori dest) (list ori)]
75 [else
76 (local (
78 (define (assf op aloxy)
79 (cond
80 [(empty? aloxy) false]
81 [(op (first (first aloxy))) (first aloxy)]
82 [else (assf op (rest aloxy))]))
83 (define neighbors
84 (first (rest (assf (lambda (x) (equal? ori x)) G))))
85 (define (find-route/list neighbors)
86 (cond
87 [(empty? neighbors) false]
88 [else (local ((define possible-route (find-route (first neighbors) dest G)))
89 (cond [(boolean? possible-route) (find-route/list (rest neighbors))]
90 [else possible-route]))]))
91 (define possible-route (find-route/list neighbors)))
92 (cond
93 [(boolean? possible-route) false]
94 [else (cons ori possible-route)]))]))
99 (define (test-on-all-nodes G)
100 (map (lambda (x)
101 (list (first x)
102 (second x)
103 (find-route (first x) (second x) G)))
104 (generate-pairs (extract-nodes G))))
106 (define (extract-nodes G)
107 (map (lambda (x) (first x)) G))
109 (define (generate-pairs alon)
110 (local ((define (generate-pairs current-lon complete-lon)
111 (cond
112 [(empty? current-lon) empty]
113 [else (append (pair (first current-lon)
114 (remove (first current-lon) complete-lon))
115 (generate-pairs (rest current-lon) complete-lon))])))
116 (generate-pairs alon alon)))
118 (define (pair anode alon)
119 (cond
120 [(empty? alon) empty]
121 [else (cons (list anode (first alon))
122 (pair anode (rest alon)))]))
124 (define (remove x alox)
125 (cond
126 [(empty? alox) empty]
127 [(equal? x (first alox)) (rest alox)]
128 [else (cons (first alox)
129 (remove x (rest alox)))]))
130 (equal? (find-route 'B 'C Graph2) '(B E C))
131 (find-route 'B 'F Graph1)