fork(2) download
copy 
  1. ; penniless pilgrim
  2.  
  3. (define (show . x)
  4.   (for-each display x)
  5.   (newline))
  6.  
  7. (define (++ x) (+ 1 x))
  8. (define (-- x) (- x 1))
  9.  
  10. (define (street-name x0 y0 x1 y1)
  11.   (apply string-append
  12.          (if (or (and (< x0 x1) (= y0 y1))
  13.                  (and (< y0 y1) (= x0 x1)))
  14.            (list (number->string x0)
  15.                  ","
  16.                  (number->string y0)
  17.                  "-"
  18.                  (number->string x1)
  19.                  ","
  20.                  (number->string y1))
  21.            (list (number->string x1)
  22.                  ","
  23.                  (number->string y1)
  24.                  "-"
  25.                  (number->string x0)
  26.                  ","
  27.                  (number->string y0)))))
  28.  
  29.  
  30. (define (next-x x direction)
  31.   (case direction
  32.     ((east) (-- x))
  33.     ((west) (++ x))
  34.     (else x)))  
  35.  
  36. (define (next-y y direction)
  37.   (case direction
  38.     ((north) (++ y))
  39.     ((south) (-- y))
  40.     (else y)))
  41.  
  42. (define (next-street x y direction)
  43.   (street-name x y 
  44.                (next-x x direction)
  45.                (next-y y direction)))
  46.  
  47. (define (visited? x y direction history)
  48.     (member (next-street x y direction) history))
  49.  
  50. (define (can-walk-north? x y history)
  51.   (and (< y 4)
  52.        (not (visited? x y 'north history))))
  53.  
  54. (define (can-walk-south? x y history)
  55.   (and (> y 0)
  56.        (not (visited? x y 'south history))))
  57.  
  58. (define (can-walk-west? x y history)
  59.   (and (< x 4)
  60.        (not (visited? x y 'west history))))
  61.  
  62. (define (can-walk-east? x y history)
  63.   (and (> x 0)
  64.        (not (visited? x y 'east history))))
  65.  
  66. (define (arrived? x y)
  67.   (and (= x 0) (= y 0)))
  68.  
  69. (define (try direction x y owed walked)
  70.   (solve (next-x x direction)
  71.          (next-y y direction)
  72.          (case direction
  73.            ((south) (* owed 2))
  74.            ((north) (/ owed 2))
  75.            ((east) (+ owed 2))
  76.            ((west) (- owed 2)))
  77.          (cons (next-street x y direction)
  78.                walked)))
  79.  
  80. (define (solve x y owed walked)
  81.   (cond ((arrived? x y) (list (= owed 0) owed (reverse walked)))
  82.         (else
  83.          (let loop ((options
  84.                      (apply 
  85.                       append
  86.                       (list
  87.                        (if (can-walk-north? x y walked) '(north) '())
  88.                        (if (can-walk-south? x y walked) '(south) '())
  89.                        (if (can-walk-east? x y walked) '(east) '())
  90.                        (if (can-walk-west? x y walked) '(west) '())))))
  91.            (cond ((null? options)
  92.                   (list #f owed walked))
  93.                  (else
  94.                   (let ((attempt (try (car options) x y owed walked)))
  95.                     (if (car attempt)
  96.                       attempt
  97.                       (loop (cdr options))))))))))
  98.  
  99. (display (solve 2 4 4 '("2,4-3,4" "3,4-4,4"))) (newline)
Success #stdin #stdout 14.96s 9876KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(#t 0 (3,4-4,4 2,4-3,4 2,3-2,4 2,2-2,3 2,1-2,2 1,1-2,1 0,1-1,1 0,1-0,2 0,2-0,3 0,3-0,4 0,4-1,4 1,3-1,4 1,3-2,3 2,3-3,3 3,3-4,3 4,2-4,3 4,1-4,2 4,0-4,1 3,0-4,0 2,0-3,0 1,0-2,0 0,0-1,0))
https://ideone.com/UNB7Al
language:
Scheme (guile 2.2.4)
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!