428c6288f9e9

Optimize a bit
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Wed, 15 Dec 2021 22:58:47 -0500
parents f08be8f420ea
children e41337e3b59b
branches/tags (none)
files src/2021/days/day-15.lisp src/utils.lisp

Changes

--- 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.
--- 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