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 |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 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) 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.
36 12687dd9 2023-08-04 jrmu ;find-route/list : (listof nodes) node graph -> (listof nodes) or false
37 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.
39 12687dd9 2023-08-04 jrmu ;neighbors : node graph -> (listof nodes)
40 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.
42 12687dd9 2023-08-04 jrmu ;; assf : (X -> boolean) (listof (list X Y)) -> (list X Y) or false
43 12687dd9 2023-08-04 jrmu ;; to find the first item on alop for whose first item p? holds
45 12687dd9 2023-08-04 jrmu ;(find-route 'A 'G Graph)
46 12687dd9 2023-08-04 jrmu ;(find-route 'C 'G Graph)
48 12687dd9 2023-08-04 jrmu ;A node-path is a list
49 12687dd9 2023-08-04 jrmu ;(cons no1 no2 lon)
50 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.
52 12687dd9 2023-08-04 jrmu ;test-on-all-nodes : graph -> (listof (listof node-path))
53 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.
55 12687dd9 2023-08-04 jrmu ;find-route : node node graph -> (listof nodes) or false
57 12687dd9 2023-08-04 jrmu ;extract-nodes : graph -> (listof nodes)
58 12687dd9 2023-08-04 jrmu ;Extracts the nodes from G and returns them as a (listof nodes).
60 12687dd9 2023-08-04 jrmu ;generate-pairs : (listof nodes) -> (listof (listof nodes))
61 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.
63 12687dd9 2023-08-04 jrmu ;generate-pairs : (listof nodes) (listof nodes) -> (listof (listof nodes))
64 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.
66 12687dd9 2023-08-04 jrmu ;pair : node (listof nodes) -> (listof (listof nodes))
67 12687dd9 2023-08-04 jrmu ;Given anode and alon, generate all possible pairs of anode with elements in alon.
69 12687dd9 2023-08-04 jrmu ;remove : X (listof X) -> (listof X)
70 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.
72 12687dd9 2023-08-04 jrmu (define (find-route ori dest G)
74 12687dd9 2023-08-04 jrmu [(symbol=? ori dest) (list ori)]
78 12687dd9 2023-08-04 jrmu (define (assf op aloxy)
80 12687dd9 2023-08-04 jrmu [(empty? aloxy) false]
81 12687dd9 2023-08-04 jrmu [(op (first (first aloxy))) (first aloxy)]
82 12687dd9 2023-08-04 jrmu [else (assf op (rest aloxy))]))
83 12687dd9 2023-08-04 jrmu (define neighbors
84 12687dd9 2023-08-04 jrmu (first (rest (assf (lambda (x) (equal? ori x)) G))))
85 12687dd9 2023-08-04 jrmu (define (find-route/list neighbors)
87 12687dd9 2023-08-04 jrmu [(empty? neighbors) false]
88 12687dd9 2023-08-04 jrmu [else (local ((define possible-route (find-route (first neighbors) dest G)))
89 12687dd9 2023-08-04 jrmu (cond [(boolean? possible-route) (find-route/list (rest neighbors))]
90 12687dd9 2023-08-04 jrmu [else possible-route]))]))
91 12687dd9 2023-08-04 jrmu (define possible-route (find-route/list neighbors)))
93 12687dd9 2023-08-04 jrmu [(boolean? possible-route) false]
94 12687dd9 2023-08-04 jrmu [else (cons ori possible-route)]))]))
99 12687dd9 2023-08-04 jrmu (define (test-on-all-nodes G)
100 12687dd9 2023-08-04 jrmu (map (lambda (x)
101 12687dd9 2023-08-04 jrmu (list (first x)
103 12687dd9 2023-08-04 jrmu (find-route (first x) (second x) G)))
104 12687dd9 2023-08-04 jrmu (generate-pairs (extract-nodes G))))
106 12687dd9 2023-08-04 jrmu (define (extract-nodes G)
107 12687dd9 2023-08-04 jrmu (map (lambda (x) (first x)) G))
109 12687dd9 2023-08-04 jrmu (define (generate-pairs alon)
110 12687dd9 2023-08-04 jrmu (local ((define (generate-pairs current-lon complete-lon)
112 12687dd9 2023-08-04 jrmu [(empty? current-lon) empty]
113 12687dd9 2023-08-04 jrmu [else (append (pair (first current-lon)
114 12687dd9 2023-08-04 jrmu (remove (first current-lon) complete-lon))
115 12687dd9 2023-08-04 jrmu (generate-pairs (rest current-lon) complete-lon))])))
116 12687dd9 2023-08-04 jrmu (generate-pairs alon alon)))
118 12687dd9 2023-08-04 jrmu (define (pair anode alon)
120 12687dd9 2023-08-04 jrmu [(empty? alon) empty]
121 12687dd9 2023-08-04 jrmu [else (cons (list anode (first alon))
122 12687dd9 2023-08-04 jrmu (pair anode (rest alon)))]))
124 12687dd9 2023-08-04 jrmu (define (remove x alox)
126 12687dd9 2023-08-04 jrmu [(empty? alox) empty]
127 12687dd9 2023-08-04 jrmu [(equal? x (first alox)) (rest alox)]
128 12687dd9 2023-08-04 jrmu [else (cons (first alox)
129 12687dd9 2023-08-04 jrmu (remove x (rest alox)))]))
130 12687dd9 2023-08-04 jrmu (equal? (find-route 'B 'C Graph2) '(B E C))
131 12687dd9 2023-08-04 jrmu (find-route 'B 'F Graph1)
