From e008f79bf437f5faee5669328f1add8cde563eed Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Mon, 18 Dec 2023 03:03:48 +0100
Subject: part 2

---
 AoC2023/day17/solver.lisp | 43 +++++++++++++++++++++++++++----------------
 1 file changed, 27 insertions(+), 16 deletions(-)

(limited to 'AoC2023')

diff --git a/AoC2023/day17/solver.lisp b/AoC2023/day17/solver.lisp
index 7001eb8..a3c47f6 100644
--- a/AoC2023/day17/solver.lisp
+++ b/AoC2023/day17/solver.lisp
@@ -34,19 +34,19 @@
     (dw 'up)
     (lf 'rt)))
 
-(defun next-moves (field tried walker)
+(defun next-moves (field tried walker turn-condition)
   (destructuring-bind (track dir row col) walker
     (arrows:->>
      (remove dir '(rt dw lf up) :key #'backtrack)
      (mapcar (lambda (d)
-               (unless (and (eq d dir) (<= 2 track))
-                 (destructuring-bind (ndir . np) (advance row col d)
-                   (when (in-bounds field np)
-                     (let* ((nt (if (eq ndir dir) (1+ track) 0))
-                            (npath (list* nt ndir np)))
-                       (unless (gethash npath tried)
-                         (setf (gethash npath tried) t)
-                         npath)))))))
+               (let ((nt (if (eq d dir) (1+ track) 0)))
+                 (when (funcall turn-condition d dir (1+ track))
+                   (destructuring-bind (ndir . np) (advance row col d)
+                     (when (in-bounds field np)
+                       (let ((npath (list* nt ndir np)))
+                         (unless (gethash npath tried)
+                           (setf (gethash npath tried) t)
+                           npath))))))))
      (delete nil))))
 
 (defun finish-p (field step)
@@ -58,22 +58,33 @@
 (defun vdequeue (q)
   (cl-heap:pop-heap (slot-value q 'cl-heap:heap)))
 
-(defun walk (options known field)
+(defun walk (options known field turn-condition)
   (loop for (pcost current) = (vdequeue options)
         while current
         until (finish-p field current)
-        do (dolist (next (next-moves field known current))
+        do (dolist (next (next-moves field known current turn-condition))
              (cl-heap:enqueue options next (+ (apply #'aref field (cddr next)) pcost)))
         finally (return pcost)))
 
-(defun solver (filename)
+(defun part1-turn (d dir track)
+  (or (not (eq d dir)) (< track 3)))
+
+(defun part2-turn (d dir track)
+  (or (and (not (eq d dir))
+           (>= track 4))
+      (and (eq d dir)
+           (< track 10))))
+
+(defun solver (filename turn-condition)
   (let* ((field (parse-input filename))
          (options (make-instance 'cl-heap:priority-queue))
          (known (make-hash-table :test #'equal))
-         (w (list -1 'rt 0 0)))
+         (w (list 10 'rest 0 0)))
     (cl-heap:enqueue options w 0)
-    (walk options known field)))
+    (walk options known field turn-condition)))
 
 (fiveam:test solutions
-  (fiveam:is (= 102 (solver "eg-in")))
-  (fiveam:is (= 963 (solver "input"))))
+  (fiveam:is (= 102 (solver "eg-in" #'part1-turn)))
+  (fiveam:is (= 963 (solver "input" #'part1-turn)))
+  (fiveam:is (= 94  (solver "eg-in" #'part2-turn)))
+  (fiveam:is (= 1178 (solver "input" #'part2-turn))))
-- 
cgit v1.2.3