# HG changeset patch # User Steve Losh # Date 1520361645 18000 # Node ID f36ebf649961b8311e6bbc2ea7ecb3a9b6c579a2 # Parent 3a158acd5a99246abdc56c7bd871d95af97ffc25# Parent 8629de8c693bef9dd9dcd59c1c304ffad0a17d18 Merge. diff -r 8629de8c693b -r f36ebf649961 src/problems.lisp --- 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 () diff -r 8629de8c693b -r f36ebf649961 src/utils.lisp --- 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)))))))) -