; penniless pilgrim
(define (add2 x) (+ x 2))
(define (sub2 x) (- x 2))
(define (halve x) (/ x 2))
(define (double x) (* x 2))
(define grid `(
(A (B ,add2) (F ,double) )
(B (A ,sub2) (C ,add2) (G ,double) )
(C (B ,sub2) (D ,add2) (H ,double) )
(D (C ,sub2) (E ,add2) (I ,double) )
(E (D ,sub2) (K ,double) )
(F (A ,halve) (G ,add2) (L ,double) )
(G (B ,halve) (F ,sub2) (H ,add2) (M ,double))
(H (C ,halve) (G ,sub2) (I ,add2) (N ,double))
(I (D ,halve) (H ,sub2) (K ,add2) (O ,double))
(K (E ,halve) (I ,sub2) (P ,double) )
(L (F ,halve) (M ,add2) (Q ,double) )
(M (G ,halve) (L ,sub2) (N ,add2) (R ,double))
(N (H ,halve) (M ,sub2) (O ,add2) (S ,double))
(O (I ,halve) (N ,sub2) (P ,add2) (T ,double))
(P (K ,halve) (O ,sub2) (U ,double) )
(Q (L ,halve) (R ,add2) (V ,double) )
(R (M ,halve) (Q ,sub2) (S ,add2) (W ,double))
(S (N ,halve) (R ,sub2) (T ,add2) (X ,double))
(T (O ,halve) (S ,sub2) (U ,add2) (Y ,double))
(U (P ,halve) (T ,sub2) (Z ,double) )
(V (Q ,halve) (W ,add2) )
(W (R ,halve) (V ,sub2) (X ,add2) )
(X (S ,halve) (W ,sub2) (Y ,add2) )
(Y (T ,halve) (X ,sub2) (Z ,add2) )
(Z (U ,halve) (Y ,sub2) )))
(define (follows? y x xs) ; does y follow x in list xs?
(if (null? xs) #f
(let loop ((xs xs))
(cond ((null? (cdr xs)) #f)
((and (equal? (car xs) x) (equal? (cadr xs) y)) #t)
(else (loop (cdr xs)))))))
(define (visited? from to path)
(or (follows? from to path) (follows? to from path)))
(define (extend cost-and-path paths)
(let ((cost (car cost-and-path))
(path (cdr cost-and-path))
(neighbors (cdr (assoc (cadr cost-and-path) grid))))
(let loop ((neighbors neighbors) (paths paths))
(cond ((null? neighbors) paths)
((not (visited? (car path) (caar neighbors) path))
(loop (cdr neighbors)
(cons (cons ((cadar neighbors) cost)
(cons (caar neighbors) path))
paths)))
(else (loop (cdr neighbors) paths))))))
(define (pilgrim paths)
(let loop ((paths paths))
(if (null? paths) #f
(let ((path (car paths)))
(if (and (zero? (car path)) (equal? (cadr path) 'Z))
(reverse (cdr path))
(loop (extend path (cdr paths))))))))
(display (pilgrim (cons '(4 C B A) (list)))) (newline)
OyBwZW5uaWxlc3MgcGlsZ3JpbQoKKGRlZmluZSAoYWRkMiB4KSAoKyB4IDIpKQooZGVmaW5lIChzdWIyIHgpICgtIHggMikpCihkZWZpbmUgKGhhbHZlIHgpICgvIHggMikpCihkZWZpbmUgKGRvdWJsZSB4KSAoKiB4IDIpKQoKKGRlZmluZSBncmlkIGAoCiAgKEEgKEIgLGFkZDIpICAgKEYgLGRvdWJsZSkgICAgICAgICAgICAgICAgICAgICAgICApCiAgKEIgKEEgLHN1YjIpICAgKEMgLGFkZDIpICAgKEcgLGRvdWJsZSkgICAgICAgICAgICApCiAgKEMgKEIgLHN1YjIpICAgKEQgLGFkZDIpICAgKEggLGRvdWJsZSkgICAgICAgICAgICApCiAgKEQgKEMgLHN1YjIpICAgKEUgLGFkZDIpICAgKEkgLGRvdWJsZSkgICAgICAgICAgICApCiAgKEUgKEQgLHN1YjIpICAgKEsgLGRvdWJsZSkgICAgICAgICAgICAgICAgICAgICAgICApCiAgKEYgKEEgLGhhbHZlKSAgKEcgLGFkZDIpICAgKEwgLGRvdWJsZSkgICAgICAgICAgICApCiAgKEcgKEIgLGhhbHZlKSAgKEYgLHN1YjIpICAgKEggLGFkZDIpICAgKE0gLGRvdWJsZSkpCiAgKEggKEMgLGhhbHZlKSAgKEcgLHN1YjIpICAgKEkgLGFkZDIpICAgKE4gLGRvdWJsZSkpCiAgKEkgKEQgLGhhbHZlKSAgKEggLHN1YjIpICAgKEsgLGFkZDIpICAgKE8gLGRvdWJsZSkpCiAgKEsgKEUgLGhhbHZlKSAgKEkgLHN1YjIpICAgKFAgLGRvdWJsZSkgICAgICAgICAgICApCiAgKEwgKEYgLGhhbHZlKSAgKE0gLGFkZDIpICAgKFEgLGRvdWJsZSkgICAgICAgICAgICApCiAgKE0gKEcgLGhhbHZlKSAgKEwgLHN1YjIpICAgKE4gLGFkZDIpICAgKFIgLGRvdWJsZSkpCiAgKE4gKEggLGhhbHZlKSAgKE0gLHN1YjIpICAgKE8gLGFkZDIpICAgKFMgLGRvdWJsZSkpCiAgKE8gKEkgLGhhbHZlKSAgKE4gLHN1YjIpICAgKFAgLGFkZDIpICAgKFQgLGRvdWJsZSkpCiAgKFAgKEsgLGhhbHZlKSAgKE8gLHN1YjIpICAgKFUgLGRvdWJsZSkgICAgICAgICAgICApCiAgKFEgKEwgLGhhbHZlKSAgKFIgLGFkZDIpICAgKFYgLGRvdWJsZSkgICAgICAgICAgICApCiAgKFIgKE0gLGhhbHZlKSAgKFEgLHN1YjIpICAgKFMgLGFkZDIpICAgKFcgLGRvdWJsZSkpCiAgKFMgKE4gLGhhbHZlKSAgKFIgLHN1YjIpICAgKFQgLGFkZDIpICAgKFggLGRvdWJsZSkpCiAgKFQgKE8gLGhhbHZlKSAgKFMgLHN1YjIpICAgKFUgLGFkZDIpICAgKFkgLGRvdWJsZSkpCiAgKFUgKFAgLGhhbHZlKSAgKFQgLHN1YjIpICAgKFogLGRvdWJsZSkgICAgICAgICAgICApCiAgKFYgKFEgLGhhbHZlKSAgKFcgLGFkZDIpICAgICAgICAgICAgICAgICAgICAgICAgICApCiAgKFcgKFIgLGhhbHZlKSAgKFYgLHN1YjIpICAgKFggLGFkZDIpICAgICAgICAgICAgICApCiAgKFggKFMgLGhhbHZlKSAgKFcgLHN1YjIpICAgKFkgLGFkZDIpICAgICAgICAgICAgICApCiAgKFkgKFQgLGhhbHZlKSAgKFggLHN1YjIpICAgKFogLGFkZDIpICAgICAgICAgICAgICApCiAgKFogKFUgLGhhbHZlKSAgKFkgLHN1YjIpICAgICAgICAgICAgICAgICAgICAgICAgICApKSkKCihkZWZpbmUgKGZvbGxvd3M/IHkgeCB4cykgOyBkb2VzIHkgZm9sbG93IHggaW4gbGlzdCB4cz8KICAoaWYgKG51bGw/IHhzKSAjZgogICAgKGxldCBsb29wICgoeHMgeHMpKQogICAgICAoY29uZCAoKG51bGw/IChjZHIgeHMpKSAjZikKICAgICAgICAgICAgKChhbmQgKGVxdWFsPyAoY2FyIHhzKSB4KSAoZXF1YWw/IChjYWRyIHhzKSB5KSkgI3QpCiAgICAgICAgICAgIChlbHNlIChsb29wIChjZHIgeHMpKSkpKSkpCgooZGVmaW5lICh2aXNpdGVkPyBmcm9tIHRvIHBhdGgpCiAgKG9yIChmb2xsb3dzPyBmcm9tIHRvIHBhdGgpIChmb2xsb3dzPyB0byBmcm9tIHBhdGgpKSkKCihkZWZpbmUgKGV4dGVuZCBjb3N0LWFuZC1wYXRoIHBhdGhzKQogIChsZXQgKChjb3N0IChjYXIgY29zdC1hbmQtcGF0aCkpCiAgICAgICAgKHBhdGggKGNkciBjb3N0LWFuZC1wYXRoKSkKICAgICAgICAobmVpZ2hib3JzIChjZHIgKGFzc29jIChjYWRyIGNvc3QtYW5kLXBhdGgpIGdyaWQpKSkpCiAgICAobGV0IGxvb3AgKChuZWlnaGJvcnMgbmVpZ2hib3JzKSAocGF0aHMgcGF0aHMpKQogICAgICAoY29uZCAoKG51bGw/IG5laWdoYm9ycykgcGF0aHMpCiAgICAgICAgICAgICgobm90ICh2aXNpdGVkPyAoY2FyIHBhdGgpIChjYWFyIG5laWdoYm9ycykgcGF0aCkpCiAgICAgICAgICAgICAgKGxvb3AgKGNkciBuZWlnaGJvcnMpCiAgICAgICAgICAgICAgICAgICAgKGNvbnMgKGNvbnMgKChjYWRhciBuZWlnaGJvcnMpIGNvc3QpCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKGNvbnMgKGNhYXIgbmVpZ2hib3JzKSBwYXRoKSkKICAgICAgICAgICAgICAgICAgICAgICAgICBwYXRocykpKQogICAgICAgICAgICAoZWxzZSAobG9vcCAoY2RyIG5laWdoYm9ycykgcGF0aHMpKSkpKSkKCihkZWZpbmUgKHBpbGdyaW0gcGF0aHMpCiAgKGxldCBsb29wICgocGF0aHMgcGF0aHMpKQogICAgKGlmIChudWxsPyBwYXRocykgI2YKICAgICAgKGxldCAoKHBhdGggKGNhciBwYXRocykpKQogICAgICAgIChpZiAoYW5kICh6ZXJvPyAoY2FyIHBhdGgpKSAoZXF1YWw/IChjYWRyIHBhdGgpICdaKSkKICAgICAgICAgICAgKHJldmVyc2UgKGNkciBwYXRoKSkKICAgICAgICAgICAgKGxvb3AgKGV4dGVuZCBwYXRoIChjZHIgcGF0aHMpKSkpKSkpKQoKKGRpc3BsYXkgKHBpbGdyaW0gKGNvbnMgJyg0IEMgQiBBKSAobGlzdCkpKSkgKG5ld2xpbmUp