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 (define (find-route ori dest G)
38 12687dd9 2023-08-04 jrmu [(symbol=? ori dest) (list ori)]
39 12687dd9 2023-08-04 jrmu [else (local ((define possible-route (find-route/list (neighbors ori G) dest G)))
41 12687dd9 2023-08-04 jrmu [(boolean? possible-route) false]
42 12687dd9 2023-08-04 jrmu [else (cons ori possible-route)]))]))
44 12687dd9 2023-08-04 jrmu ;find-route/list : (listof nodes) node graph -> (listof nodes) or false
45 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.
47 12687dd9 2023-08-04 jrmu (define (find-route/list lo-ori dest G)
49 12687dd9 2023-08-04 jrmu [(empty? lo-ori) false]
50 12687dd9 2023-08-04 jrmu [else (local ((define possible-route (find-route (first lo-ori) dest G)))
51 12687dd9 2023-08-04 jrmu (cond [(boolean? possible-route) (find-route/list (rest lo-ori) dest G)]
52 12687dd9 2023-08-04 jrmu [else possible-route]))]))
54 12687dd9 2023-08-04 jrmu ;neighbors : node graph -> (listof nodes)
55 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.
57 12687dd9 2023-08-04 jrmu (define (neighbors anode G)
58 12687dd9 2023-08-04 jrmu (first (rest (assf (lambda (x) (equal? anode x)) G))))
60 12687dd9 2023-08-04 jrmu ;; assf : (X -> boolean) (listof (list X Y)) -> (list X Y) or false
61 12687dd9 2023-08-04 jrmu ;; to find the first item on alop for whose first item p? holds
63 12687dd9 2023-08-04 jrmu (define (assf op aloxy)
65 12687dd9 2023-08-04 jrmu [(empty? aloxy) false]
66 12687dd9 2023-08-04 jrmu [(op (first (first aloxy))) (first aloxy)]
67 12687dd9 2023-08-04 jrmu [else (assf op (rest aloxy))]))
69 12687dd9 2023-08-04 jrmu ;(find-route 'A 'G Graph)
70 12687dd9 2023-08-04 jrmu ;(find-route 'C 'G Graph)
72 12687dd9 2023-08-04 jrmu ;A node-path is a list
73 12687dd9 2023-08-04 jrmu ;(cons no1 no2 lon)
74 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.
76 12687dd9 2023-08-04 jrmu ;test-on-all-nodes : graph -> (listof (listof node-path))
77 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.
79 12687dd9 2023-08-04 jrmu ;find-route : node node graph -> (listof nodes) or false
81 12687dd9 2023-08-04 jrmu (define (test-on-all-nodes G)
82 12687dd9 2023-08-04 jrmu (map (lambda (x)
83 12687dd9 2023-08-04 jrmu (list (first x)
85 12687dd9 2023-08-04 jrmu (find-route (first x) (second x) G)))
86 12687dd9 2023-08-04 jrmu (generate-pairs (extract-nodes G))))
88 12687dd9 2023-08-04 jrmu ;extract-nodes : graph -> (listof nodes)
89 12687dd9 2023-08-04 jrmu ;Extracts the nodes from G and returns them as a (listof nodes).
91 12687dd9 2023-08-04 jrmu (define (extract-nodes G)
92 12687dd9 2023-08-04 jrmu (map (lambda (x) (first x)) G))
94 12687dd9 2023-08-04 jrmu ;generate-pairs : (listof nodes) -> (listof (listof nodes))
95 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.
97 12687dd9 2023-08-04 jrmu ;generate-pairs : (listof nodes) (listof nodes) -> (listof (listof nodes))
98 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.
101 12687dd9 2023-08-04 jrmu (define (generate-pairs alon)
102 12687dd9 2023-08-04 jrmu (local ((define (generate-pairs current-lon complete-lon)
104 12687dd9 2023-08-04 jrmu [(empty? current-lon) empty]
105 12687dd9 2023-08-04 jrmu [else (append (pair (first current-lon)
106 12687dd9 2023-08-04 jrmu (remove (first current-lon) complete-lon))
107 12687dd9 2023-08-04 jrmu (generate-pairs (rest current-lon) complete-lon))])))
108 12687dd9 2023-08-04 jrmu (generate-pairs alon alon)))
110 12687dd9 2023-08-04 jrmu ;pair : node (listof nodes) -> (listof (listof nodes))
111 12687dd9 2023-08-04 jrmu ;Given anode and alon, generate all possible pairs of anode with elements in alon.
113 12687dd9 2023-08-04 jrmu (define (pair anode alon)
115 12687dd9 2023-08-04 jrmu [(empty? alon) empty]
116 12687dd9 2023-08-04 jrmu [else (cons (list anode (first alon))
117 12687dd9 2023-08-04 jrmu (pair anode (rest alon)))]))
119 12687dd9 2023-08-04 jrmu ;remove : X (listof X) -> (listof X)
120 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.
122 12687dd9 2023-08-04 jrmu (define (remove x alox)
124 12687dd9 2023-08-04 jrmu [(empty? alox) empty]
125 12687dd9 2023-08-04 jrmu [(equal? x (first alox)) (rest alox)]
126 12687dd9 2023-08-04 jrmu [else (cons (first alox)
127 12687dd9 2023-08-04 jrmu (remove x (rest alox)))]))
128 12687dd9 2023-08-04 jrmu (equal? (find-route 'B 'C Graph2) '(B E C))
