refactored and redesign data structures runs now in 2s

src/2024/day06.lisp

@@ -1,4 +1,4 @@
-(declaim (optimize (speed 3) (debug 0) (safety 0)))
+					;(declaim (optimize (speed 3) (debug 0) (safety 0)))
 
 (defpackage :aoc/2024/06
   (:use :cl :aoc :alexandria :trivia)
@@ -12,15 +12,24 @@
 (in-package :aoc/2024/06)
 
 
+(defun list-of-strings-p (list)
+  "Return t if LIST is non nil and contains only strings."
+  (and (consp list)
+       (every #'stringp list)))
+
+(deftype list-of-strings ()
+  `(satisfies list-of-strings-p))
 
 
-
+(declaim (ftype (function (list-of-strings) (simple-array standard-char (* *)))))
 (defun parse-input (lines)
   (let ((l (length lines)))
     (make-array (list l l)
 		:initial-contents (mapcar (lambda (s) (coerce s 'list)) lines))))
 
+(declaim (type list-of-strings input-text))
 (defparameter input-text (test-input 2024 6))
+(declaim (type (simple-array standard-char (* *)) input-data))
 (defparameter input-data 
   (parse-input (test-input 2024 6)))
 
@@ -35,88 +44,104 @@
 #.........
 ......#...
 "))
+
+
 (defparameter sample-data 
   (parse-input sample-text))
+(deftype direction () '(member :north :east :south :west))
+(defstruct guard
+  (x 0 :type fixnum)
+  (y 0 :type fixnum)
+  (dir :north :type direction))
 
-(defun make-guard (pos direction)
-  (list pos direction))
 
-(defun guardp (labo pos)
-  (eq #\^ (aref labo (second pos) (first pos))))
-
-(defun blockedp (labo pos)
-  (eq #\# (aref labo (second pos) (first pos))))
+(defun blockedp (labo g &optional extra-block)
+  (or (eq #\# (aref labo (guard-y g) (guard-x g)))
+      (and
+       extra-block
+       (eq (guard-x g) (car extra-block))
+       (eq (guard-y g) (cdr extra-block)))))
 
 (defun find-guard (labo)
-  (make-guard
-   (loop for x from 0 to (1- (array-dimension labo 0))
-	 for guard-pos =			(loop for y from 0 to (1- (array-dimension labo 1))
-						      for pos = (list x y)
-						      if (guardp labo pos)
-							return pos)
-	 if guard-pos
-	   return guard-pos)
-   :north))
+  (declare (type (array t (* *)) labo))
+  (first (loop for x from 0 to (1- (array-dimension labo 0))
+	       append (loop for y from 0 to (1- (array-dimension labo 1))
+			    if (eq #\^ (aref labo y x))
+			      collect (make-guard :x x :y y :dir :north)))))
 
-(defun move (pos direction)
-  (destructuring-bind (x y) pos
-    (case direction
-      (:north (list x (1- y)))
-      (:east (list (1+ x) y))
-      (:south (list x (1+ y)))
-      (:west (list (1- x) y)))))
+(defun move (g)
+  (declare (type guard g))
+  (let ((dir (guard-dir g)))
+    (case dir
+      (:north (make-guard :x (guard-x g)      :y (1- (guard-y g)) :dir dir))
+      (:east  (make-guard :x (1+ (guard-x g)) :y (guard-y g)     :dir dir))
+      (:south (make-guard :x (guard-x g)      :y (1+ (guard-y g)) :dir dir))
+      (:west  (make-guard :x (1- (guard-x g)) :y (guard-y g)      :dir dir)))))
 
-(defun out-labop (labo pos)
-  (destructuring-bind (x y) pos
-    (or
-     (< x 0)
-     (< y 0)
-     (>= x (array-dimension labo 1))
-     (>= y (array-dimension labo 1)))))
+(defun out-labop (labo g)
+  (declare (type (array t (* *)) labo)
+	   (type (or null guard) g))
+  (not
+   (and
+    g
+    (< -1 (guard-x g) (array-dimension labo 1))
+    (< -1 (guard-y g) (array-dimension labo 0)))))
 
-(defun guard-rotate (guard)
-  (let ((direction (second guard)))
-    (make-guard
-     (first guard)
-     (case direction
-       (:north :east)
-       (:east :south)
-       (:south :west)
-       (:west :north)))))
+
+(defun guard-rotate (g)
+  (declare (type guard g))
+  (make-guard :x (guard-x g) :y (guard-y g)
+	      :dir (case (guard-dir g)
+		     (:north :east)
+		     (:east :south)
+		     (:south :west)
+		     (:west :north))))
 
 (defun guard-move (labo guard &optional (extra-block nil))
-  (destructuring-bind (pos dir) guard
-    (let ((new-pos (move pos dir)))
-      (cond
-	((out-labop labo new-pos) nil)
-	((or (blockedp labo new-pos)
-	     (equal new-pos extra-block))
-	 (guard-move labo (guard-rotate guard) extra-block))
-	(t (make-guard new-pos dir))))))
+  (let ((new-guard (move guard)))
+    (cond
+      ((out-labop labo new-guard) nil)
+      ((blockedp labo new-guard extra-block)
+       (guard-move labo (guard-rotate guard) extra-block))
+      (t new-guard))))
 
-(defun guard-path (labo guard &optional (path nil) (extra-block nil))
-  (cond
-    ((member guard path :test #'equal) nil)
-    ((emptyp guard) (reverse path))
-    (t (guard-path labo (guard-move labo guard extra-block) (push guard path) extra-block))))
+(defun guard-hash (g)
+  (declare (type (or null guard) g))
+  (if g
+      (+ (* 10000 (guard-y g))
+	 (* 10 (guard-x g))
+	 (case (guard-dir g)
+	   (:north 0)
+	   (:east 1)
+	   (:south 2)
+	   (:west 3)))
+      0))
 
-(defun number-squares-covered-by-guard (labo)
-  (let ((squares (mapcar #'first (guard-path labo (find-guard labo)))))
-    (length (remove-duplicates squares :test #'equal))))
+(defun hash-to-pos (h)
+  (cons
+   (floor (/ h 10000))
+   (mod (floor (/ h 10)) 1000)
+   ))
 
+(defun guard-path (labo guard &optional (path (make-hash-table :size 10000)) (extra-block nil))
+  (let ((hash (guard-hash guard)))
+    (cond
+      ((not guard) (remove-duplicates (loop for k being the hash-keys of path collect (floor (/ k 10)))))
+      ((gethash hash path) nil)
+      (t (progn
+	   (setf (gethash hash path) 1)
+	   (guard-path labo (guard-move labo guard extra-block) path extra-block))))))
 
 (defun part1 (data)
-  (format nil "~A" (number-squares-covered-by-guard data)))
+  (format nil "~A" (length (guard-path data (find-guard data)))))
 
 (defun looping-blocks (labo)
   (let* ((g (find-guard labo))
 	 (route (guard-path labo g)))
-    (remove-duplicates
-     (loop for s in route
-	   for b = (first s)
-	   unless (guard-path labo g '() b)
-	     collect b)
-     :test #'equal)))
+    (loop for s in route
+	  for b = (cons (mod s 1000) (floor (/ s 1000))) 
+	  unless (guard-path labo g (make-hash-table :size 10000) b)
+	    collect b)))
 
 (defun part2 (data)
   (let* ((lb (looping-blocks data)))