# HG changeset patch # User Steve Losh # Date 1639627127 18000 # Node ID 428c6288f9e9aadec6fd0998afe9e04bd0869b09 # Parent f08be8f420ea4e1d25175b275064efab48150fa6 Optimize a bit diff -r f08be8f420ea -r 428c6288f9e9 src/2021/days/day-15.lisp --- a/src/2021/days/day-15.lisp Wed Dec 15 19:32:47 2021 -0500 +++ b/src/2021/days/day-15.lisp Wed Dec 15 22:58:47 2021 -0500 @@ -1,31 +1,39 @@ (advent:defpackage* :advent/2021/15) (in-package :advent/2021/15) -(defun-inline cref (array coord) - (aref array (realpart coord) (imagpart coord))) + +(defun-inline coord (row col) + (cons row col)) -(defun-inline validp (array coord) - (array-in-bounds-p array (realpart coord) (imagpart coord))) +(defun-inline coord= (a b) + (and (= (car a) (car b)) + (= (cdr a) (cdr b)))) + +(defun-inline cref (array coord) + (aref array (car coord) (cdr coord))) + +(defun-inline (setf cref) (value array coord) + (setf (aref array (car coord) (cdr coord)) value)) (defun-inline neighbors (array coord) - (loop :for δ in '(#c(-1 0) #c(1 0) #c(0 -1) #c(0 1)) - :for n = (+ coord δ) - :when (validp array n) :collect n)) - -(defun cost (data from to) - (declare (ignore from)) - (cref data to)) + (loop :for δ in '((-1 . 0) (1 . 0) (0 . -1) (0 . 1)) + :for r = (+ (car coord) (car δ)) + :for c = (+ (cdr coord) (cdr δ)) + :when (array-in-bounds-p array r c) + :collect (coord r c))) (defun find-path (data) - (declare (inline dijkstra curry) - (optimize (speed 3) (debug 1) (safety 1))) - (let ((goal (complex (1- (array-dimension data 0)) - (1- (array-dimension data 1))))) - (astar :start #c(0 0) - :neighbors (curry #'neighbors data) - :goalp (curry #'= goal) - :cost (curry #'cost data) - :test #'eql + (declare (inline astar) (optimize (speed 3) (debug 1) (safety 1))) + (let ((seen (make-array (array-dimensions data) :initial-element nil)) + (goal (coord (1- (array-dimension data 0)) + (1- (array-dimension data 1))))) + (astar :test #'equal + :start (coord 0 0) + :neighbors (lambda (state) (neighbors data state)) + :goalp (lambda (state) (coord= goal state)) + :cost (lambda (from to) (declare (ignore from)) (cref data to)) + :get-seen (lambda (state) (cref seen state)) + :set-seen (lambda (state cost) (setf (cref seen state) cost)) ;; Manhattan distance is the only candidate for a heuristic, but for ;; this problem it's not particularly helpful and slows things down. ;; Just use a constant and degrade to Dijkstra. diff -r f08be8f420ea -r 428c6288f9e9 src/utils.lisp --- a/src/utils.lisp Wed Dec 15 19:32:47 2021 -0500 +++ b/src/utils.lisp Wed Dec 15 22:58:47 2021 -0500 @@ -891,7 +891,8 @@ (recur (path-previous path)))) result) -(defun-inlineable astar (&key start neighbors goalp cost heuristic test limit) +(defun-inlineable astar (&key start neighbors goalp cost heuristic test limit + get-seen set-seen) "Search for a path from `start` to a goal using A★. The following parameters are all required: @@ -925,13 +926,26 @@ * `limit`: a maximum cost. Any paths that exceed this cost will not be considered. + * `set-seen`: a function that takes a state and a cost, and records it. + If not provided a hash table will be used, but sometimes (depending on what + your states are) it can be faster to store visited nodes more efficiently. + + * `get-seen`: a function that takes a state and retrieves the stored cost, or + `nil` if the state has not been seen. + " - (let ((seen (make-hash-table :test test)) + (let ((seen (unless get-seen (make-hash-table :test test))) (frontier (pileup:make-heap #'< :key #'path-estimate))) - (labels ((mark-seen (path) - (setf (gethash (path-state path) seen) (path-cost path))) + (labels ((set-seen% (path) + (if set-seen + (funcall set-seen (path-state path) (path-cost path)) + (setf (gethash (path-state path) seen) (path-cost path)))) + (get-seen% (state) + (if get-seen + (funcall get-seen state) + (gethash state seen))) (push-path (path) - (mark-seen path) + (set-seen% path) (pileup:heap-insert path frontier))) (iterate (initially (push-path (make-path :state start))) @@ -950,10 +964,9 @@ (iterate (for next-state :in (funcall neighbors current-state)) (for next-cost = (+ current-cost (funcall cost current-state next-state))) - (for (values seen-cost previously-seen) = (gethash next-state seen)) + (for seen-cost = (get-seen% next-state)) (unless (and limit (> next-cost limit)) - (when (or (not previously-seen) - (< next-cost seen-cost)) + (when (or (null seen-cost) (< next-cost seen-cost)) (for next-estimate = (+ next-cost (funcall heuristic next-state))) (push-path (make-path :state next-state :cost next-cost