fork download
copy 
  1. ; penniless pilgrim
  2.  
  3. (define (add2 x) (+ x 2))
  4. (define (sub2 x) (- x 2))
  5. (define (halve x) (/ x 2))
  6. (define (double x) (* x 2))
  7.  
  8. (define grid `(
  9.   (A (B ,add2)   (F ,double)                        )
  10.   (B (A ,sub2)   (C ,add2)   (G ,double)            )
  11.   (C (B ,sub2)   (D ,add2)   (H ,double)            )
  12.   (D (C ,sub2)   (E ,add2)   (I ,double)            )
  13.   (E (D ,sub2)   (K ,double)                        )
  14.   (F (A ,halve)  (G ,add2)   (L ,double)            )
  15.   (G (B ,halve)  (F ,sub2)   (H ,add2)   (M ,double))
  16.   (H (C ,halve)  (G ,sub2)   (I ,add2)   (N ,double))
  17.   (I (D ,halve)  (H ,sub2)   (K ,add2)   (O ,double))
  18.   (K (E ,halve)  (I ,sub2)   (P ,double)            )
  19.   (L (F ,halve)  (M ,add2)   (Q ,double)            )
  20.   (M (G ,halve)  (L ,sub2)   (N ,add2)   (R ,double))
  21.   (N (H ,halve)  (M ,sub2)   (O ,add2)   (S ,double))
  22.   (O (I ,halve)  (N ,sub2)   (P ,add2)   (T ,double))
  23.   (P (K ,halve)  (O ,sub2)   (U ,double)            )
  24.   (Q (L ,halve)  (R ,add2)   (V ,double)            )
  25.   (R (M ,halve)  (Q ,sub2)   (S ,add2)   (W ,double))
  26.   (S (N ,halve)  (R ,sub2)   (T ,add2)   (X ,double))
  27.   (T (O ,halve)  (S ,sub2)   (U ,add2)   (Y ,double))
  28.   (U (P ,halve)  (T ,sub2)   (Z ,double)            )
  29.   (V (Q ,halve)  (W ,add2)                          )
  30.   (W (R ,halve)  (V ,sub2)   (X ,add2)              )
  31.   (X (S ,halve)  (W ,sub2)   (Y ,add2)              )
  32.   (Y (T ,halve)  (X ,sub2)   (Z ,add2)              )
  33.   (Z (U ,halve)  (Y ,sub2)                          )))
  34.  
  35. (define (follows? y x xs) ; does y follow x in list xs?
  36.   (if (null? xs) #f
  37.     (let loop ((xs xs))
  38.       (cond ((null? (cdr xs)) #f)
  39.             ((and (equal? (car xs) x) (equal? (cadr xs) y)) #t)
  40.             (else (loop (cdr xs)))))))
  41.  
  42. (define (visited? from to path)
  43.   (or (follows? from to path) (follows? to from path)))
  44.  
  45. (define (extend cost-and-path paths)
  46.   (let ((cost (car cost-and-path))
  47.         (path (cdr cost-and-path))
  48.         (neighbors (cdr (assoc (cadr cost-and-path) grid))))
  49.     (let loop ((neighbors neighbors) (paths paths))
  50.       (cond ((null? neighbors) paths)
  51.             ((not (visited? (car path) (caar neighbors) path))
  52.               (loop (cdr neighbors)
  53.                     (cons (cons ((cadar neighbors) cost)
  54.                                 (cons (caar neighbors) path))
  55.                           paths)))
  56.             (else (loop (cdr neighbors) paths))))))
  57.  
  58. (define (pilgrim paths)
  59.   (let loop ((paths paths))
  60.     (if (null? paths) #f
  61.       (let ((path (car paths)))
  62.         (if (and (zero? (car path)) (equal? (cadr path) 'Z))
  63.             (reverse (cdr path))
  64.             (loop (extend path (cdr paths))))))))
  65.  
  66. (display (pilgrim (cons '(4 C B A) (list)))) (newline)
Success #stdin #stdout 5.25s 8996KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(A B C H N S T U P K E D I H G F L Q V W X Y Z)
https://ideone.com/wdZ7Te
language:
Scheme (chicken 4.13)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!