fork download
copy 
  1. (defparameter *sample-input*
  2.   "(2,0)
  3.  e se se sw  s
  4.  s nw nw  n  w
  5. ne  s  h  e sw
  6. se  n  w ne sw
  7. ne nw nw  n  n"
  8.   "Challenge input.")
  9.  
  10. (defun parse-coord-string (coord)
  11.   "Convert an (X, Y) coordinate pair into a list consisting of (X Y)."
  12.   (with-input-from-string (coord-stream (substitute #\Space #\, coord))
  13. 	(read coord-stream)))
  14.  
  15. (defun split-seq (splitp seq)
  16.   "Split SEQ into chunks based on SPLITP."
  17.   (loop
  18. 	 for beg = (position-if-not splitp seq)
  19. 	 then (position-if-not splitp seq :start (1+ end))
  20. 	 for end = (and beg (position-if splitp seq :start beg))
  21. 	 if beg collect (subseq seq beg end)
  22. 	 while end))
  23.  
  24. (defun 2d-array-find (item arr &key (test #'eql))
  25.   "Returns a list of (X Y) coordinates if ITEM is found in ARR."
  26.   (loop named outer-loop
  27. 	 for y below (array-dimension arr 0) do
  28. 	   (loop for x below (array-dimension arr 1)
  29. 	      if (funcall test (aref arr y x) item)
  30. 	      do (return-from outer-loop (list x y)))))
  31.  
  32. (defun points-that-could-reach-coord (arr coord)
  33.   (destructuring-bind (coord-x coord-y) coord
  34. 	(loop for y below (array-dimension arr 0) nconc
  35. 	     (loop
  36. 		for x below (array-dimension arr 1)
  37. 		for dir = (aref arr y x)
  38. 		for x-delta = (- x coord-x)
  39. 		for y-delta = (- y coord-y)
  40. 		if (or (and (zerop x-delta)
  41. 			    (or (and (string= dir "s")
  42. 				     (minusp y-delta))
  43. 				(and (string= dir "n")
  44. 				     (plusp y-delta))))
  45. 		       (and (zerop y-delta)
  46. 			    (or (and (string= dir "e")
  47. 				     (minusp x-delta))
  48. 				(and (string= dir "w")
  49. 				     (plusp x-delta))))
  50. 		       (and (= (abs x-delta) (abs y-delta))
  51. 			    ; PLUSP and MINUSP ensure that neither is ZEROP
  52. 			    (or (and (string= "se" dir) (minusp y-delta) (minusp x-delta))
  53. 				(and (string= "sw" dir) (minusp y-delta) (plusp x-delta))
  54. 				(and (string= "ne" dir) (plusp y-delta) (minusp x-delta))
  55. 				(and (string= "nw" dir) (plusp y-delta) (plusp x-delta)))))
  56. 		collect (list x y)))))
  57.  
  58. (defun arrayify-maze (maze)
  59.   (let ((maze-list (mapcar (lambda (x)
  60. 				 (split-seq (lambda (y) (char= #\Space y)) x))
  61. 			       maze)))
  62. 	(make-array (list (length maze-list)
  63. 			  (length (car maze-list)))
  64. 		    :initial-contents maze-list)))
  65.  
  66. (defun solve-maze (maze destination start-point)
  67.   (labels ((%solve-maze (maze destination point-list potential-points)
  68. 		 (cond ((equal destination (car point-list))
  69. 			point-list)
  70. 		       ((null potential-points)
  71. 			nil)
  72. 		       ((null (car point-list))
  73. 			(%solve-maze maze
  74. 				     destination
  75. 				     (cdr point-list)
  76. 				     (cdr potential-points)))
  77. 		       (t
  78. 			(%solve-maze maze
  79. 				     destination
  80. 				     (cons (car potential-points) point-list)
  81. 				     (remove-if (lambda (x) (member x point-list :test #'equal))
  82. 						(points-that-could-reach-coord maze (car potential-points))))))))
  83. 	(%solve-maze maze destination (list start-point)
  84. 		     (points-that-could-reach-coord maze start-point))))
  85.  
  86. (defun show-map-solution (in)
  87.   (destructuring-bind (start-coord &rest maze)
  88. 	  (split-seq (lambda (x) (char= #\Newline x)) in)
  89. 	(let* ((start-coord (parse-coord-string start-coord))
  90. 	       (maze-array (arrayify-maze maze))
  91. 	       (home-pos (2d-array-find "h" maze-array :test #'string=)))
  92. 	  (format t "~{(~{~d~^, ~})~%~}"
  93. 		  (solve-maze maze-array start-coord home-pos)))))
  94.  
  95. (show-map-solution *sample-input*)
Success #stdin #stdout 0s 203840KB
comments ()
stdin
copy 
Standard input is empty
stdout
copy 
(2, 0)
(4, 2)
(2, 4)
(0, 2)
(1, 1)
(0, 0)
(4, 0)
(4, 1)
(0, 1)
(0, 4)
(2, 2)
https://ideone.com/LaZuSg
language:
Common Lisp (sbcl 1.4.16)
created:
7 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!