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 |30.2|) (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) -> (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.  If a node that has already been traversed before is traversed again, return false (to prevent infinite loops).
35 
36 (define (find-route ori dest G accu-seen)
37   (cond
38     [(symbol=? ori dest) (list ori)]
39     [(contains ori accu-seen) false]
40     [else (local ((define possible-route (find-route/list (neighbors ori G) dest G (cons ori accu-seen))))
41             (cond
42               [(boolean? possible-route) false]
43               [else (cons ori possible-route)]))]))
44 
45 ;find-route/list : (listof nodes) node graph (listof nodes)-> (listof nodes) or false
46 ;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.
47 
48 (define (find-route/list lo-ori dest G accu-seen)
49   (cond
50     [(empty? lo-ori) false]
51     [else (local ((define possible-route (find-route (first lo-ori) dest G accu-seen)))
52             (cond [(boolean? possible-route) (find-route/list (rest lo-ori) dest G accu-seen)]
53                   [else possible-route]))]))
54 
55 ;neighbors : node graph -> (listof nodes)
56 ;Given anode and G, find all the neighboring nodes of anode in G.  If there are no neighboring nodes, return empty.
57 
58 (define (neighbors anode G)
59   (first (rest (assf (lambda (x) (equal? anode x)) G))))
60 
61 ;contains : X (listof X) -> boolean
62 ;Determines if alox contains x.
63 
64 (define (contains x alox)
65   (ormap (lambda (item) (equal? x item)) alox))
66 
67 ;; assf : (X  ->  boolean) (listof (list X Y))  ->  (list X Y) or false
68 ;; to find the first item on alop for whose first item p? holds
69 
70 (define (assf op aloxy)
71   (cond
72     [(empty? aloxy) false]
73     [(op (first (first aloxy))) (first aloxy)]
74     [else (assf op (rest aloxy))]))
75 
76 (find-route 'A 'G Graph2 empty)
77 (find-route 'C 'G Graph2 empty)
78 (find-route 'F 'G Graph2 empty)
79 
80 #|
81 
82 ;A node-path is a list
83 ;(cons no1 no2 lon)
84 ;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.
85 
86 ;test-on-all-nodes : graph -> (listof (listof node-path))
87 ;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.
88 
89 ;find-route : node node graph -> (listof nodes) or false
90 
91 (define (test-on-all-nodes G)
92   (map (lambda (x)
93          (list (first x)
94                (second x)
95                (find-route (first x) (second x) G)))
96        (generate-pairs (extract-nodes G))))
97 
98 ;extract-nodes : graph -> (listof nodes)
99 ;Extracts the nodes from G and returns them as a (listof nodes).
100 
101 (define (extract-nodes G)
102   (map (lambda (x) (first x)) G))
103 
104 ;generate-pairs : (listof nodes) -> (listof (listof nodes))
105 ;Generates all possible pairs of nodes from alon and returns it as a (listof (listof nodes)), each element containing a pair of nodes.
106 
107 ;generate-pairs : (listof nodes) (listof nodes) -> (listof (listof nodes))
108 ;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.
109 
110 
111 (define (generate-pairs alon)
112   (local ((define (generate-pairs current-lon complete-lon)
113             (cond
114               [(empty? current-lon) empty]
115               [else (append (pair (first current-lon)
116                                   (remove (first current-lon) complete-lon))
117                             (generate-pairs (rest current-lon) complete-lon))])))
118     (generate-pairs alon alon)))
119 
120 ;pair : node (listof nodes) -> (listof (listof nodes))
121 ;Given anode and alon, generate all possible pairs of anode with elements in alon.
122 
123 (define (pair anode alon)
124   (cond
125     [(empty? alon) empty]
126     [else (cons (list anode (first alon))
127                 (pair anode (rest alon)))]))
128 
129 ;remove : X (listof X) -> (listof X)
130 ;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.
131 
132 (define (remove x alox)
133   (cond
134     [(empty? alox) empty]
135     [(equal? x (first alox)) (rest alox)]
136     [else (cons (first alox)
137                 (remove x (rest alox)))]))
138 (equal? (find-route 'B 'C Graph2) '(B E C))
139 
140 |#