solved day 6

aoc.asd

@@ -28,6 +28,8 @@
 		 (:file "2024/day02")
 		 (:file "2024/day03")
 		 (:file "2024/day04")
+		 (:file "2024/day05")
+		 (:file "2024/day06")
 		 )))
   :description "Advent of Code challenges and solutions."
   :long-description "Solutions for the AOC challenges."
@@ -48,6 +50,8 @@
 		 (:file "2024/day02-test")
 		 (:file "2024/day03-test")
 		 (:file "2024/day04-test")
+		 (:file "2024/day05-test")
+		 (:file "2024/day06-test")
 		 )))
   :description "Test system for aoc"
   :perform (test-op (op c) (symbol-call :parachute :test :aoc/tests)))

src/2024/day05.lisp

@@ -93,8 +93,7 @@
     (cond
       ((not a) book)
       ((not b) book)
-      ((< a b)
-       book)
+      ((< a b) book)
       (t (append (subseq book 0 b)
 		 (subseq book a (1+ a))
 		 (subseq book b a)

src/2024/day06.lisp

@@ -0,0 +1,128 @@
+(declaim (optimize (speed 3) (debug 0) (safety 0)))
+
+(defpackage :aoc/2024/06
+  (:use :cl :aoc :alexandria :trivia)
+  (:export
+   #:sample-data
+   #:sample-data2
+   #:part1
+   #:part2
+   ))
+
+(in-package :aoc/2024/06)
+
+
+
+
+
+(defun parse-input (lines)
+  (let ((l (length lines)))
+    (make-array (list l l)
+		:initial-contents (mapcar (lambda (s) (coerce s 'list)) lines))))
+
+(defparameter input-text (test-input 2024 6))
+(defparameter input-data 
+  (parse-input (test-input 2024 6)))
+
+(defparameter sample-text (aoc:split-lines "....#.....
+.........#
+..........
+..#.......
+.......#..
+..........
+.#..^.....
+........#.
+#.........
+......#...
+"))
+(defparameter sample-data 
+  (parse-input sample-text))
+
+(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 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))
+
+(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 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 guard-rotate (guard)
+  (let ((direction (second guard)))
+    (make-guard
+     (first guard)
+     (case direction
+       (: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))))))
+
+(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 number-squares-covered-by-guard (labo)
+  (let ((squares (mapcar #'first (guard-path labo (find-guard labo)))))
+    (length (remove-duplicates squares :test #'equal))))
+
+
+(defun part1 (data)
+  (format nil "~A" (number-squares-covered-by-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)))
+
+(defun part2 (data)
+  (let* ((lb (looping-blocks data)))
+    (format nil "~A" (length lb))))
+
+(defun solve-day ()
+  (format t "part1: ~A~%" (part1 input-data))
+  (format t "part2: ~A~%" (part2 input-data)))
+

tests/2024/day06-test.lisp

@@ -0,0 +1,20 @@
+(defpackage :aoc/2024/06/tests
+  (:use :cl :aoc :aoc/tests :aoc/2024/tests :parachute :aoc/2024/06))
+
+(in-package :aoc/2024/06/tests)
+
+(define-test suite-2024-06
+					;:parent suite-2024
+  )
+
+
+
+(define-test+run test-part1
+  :parent suite-2024-06
+  (true (equalp "41" (part1 sample-data))))
+
+(define-test+run test-part2
+  :parent suite-2024-06
+  (true (equalp "6" (part2 sample-data2))))
+
+