1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
3 12687dd9 2023-08-04 jrmu #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 12687dd9 2023-08-04 jrmu (define Graph1
12 12687dd9 2023-08-04 jrmu (define Graph2
22 12687dd9 2023-08-04 jrmu ;A node is a symbol.
24 12687dd9 2023-08-04 jrmu ;A path is a list of the form
25 12687dd9 2023-08-04 jrmu ;(cons no lon)
26 12687dd9 2023-08-04 jrmu ;where no is a node and lon is a (listof nodes).
28 12687dd9 2023-08-04 jrmu ;A graph is either
29 12687dd9 2023-08-04 jrmu ;1. empty or
30 12687dd9 2023-08-04 jrmu ;2. (cons pa gr)
31 12687dd9 2023-08-04 jrmu ;where pa is a path and gr is a graph.
33 12687dd9 2023-08-04 jrmu ;find-route : node node graph (listof nodes) -> (listof nodes) or false
34 12687dd9 2023-08-04 jrmu ;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).
36 12687dd9 2023-08-04 jrmu (define (find-route ori dest G accu-seen)
38 12687dd9 2023-08-04 jrmu [(symbol=? ori dest) (list ori)]
39 12687dd9 2023-08-04 jrmu [(contains ori accu-seen) false]
40 12687dd9 2023-08-04 jrmu [else (local ((define possible-route (find-route/list (neighbors ori G) dest G (cons ori accu-seen))))
42 12687dd9 2023-08-04 jrmu [(boolean? possible-route) false]
43 12687dd9 2023-08-04 jrmu [else (cons ori possible-route)]))]))
45 12687dd9 2023-08-04 jrmu ;find-route/list : (listof nodes) node graph (listof nodes)-> (listof nodes) or false
46 12687dd9 2023-08-04 jrmu ;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.
48 12687dd9 2023-08-04 jrmu (define (find-route/list lo-ori dest G accu-seen)
50 12687dd9 2023-08-04 jrmu [(empty? lo-ori) false]
51 12687dd9 2023-08-04 jrmu [else (local ((define possible-route (find-route (first lo-ori) dest G accu-seen)))
52 12687dd9 2023-08-04 jrmu (cond [(boolean? possible-route) (find-route/list (rest lo-ori) dest G accu-seen)]
53 12687dd9 2023-08-04 jrmu [else possible-route]))]))
55 12687dd9 2023-08-04 jrmu ;neighbors : node graph -> (listof nodes)
56 12687dd9 2023-08-04 jrmu ;Given anode and G, find all the neighboring nodes of anode in G. If there are no neighboring nodes, return empty.
58 12687dd9 2023-08-04 jrmu (define (neighbors anode G)
59 12687dd9 2023-08-04 jrmu (first (rest (assf (lambda (x) (equal? anode x)) G))))
61 12687dd9 2023-08-04 jrmu ;contains : X (listof X) -> boolean
62 12687dd9 2023-08-04 jrmu ;Determines if alox contains x.
64 12687dd9 2023-08-04 jrmu (define (contains x alox)
65 12687dd9 2023-08-04 jrmu (ormap (lambda (item) (equal? x item)) alox))
67 12687dd9 2023-08-04 jrmu ;; assf : (X -> boolean) (listof (list X Y)) -> (list X Y) or false
68 12687dd9 2023-08-04 jrmu ;; to find the first item on alop for whose first item p? holds
70 12687dd9 2023-08-04 jrmu (define (assf op aloxy)
72 12687dd9 2023-08-04 jrmu [(empty? aloxy) false]
73 12687dd9 2023-08-04 jrmu [(op (first (first aloxy))) (first aloxy)]
74 12687dd9 2023-08-04 jrmu [else (assf op (rest aloxy))]))
76 12687dd9 2023-08-04 jrmu (find-route 'A 'G Graph2 empty)
77 12687dd9 2023-08-04 jrmu (find-route 'C 'G Graph2 empty)
78 12687dd9 2023-08-04 jrmu (find-route 'F 'G Graph2 empty)
82 12687dd9 2023-08-04 jrmu ;A node-path is a list
83 12687dd9 2023-08-04 jrmu ;(cons no1 no2 lon)
84 12687dd9 2023-08-04 jrmu ;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.
86 12687dd9 2023-08-04 jrmu ;test-on-all-nodes : graph -> (listof (listof node-path))
87 12687dd9 2023-08-04 jrmu ;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.
89 12687dd9 2023-08-04 jrmu ;find-route : node node graph -> (listof nodes) or false
91 12687dd9 2023-08-04 jrmu (define (test-on-all-nodes G)
92 12687dd9 2023-08-04 jrmu (map (lambda (x)
93 12687dd9 2023-08-04 jrmu (list (first x)
95 12687dd9 2023-08-04 jrmu (find-route (first x) (second x) G)))
96 12687dd9 2023-08-04 jrmu (generate-pairs (extract-nodes G))))
98 12687dd9 2023-08-04 jrmu ;extract-nodes : graph -> (listof nodes)
99 12687dd9 2023-08-04 jrmu ;Extracts the nodes from G and returns them as a (listof nodes).
101 12687dd9 2023-08-04 jrmu (define (extract-nodes G)
102 12687dd9 2023-08-04 jrmu (map (lambda (x) (first x)) G))
104 12687dd9 2023-08-04 jrmu ;generate-pairs : (listof nodes) -> (listof (listof nodes))
105 12687dd9 2023-08-04 jrmu ;Generates all possible pairs of nodes from alon and returns it as a (listof (listof nodes)), each element containing a pair of nodes.
107 12687dd9 2023-08-04 jrmu ;generate-pairs : (listof nodes) (listof nodes) -> (listof (listof nodes))
108 12687dd9 2023-08-04 jrmu ;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.
111 12687dd9 2023-08-04 jrmu (define (generate-pairs alon)
112 12687dd9 2023-08-04 jrmu (local ((define (generate-pairs current-lon complete-lon)
114 12687dd9 2023-08-04 jrmu [(empty? current-lon) empty]
115 12687dd9 2023-08-04 jrmu [else (append (pair (first current-lon)
116 12687dd9 2023-08-04 jrmu (remove (first current-lon) complete-lon))
117 12687dd9 2023-08-04 jrmu (generate-pairs (rest current-lon) complete-lon))])))
118 12687dd9 2023-08-04 jrmu (generate-pairs alon alon)))
120 12687dd9 2023-08-04 jrmu ;pair : node (listof nodes) -> (listof (listof nodes))
121 12687dd9 2023-08-04 jrmu ;Given anode and alon, generate all possible pairs of anode with elements in alon.
123 12687dd9 2023-08-04 jrmu (define (pair anode alon)
125 12687dd9 2023-08-04 jrmu [(empty? alon) empty]
126 12687dd9 2023-08-04 jrmu [else (cons (list anode (first alon))
127 12687dd9 2023-08-04 jrmu (pair anode (rest alon)))]))
129 12687dd9 2023-08-04 jrmu ;remove : X (listof X) -> (listof X)
130 12687dd9 2023-08-04 jrmu ;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.
132 12687dd9 2023-08-04 jrmu (define (remove x alox)
134 12687dd9 2023-08-04 jrmu [(empty? alox) empty]
135 12687dd9 2023-08-04 jrmu [(equal? x (first alox)) (rest alox)]
136 12687dd9 2023-08-04 jrmu [else (cons (first alox)
137 12687dd9 2023-08-04 jrmu (remove x (rest alox)))]))
138 12687dd9 2023-08-04 jrmu (equal? (find-route 'B 'C Graph2) '(B E C))
