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