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-advanced-reader.ss" "lang")((modname |29.3|) (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 #t #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 G1
 5 12687dd9 2023-08-04 jrmu   '((A (B E))
 6 12687dd9 2023-08-04 jrmu     (B (E F))
 7 12687dd9 2023-08-04 jrmu     (C (D))
 8 12687dd9 2023-08-04 jrmu     (D ())
 9 12687dd9 2023-08-04 jrmu     (E (C F))
10 12687dd9 2023-08-04 jrmu     (F (D G))
11 12687dd9 2023-08-04 jrmu     (G ())))
12 12687dd9 2023-08-04 jrmu 
13 12687dd9 2023-08-04 jrmu (define G2 (vector '(1 4)
14 12687dd9 2023-08-04 jrmu                    '(4 5)
15 12687dd9 2023-08-04 jrmu                    '(3)
16 12687dd9 2023-08-04 jrmu                    empty
17 12687dd9 2023-08-04 jrmu                    '(2 5)
18 12687dd9 2023-08-04 jrmu                    '(3 6)
19 12687dd9 2023-08-04 jrmu                    empty))
20 12687dd9 2023-08-04 jrmu 
21 12687dd9 2023-08-04 jrmu (define (find-route1 ori dest G)
22 12687dd9 2023-08-04 jrmu   (local ((define (find-route ori dest G)
23 12687dd9 2023-08-04 jrmu             (cond
24 12687dd9 2023-08-04 jrmu               [(symbol=? ori dest) (list ori)]
25 12687dd9 2023-08-04 jrmu               [else (local ((define possible-route (find-route/list (neighbors ori G) dest G)))
26 12687dd9 2023-08-04 jrmu                       (cond
27 12687dd9 2023-08-04 jrmu                         [(boolean? possible-route) false]
28 12687dd9 2023-08-04 jrmu                         [else (cons ori possible-route)]))]))
29 12687dd9 2023-08-04 jrmu           (define (find-route/list lo-ori dest G)
30 12687dd9 2023-08-04 jrmu             (cond
31 12687dd9 2023-08-04 jrmu               [(empty? lo-ori) false]
32 12687dd9 2023-08-04 jrmu               [else (local ((define possible-route (find-route (first lo-ori) dest G)))
33 12687dd9 2023-08-04 jrmu                       (cond [(boolean? possible-route) (find-route/list (rest lo-ori) dest G)]
34 12687dd9 2023-08-04 jrmu                             [else possible-route]))]))
35 12687dd9 2023-08-04 jrmu           (define (assf op aloxy)
36 12687dd9 2023-08-04 jrmu             (cond
37 12687dd9 2023-08-04 jrmu               [(empty? aloxy) false]
38 12687dd9 2023-08-04 jrmu               [(op (first (first aloxy))) (first aloxy)]
39 12687dd9 2023-08-04 jrmu               [else (assf op (rest aloxy))]))
40 12687dd9 2023-08-04 jrmu           (define (neighbors anode G)
41 12687dd9 2023-08-04 jrmu             (first (rest (assf (lambda (x) (equal? anode x)) G)))))
42 12687dd9 2023-08-04 jrmu     (find-route ori dest G)))
43 12687dd9 2023-08-04 jrmu 
44 12687dd9 2023-08-04 jrmu (define (find-route2 ori dest G)
45 12687dd9 2023-08-04 jrmu   (local ((define (find-route ori dest G)
46 12687dd9 2023-08-04 jrmu             (cond
47 12687dd9 2023-08-04 jrmu               [(= ori dest) (list ori)]
48 12687dd9 2023-08-04 jrmu               [else (local ((define possible-route (find-route/list (neighbors ori G) dest G)))
49 12687dd9 2023-08-04 jrmu                       (cond [(boolean? possible-route) false]
50 12687dd9 2023-08-04 jrmu                             [else (cons ori possible-route)]))]))
51 12687dd9 2023-08-04 jrmu           (define (find-route/list lo-ori dest G)
52 12687dd9 2023-08-04 jrmu             (cond
53 12687dd9 2023-08-04 jrmu               [(empty? lo-ori) false]
54 12687dd9 2023-08-04 jrmu               [else (local ((define possible-route (find-route (first lo-ori) dest G)))
55 12687dd9 2023-08-04 jrmu                       (cond
56 12687dd9 2023-08-04 jrmu                         [(boolean? possible-route) (find-route/list (rest lo-ori) dest G)]
57 12687dd9 2023-08-04 jrmu                         [else possible-route]))]))
58 12687dd9 2023-08-04 jrmu           (define (neighbors anode agraph)
59 12687dd9 2023-08-04 jrmu             (vector-ref agraph anode)))
60 12687dd9 2023-08-04 jrmu     (find-route ori dest G)))
61 12687dd9 2023-08-04 jrmu 
62 12687dd9 2023-08-04 jrmu (define n 100000)
63 12687dd9 2023-08-04 jrmu (time (andmap (lambda (x) (equal? (find-route1 'A 'G G1)
64 12687dd9 2023-08-04 jrmu                                   (list 'A 'B 'E 'F 'G))) (build-list n identity)))
65 12687dd9 2023-08-04 jrmu (time (andmap (lambda (x) (equal? (find-route2 0 6 G2)
66 12687dd9 2023-08-04 jrmu                                   (list 0 1 4 5 6))) (build-list n identity)))