Implement both parts for 2024 day 11

4 files changed, 48 insertions, 51 deletions

diff --git a/2024/11/.gitignore b/2024/11/.gitignore
new file mode 100644
index 0000000..5fcaefb
--- /dev/null
+++ b/2024/11/.gitignore
@@ -0,0 +1 @@
+puzzle-[12].lisp
\ No newline at end of file
diff --git a/2024/11/Makefile b/2024/11/Makefile
new file mode 100644
index 0000000..5a21270
--- /dev/null
+++ b/2024/11/Makefile
@@ -0,0 +1 @@
+include ../../Makefiles/lisp.mk
\ No newline at end of file
diff --git a/2024/11/puzzle-1.lisp b/2024/11/puzzle-1.lisp
deleted file mode 100755
index 3fc7df7..0000000
--- a/2024/11/puzzle-1.lisp
+++ /dev/null
@@ -1,51 +0,0 @@
-#!/usr/bin/sbcl --script
-
-(defparameter *numbers*
-  '())
-
-(defun main (filename)
-  (setq *numbers* (read-stones filename))
-  (loop repeat 25
-        do (blink)
-        finally (return (length *numbers*))))
-
-(defun read-stones (filename)
-  (with-open-file (stream filename)
-    (let ((contents (make-string (file-length stream))))
-      (read-sequence contents stream)
-      (read-from-string (concatenate 'string "(" contents ")")))))
-
-(defun blink ()
-  (setq *numbers*
-        (loop for number in *numbers*
-              for after-blink = (stone-change-or-split number)
-              if (listp after-blink)
-                append after-blink
-              else
-                collect after-blink
-              finally (setq *numbers* after-blink))))
-
-(defun stone-change-or-split (number)
-  (cond ((= number 0)
-         1)
-        ((evenp (digit-count number))
-         (number-split number))
-        (:else
-         (* 2024 number))))
-
-(defun digit-count (number)
-  (loop with x = 0
-        while (/= number 0)
-        do (progn
-             (incf x)
-             (setq number (floor number 10)))
-        finally (return x)))
-
-(defun number-split (number)
-  (let* ((length (digit-count number))
-         (string (write-to-string number))
-         (half (/ length 2)))
-    (list (parse-integer (subseq string 0 half))
-          (parse-integer (subseq string half (length string))))))
-
-(format t "~d~%" (main "input"))
\ No newline at end of file
diff --git a/2024/11/puzzles.lisp b/2024/11/puzzles.lisp
new file mode 100644
index 0000000..9c3c73b
--- /dev/null
+++ b/2024/11/puzzles.lisp
@@ -0,0 +1,46 @@
+#!/usr/bin/sbcl --script
+
+(defparameter *memo* (make-hash-table :test 'equal))
+
+(defun main (filename blink-count)
+  (let ((stones (read-stones filename)))
+    (loop for stone in stones
+          sum (count-stones stone blink-count))))
+
+(defun read-stones (filename)
+  (with-open-file (stream filename)
+    (let ((contents (make-string (file-length stream))))
+      (read-sequence contents stream)
+      (read-from-string (concatenate 'string "(" contents ")")))))
+
+(defun count-stones (stone blink-count)
+  (or (gethash (cons stone blink-count) *memo*)
+      (setf (gethash (cons stone blink-count) *memo*)
+            (cond ((= (decf blink-count) -1)
+                   1)
+                  ((= stone 0)
+                   (count-stones 1 blink-count))
+                  ((evenp (integer-digit-count stone))
+                   (let ((hi-lo (integer-split stone)))
+                     (+ (count-stones (car hi-lo) blink-count)
+                        (count-stones (cdr hi-lo) blink-count))))
+                  (:else
+                   (count-stones (* 2024 stone) blink-count))))))
+
+(defun integer-digit-count (x)
+  (loop with n = 0
+        while (/= x 0)
+        do (progn (incf n) (setq x (floor x 10)))
+        finally (return n)))
+
+(defun integer-split (x)
+  (let* ((n (floor (integer-digit-count x) 2))
+         (m (expt 10 n)))
+    (cons (floor x m)
+          (mod x m))))
+
+;; START PART 1
+(format t "~d~%" (main "input" 25))
+;; END PART 1 START PART 2
+(format t "~d~%" (main "input" 75))
+;; END PART 2
\ No newline at end of file