f36ebf649961

Merge.
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 06 Mar 2018 13:40:45 -0500
parents 3a158acd5a99 (diff) 8629de8c693b (current diff)
children 6310aa56fed7
branches/tags (none)
files src/problems.lisp src/utils.lisp

Changes

--- a/src/problems.lisp	Mon Feb 26 06:58:59 2018 +0000
+++ b/src/problems.lisp	Tue Mar 06 13:40:45 2018 -0500
@@ -1765,18 +1765,20 @@
                    (collect line))))
          (rows (array-dimension data 0))
          (cols (array-dimension data 1))
+         (last-row (1- rows))
+         (last-col (1- cols))
          (down (vec2 0 1))
          (right (vec2 1 0))
          (top-left (vec2 0 0))
-         (bottom-right (vec2 (1- cols) (1- rows)))
+         (bottom-right (vec2 last-col last-row))
          (minimum-value (iterate (for value :in-array data)
                                  (minimizing value))))
     (labels ((value-at (point)
                (aref data (vy point) (vx point)))
              (neighbors (point)
-               (remove nil (list (when (< (vx point) (1- cols))
+               (remove nil (list (when (< (vx point) last-col)
                                    (vec2+ point right))
-                                 (when (< (vy point) (1- rows))
+                                 (when (< (vy point) last-row)
                                    (vec2+ point down)))))
              (remaining-moves (point)
                (+ (- cols (vx point))
@@ -1786,9 +1788,9 @@
              (cost (prev point)
                (declare (ignore prev))
                (value-at point)))
-      (summation (astar :start (list top-left)
+      (summation (astar :start top-left
                         :neighbors #'neighbors
-                        :goal-p (curry #'vec2= bottom-right)
+                        :goalp (curry #'vec2= bottom-right)
                         :cost #'cost
                         :heuristic #'heuristic
                         :test #'equalp)
@@ -1811,36 +1813,43 @@
                    (collect line))))
          (rows (array-dimension data 0))
          (cols (array-dimension data 1))
+         (last-row (1- rows))
+         (last-col (1- cols))
          (up (vec2 0 -1))
          (down (vec2 0 1))
          (right (vec2 1 0))
          (minimum-value (iterate (for value :in-array data)
                                  (minimizing value))))
+    ;; We can still use A*, we just need to do a little hack to allow it to
+    ;; choose anything in the first column as a starting state: we'll make the
+    ;; starting state NIL and make everything in the first column its neighbors.
     (labels ((value-at (point)
                (aref data (vy point) (vx point)))
              (neighbors (point)
-               (remove nil (list (when (< (vx point) (1- cols))
-                                   (vec2+ point right))
-                                 (when (< 0 (vy point))
-                                   (vec2+ point up))
-                                 (when (< (vy point) (1- rows))
-                                   (vec2+ point down)))))
+               (if (null point)
+                 (mapcar (curry #'vec2 0) (range 0 rows))
+                 (remove nil (list (when (< (vx point) last-col)
+                                     (vec2+ point right))
+                                   (when (< 0 (vy point))
+                                     (vec2+ point up))
+                                   (when (< (vy point) last-row)
+                                     (vec2+ point down))))))
              (remaining-moves (point)
                (+ (- cols (vx point))
                   (- rows (vy point))))
              (goalp (point)
-               (= (1- rows) (vx point)))
+               (and point (= last-col (vx point))))
              (heuristic (point)
                (* minimum-value (remaining-moves point)))
              (cost (prev point)
                (declare (ignore prev))
                (value-at point)))
-      (summation (astar :start (mapcar (curry #'vec2 0) (range 0 rows))
-                        :neighbors #'neighbors
-                        :goal-p #'goalp
-                        :cost #'cost
-                        :heuristic #'heuristic
-                        :test #'equalp)
+      (summation (rest (astar :start nil
+                              :neighbors #'neighbors
+                              :goalp #'goalp
+                              :cost #'cost
+                              :heuristic #'heuristic
+                              :test #'equalp))
                  :key #'value-at))))
 
 (defun problem-92 ()
--- a/src/utils.lisp	Mon Feb 26 06:58:59 2018 +0000
+++ b/src/utils.lisp	Tue Mar 06 13:40:45 2018 -0500
@@ -937,17 +937,17 @@
       (recur (path-previous path))))
   result)
 
-(defun astar (&key start neighbors goal-p cost heuristic test)
+(defun astar (&key start neighbors goalp cost heuristic test)
   "Search for a path from `start` to a goal using A★.
 
   The following parameters are all required:
 
-  * `start`: a sequence of starting states.
+  * `start`: the starting state.
 
   * `neighbors`: a function that takes a state and returns all states reachable
     from it.
 
-  * `goal-p`: a predicate that takes a state and returns whether it is a goal.
+  * `goalp`: a predicate that takes a state and returns whether it is a goal.
 
   * `cost`: a function that takes two states `a` and `b` and returns the cost
     to move from `a` to `b`.
@@ -974,8 +974,7 @@
                (mark-seen path)
                (pileup:heap-insert path frontier)))
       (iterate
-        (initially (doseq (state start)
-                     (push-path (make-path :state state))))
+        (initially (push-path (make-path :state start)))
 
         (for (values current found) = (pileup:heap-pop frontier))
         (unless found
@@ -983,7 +982,7 @@
 
         (for current-state = (path-state current))
 
-        (when (funcall goal-p current-state)
+        (when (funcall goalp current-state)
           (return (values (path-to-list current) t)))
 
         (for current-cost = (path-cost current))
@@ -999,4 +998,3 @@
                                   :cost next-cost
                                   :estimate next-estimate
                                   :previous current))))))))
-