Add 2024 day 12 solutions

1 files changed, 115 insertions, 0 deletions

diff --git a/2024/12/puzzles.lisp b/2024/12/puzzles.lisp
new file mode 100644
index 0000000..3a02033
--- /dev/null
+++ b/2024/12/puzzles.lisp
@@ -0,0 +1,115 @@
+#!/usr/bin/sbcl --script
+
+(defparameter *seen*
+  (make-hash-table :test #'equal))
+
+(defun read-grid (filename)
+  (with-open-file (stream filename)
+    (let ((lines (loop for line = (read-line stream nil)
+                       while line
+                       collect (coerce line 'array))))
+      (make-array (list (length lines)
+                        (length (first lines)))
+                  :initial-contents lines))))
+
+(defconstant +farm+
+  (read-grid "input"))
+
+(defun main ()
+  (loop with dimensions = (array-dimensions +farm+)
+        for i from 0 below (first dimensions)
+        sum (loop for j from 0 below (second dimensions)
+                  sum (multiple-value-call #'* (flood-fill i j)))))
+
+(defun flood-fill (i j)
+  (flood-fill-1 (aref +farm+ i j) i j))
+
+(defun flood-fill-1 (char i j)
+  (block nil
+    (let ((pos (cons i j)))
+      (when (gethash pos *seen*)
+        (return (values 0 0)))
+      (setf (gethash pos *seen*) t))
+
+    (when (char/= char (try-aref i j))
+      (return (values 0 0)))
+
+    (loop with neighbors = (locate-neighbors char i j)
+          with a = 1
+          ;; START PART 1
+          with c = (- 4 (length neighbors))
+          ;; END PART 1 START PART 2
+          with c = (corner-count char neighbors i j)
+          ;; END PART 2
+          for (i . j) in neighbors
+          do (multiple-value-bind (a1 c1) (flood-fill-1 char i j)
+               (incf a a1)
+               (incf c c1))
+          finally (return (values a c)))))
+
+(defun locate-neighbors (char i j)
+  (loop for (i . j) in (list (cons (1- i) j) (cons i (1- j))
+                             (cons (1+ i) j) (cons i (1+ j)))
+        if (char= char (try-aref i j))
+        collect (cons i j)))
+
+;; START PART 2
+(defun corner-count (char neighbors i j)
+  ;; Figuring out how many corners the current chunk of the farm has is a
+  ;; bit tricky.  If the chunk has less than 2 neighbors then the number
+  ;; of corners is fixed.  When there are 2 neighbors then if the three
+  ;; chunks form a line there are no corners, and if they form an ‘L’
+  ;; then there may be 1 or 2 corners.  When there are 4 neighbors then
+  ;; there are as many corners as there aren’t diagonal neighbors.
+  ;; Finally the trickiest is 3 neighbors.  In this case we need to
+  ;; figure out which 2 diagonal-neighbors would turn our ‘T’ shape into
+  ;; a rectangle, and use them to determine how many corners we have.
+  (let ((n (length neighbors)))
+    (cond
+      ((= n 0) 4)
+      ((= n 1) 2)
+      ((= n 2)
+       (let* ((l (first  neighbors))
+              (r (second neighbors))
+              (li (car l)) (ri (car r))
+              (lj (cdr l)) (rj (cdr r)))
+         (cond
+           ((or (= li ri i) (= lj rj j)) 0)
+           ((char= char (try-aref
+                         (if (= li i) ri li)
+                         (if (= lj j) rj lj)))
+            1)
+           (:else 2))))
+      ((= n 3)
+       (let ((wart (loop for n in neighbors
+                         if (/= (car n) i)
+                           collect n into odd-one-out-i
+                         else
+                           collect n into odd-one-out-j
+                         finally (return
+                                   (first (if (= 1 (length odd-one-out-i))
+                                              odd-one-out-i
+                                              odd-one-out-j))))))
+         (loop for n in neighbors
+               count (not (or (equal n wart)
+                              (char= char (try-aref
+                                           (if (= (car n) i)
+                                               (car wart)
+                                               (car n))
+                                           (if (= (cdr n) j)
+                                               (cdr wart)
+                                               (cdr n)))))))))
+      ((= n 4)
+       (loop for (i . j) in (list (cons (1- i) (1- j)) (cons (1- i) (1+ j))
+                                  (cons (1+ i) (1- j)) (cons (1+ i) (1+ j)))
+             count (char/= (try-aref i j) char))))))
+;; END PART 2
+
+(defun try-aref (i j)
+  (let ((dimensions (array-dimensions +farm+)))
+    (if (and (< -1 i (first dimensions))
+             (< -1 j (second dimensions)))
+        (aref +farm+ i j)
+        #\Nul)))
+
+(format t "~d~%" (main))
\ No newline at end of file