fork download
  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
stdin
Standard input is empty
stdout
(#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))