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 "htdp-intermediate-lambda-reader.ss" "lang")((modname |28.1|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "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 ())))
20 
21 
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.
32 
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.
35 
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.
38 
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.
41 
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
44 
45 ;(find-route 'A 'G Graph)
46 ;(find-route 'C 'G Graph)
47 
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.
51 
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.
54 
55 ;find-route : node node graph -> (listof nodes) or false
56 
57 ;extract-nodes : graph -> (listof nodes)
58 ;Extracts the nodes from G and returns them as a (listof nodes).
59 
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.
62 
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.
65 
66 ;pair : node (listof nodes) -> (listof (listof nodes))
67 ;Given anode and alon, generate all possible pairs of anode with elements in alon.
68 
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.
71 
72 (define (find-route ori dest G)
73   (cond
74     [(symbol=? ori dest) (list ori)]
75     [else
76      (local (
77              
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)]))]))
95 
96 
97 
98 
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))))
105 
106 (define (extract-nodes G)
107   (map (lambda (x) (first x)) G))
108 
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)))
117 
118 (define (pair anode alon)
119   (cond
120     [(empty? alon) empty]
121     [else (cons (list anode (first alon))
122                 (pair anode (rest alon)))]))
123 
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)