solved day 4

aoc.asd

@@ -16,7 +16,9 @@
 	       #:array-operations
 	       #:lla
 	       #:queues.simple-queue
-			#:bt-semaphore)
+	       #:bt-semaphore ; threads higher level lib
+	       #:trivia                ; community standard pattern matching
+	       )
   :components ((:module "src"
 		:components
 		((:file "main")
@@ -25,6 +27,7 @@
 		 (:file "2024/day01")
 		 (:file "2024/day02")
 		 (:file "2024/day03")
+		 (:file "2024/day04")
 		 )))
   :description "Advent of Code challenges and solutions."
   :long-description "Solutions for the AOC challenges."
@@ -40,8 +43,11 @@
                 ((:file "main")
 		 (:file "2018/day06-test")
 		 (:file "2018/day07-test")
+		 (:file "2024/main")
 		 (:file "2024/day01-test")
 		 (:file "2024/day02-test")
+		 (:file "2024/day03-test")
+		 (:file "2024/day04-test")
 		 )))
   :description "Test system for aoc"
   :perform (test-op (op c) (symbol-call :parachute :test :aoc/tests)))

src/2024/day04.lisp

@@ -0,0 +1,145 @@
+(defpackage :aoc/2024/04
+  (:use :cl :aoc :alexandria :trivia)
+  (:export
+   #:sample-data
+   #:sample-data2
+   #:part1
+   #:part2
+   #:lil-xmas-state-machine
+   #:count-xmas-in-line
+   #:count-xmas
+   #:transpose
+   #:diagonals
+   ))
+
+(in-package :aoc/2024/04)
+
+(defun parse-line (s)
+  s)
+
+(defvar input-data '())
+(setf input-data (map 'list #'parse-line (test-input 2024 4)))
+
+(defvar sample-text "")
+(setf sample-text (aoc:split-lines "MMMSXXMASM
+MSAMXMSMSA
+AMXSXMAAMM
+MSAMASMSMX
+XMASAMXAMM
+XXAMMXXAMA
+SMSMSASXSS
+SAXAMASAAA
+MAMMMXMMMM
+MXMXAXMASX"))
+
+(defvar sample-data '())
+(setf sample-data (map 'list #'parse-line sample-text))
+
+(defun lil-xmas-state-machine (state x)
+  (let ((cnt (car state))
+	(last (cdr state)))
+    (match (cons last x)
+      ((cons _ #\X) (cons cnt :x))
+      ((cons :x #\M) (cons cnt :m))
+      ((cons :m #\A) (cons cnt :a))
+      ((cons :a #\S) (cons (1+ cnt) nil))
+      ((cons _ _) (cons cnt nil))
+      )))
+
+(defun count-xmas-in-line- (line)
+  (car
+   (reduce #'lil-xmas-state-machine line :initial-value (cons 0 nil))))
+
+(defun count-xmas-in-line (line)
+  (+ (count-xmas-in-line- line)
+     (count-xmas-in-line- (reverse line))))
+
+(defun transpose (lines)
+  (loop for i from 0 to (1- (length (first lines)))
+	collect (format nil "~{~A~}"
+			(loop for l in lines collect (subseq l i (1+ i))))))
+
+(defun diag-coords (len)
+  (let ((l (1- len)))
+    (loop for i from (- l) to l 
+	  collect (if (< i 0)
+		      (loop for x from 0 to l
+			    for y from (- i) to l 
+			    collect (list x y))
+		      (loop for x from i to l 
+			    for y from 0 to l 
+			    collect (list x y))))))
+
+(defun get-xy (cell lines)
+  (let ((x (first cell))
+	(y (second cell)))
+    (subseq (nth y lines) x (1+ x))))
+
+(defun diagonals (lines)
+  (loop for diag in (diag-coords (length lines))
+	collect (format nil "~{~A~}"
+			(loop for cell in diag
+			      collect (get-xy cell lines)))))
+
+(defun count-xmas (data)
+  (let ((lines (append data
+		       (transpose data)
+		       (diagonals data)
+		       (diagonals (mapcar #'reverse data)))))
+    (loop for line in lines
+	  sum (count-xmas-in-line line))))
+
+(defun part1 (data)
+  (format nil "~A" (count-xmas data)))
+
+
+(defvar sample-input2 ".M.S......
+..A..MSMS.
+.M.S.MAA..
+..A.ASMSM.
+.M.S.M....
+..........
+S.S.S.S.S.
+.A.A.A.A..
+M.M.M.M.M.
+..........
+")
+(defvar sample-data2 ())
+(setf sample-data2 (map 'list #'parse-line sample-text))
+
+(defun find-a-cells (data)
+  (loop for y from 1 to (- (length data) 2)
+	append (loop for x from 1 to (- (length data) 2)
+		     if (equal "A" (get-xy (list x y) data))
+		       collect (list x y))))
+
+(defun cell-crossp (cell data)
+  (let* ((x (first cell))
+	 (y (second cell))
+	 (tl (get-xy (list (1- x) (1- y)) data))
+	 (tr (get-xy (list (1+ x) (1- y)) data))
+	 (bl (get-xy (list (1- x) (1+ y)) data))
+	 (br (get-xy (list (1+ x) (1+ y)) data))
+	 (all-ms-p (every
+		    (lambda (x)
+		      (member x (list "M" "S") :test #'equal))
+		    (list tl tr bl br))))
+    (format t "~A ~A ~A ~A ~%" tl tr bl br )
+    (format t "x: ~A y: ~A ms: ~A~%" x y all-ms-p)
+    (format t "tl-br: ~A, tr-bl: ~A ~%" (equal tl br) (equal tr bl) )
+    (and
+     all-ms-p
+     (not (equal tl br))
+     (not (equal tr bl)))))
+
+(defun count-x-mas (data)
+  (loop for a in (find-a-cells data)
+	count (cell-crossp a data)))
+
+(defun part2 (data)
+  (format nil "~A" (count-x-mas data)))
+
+(defun solve-day ()
+  (format t "part1: ~A~%" (part1 input-data))
+  (format t "part2: ~A~%" (part2 input-data)))
+

tests/2018/day06-test.lisp

@@ -10,7 +10,8 @@
 (in-package :aoc/2018/06/tests)
 
 (define-test suite-2018-06
-  :parent suite-2018)
+					;:parent suite-2018
+  )
 
 (define-test+run test-find-top-left
   :parent suite-2018-06

tests/2024/day04-test.lisp

@@ -0,0 +1,42 @@
+(defpackage :aoc/2024/04/tests
+	    (:use :cl :aoc :aoc/tests :aoc/2024/tests :parachute :aoc/2024/04))
+
+(in-package :aoc/2024/04/tests)
+
+(define-test suite-2024-04
+					;:parent suite-2024
+  )
+
+(define-test test-lil-xmas-state-machine
+  :parent suite-2024-04
+  (is equal (cons 0 nil) (lil-xmas-state-machine (cons 0 nil) #\a))
+  (is equal (cons 0 :x) (lil-xmas-state-machine (cons 0 nil) #\X))
+  (is equal (cons 0 :m) (lil-xmas-state-machine (cons 0 :x) #\M))
+  (is equal (cons 0 :a) (lil-xmas-state-machine (cons 0 :m) #\A))
+  (is equal (cons 1 nil) (lil-xmas-state-machine (cons 0 :a) #\S))
+  )
+
+(define-test test-count-xmas-in-line 
+  :parent suite-2024-04
+  (is = 0 (count-xmas-in-line "FOOBAR"))
+  (is = 1 (count-xmas-in-line "XMAS"))
+  (is = 2 (count-xmas-in-line "XMASZXMAS"))
+  (is = 2 (count-xmas-in-line (reverse "XMASZXMAS"))))
+
+(define-test test-transpose
+  :parent suite-2024-04
+  (is equal (list "147" "258" "369") (transpose (list "123" "456" "789"))))
+
+(define-test test-diagonals
+  :parent suite-2024-04
+  (is equal (list "7" "48" "159" "26" "3") (diagonals (list "123" "456" "789"))))
+
+(define-test+run test-part1
+  :parent suite-2024-04
+  (true (equalp "18" (part1 sample-data))))
+
+(define-test+run test-part2
+  :parent suite-2024-04
+  (true (equalp "9" (part2 sample-data2))))
+
+