## Blob

1 ;; The first three lines of this file were inserted by DrScheme. They record metadata2 ;; 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 Graph15 '((A (B E))6 (B (E F))7 (C (D))8 (D ())9 (E (C F))10 (F (D G))11 (G ())))12 (define Graph213 '((A (B E))14 (B (E F))15 (C (B D))16 (D ())17 (E (C F))18 (F (D G))19 (G ())))22 ;A node is a symbol.23 ;24 ;A path is a list of the form25 ;(cons no lon)26 ;where no is a node and lon is a (listof nodes).27 ;28 ;A graph is either29 ;1. empty or30 ;2. (cons pa gr)31 ;where pa is a path and gr is a graph.33 ;find-route : node node graph -> (listof nodes) or false34 ;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 ;find-route/list : (listof nodes) node graph -> (listof nodes) or false37 ;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 ;neighbors : node graph -> (listof nodes)40 ;Given anode and G, find all the neighboring nodes of anode in G. If there are no neighboring nodes, return empty.42 ;; assf : (X -> boolean) (listof (list X Y)) -> (list X Y) or false43 ;; to find the first item on alop for whose first item p? holds45 ;(find-route 'A 'G Graph)46 ;(find-route 'C 'G Graph)48 ;A node-path is a list49 ;(cons no1 no2 lon)50 ;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 ;test-on-all-nodes : graph -> (listof (listof node-path))53 ;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 ;find-route : node node graph -> (listof nodes) or false57 ;extract-nodes : graph -> (listof nodes)58 ;Extracts the nodes from G and returns them as a (listof nodes).60 ;generate-pairs : (listof nodes) -> (listof (listof nodes))61 ;Generates all possible pairs of nodes from alon and returns it as a (listof (listof nodes)), each element containing a pair of nodes.63 ;generate-pairs : (listof nodes) (listof nodes) -> (listof (listof nodes))64 ;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 ;pair : node (listof nodes) -> (listof (listof nodes))67 ;Given anode and alon, generate all possible pairs of anode with elements in alon.69 ;remove : X (listof X) -> (listof X)70 ;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 (define (find-route ori dest G)73 (cond74 [(symbol=? ori dest) (list ori)]75 [else76 (local (78 (define (assf op aloxy)79 (cond80 [(empty? aloxy) false]81 [(op (first (first aloxy))) (first aloxy)]82 [else (assf op (rest aloxy))]))83 (define neighbors84 (first (rest (assf (lambda (x) (equal? ori x)) G))))85 (define (find-route/list neighbors)86 (cond87 [(empty? neighbors) false]88 [else (local ((define possible-route (find-route (first neighbors) dest G)))89 (cond [(boolean? possible-route) (find-route/list (rest neighbors))]90 [else possible-route]))]))91 (define possible-route (find-route/list neighbors)))92 (cond93 [(boolean? possible-route) false]94 [else (cons ori possible-route)]))]))99 (define (test-on-all-nodes G)100 (map (lambda (x)101 (list (first x)102 (second x)103 (find-route (first x) (second x) G)))104 (generate-pairs (extract-nodes G))))106 (define (extract-nodes G)107 (map (lambda (x) (first x)) G))109 (define (generate-pairs alon)110 (local ((define (generate-pairs current-lon complete-lon)111 (cond112 [(empty? current-lon) empty]113 [else (append (pair (first current-lon)114 (remove (first current-lon) complete-lon))115 (generate-pairs (rest current-lon) complete-lon))])))116 (generate-pairs alon alon)))118 (define (pair anode alon)119 (cond120 [(empty? alon) empty]121 [else (cons (list anode (first alon))122 (pair anode (rest alon)))]))124 (define (remove x alox)125 (cond126 [(empty? alox) empty]127 [(equal? x (first alox)) (rest alox)]128 [else (cons (first alox)129 (remove x (rest alox)))]))130 (equal? (find-route 'B 'C Graph2) '(B E C))131 (find-route 'B 'F Graph1)