From 310d8d21bfc8a024c9a469a1f39a2370008fd9ea Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Wed, 22 Dec 2021 18:34:27 +0100
Subject: Add day 5 to aoc

---
 src/04.lisp     |  3 +--
 src/05.lisp     | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/common.lisp |  5 ++++
 test/05.lisp    |  6 ++---
 top.lisp        |  3 +++
 5 files changed, 95 insertions(+), 5 deletions(-)
 create mode 100644 src/05.lisp

diff --git a/src/04.lisp b/src/04.lisp
index 33436c2..4bbdd60 100644
--- a/src/04.lisp
+++ b/src/04.lisp
@@ -1,5 +1,4 @@
 (use-package 'cl-ppcre)
-(use-package 'cl-utilities)
 (use-package 'trivia)
 
 (defun 04/parse-input-direct (input)
@@ -7,7 +6,7 @@
         (boards (mapcar (lambda (x) (mapcar (lambda (y)
                                               (mapcar (lambda (z)
                                                         (list (parse-integer z) nil)) (split " +" (trim y)))) x))
-                        (split-sequence-if (lambda (x) (equalp x "")) (cddr input)))))
+                        (cl-utilities:split-sequence-if (lambda (x) (equalp x "")) (cddr input)))))
     (list in-list boards)))
 
 (defun 04/parse-input (input-file)
diff --git a/src/05.lisp b/src/05.lisp
new file mode 100644
index 0000000..607b290
--- /dev/null
+++ b/src/05.lisp
@@ -0,0 +1,83 @@
+(use-package 'cl-ppcre)
+(use-package 'trivia)
+
+(defun 05/parse-input-direct (input)
+  (mapcar (lambda (i)
+            (map 'list #'parse-integer
+                 (multiple-value-bind (a b)
+                     (scan-to-strings "(.*),(.*) -> (.*),(.*)" i) b)))
+          input))
+
+(defun max-coord (c1 c2)
+  (match (list c1 c2)
+    ((list (list x1 y1) (list x2 y2))
+     (list (max x1 x2) (max y1 y2)))))
+
+(defun find-max (l)
+  (fold-left #'max-coord '(0 0)
+             (mapcar
+              (lambda (x)
+                (match x
+                  ((list x1 y1 x2 y2)
+                   (list (max x1 x2) (max y1 y2))))) l)))
+
+(defun 05/parse-input (input-file)
+  (05/parse-input-direct (get-file-lines input-file)))
+
+(defun draw-line-x (arr y x1 x2)
+  (let ((nx1 (min x1 x2))
+        (nx2 (max x1 x2)))
+    (loop :for x :from nx1 :to nx2
+          :do (incf (aref arr y x)))))
+
+(defun draw-line-y (arr x y1 y2)
+  (let ((ny1 (min y1 y2))
+        (ny2 (max y1 y2)))
+    (loop :for y :from ny1 :to ny2
+          :do (incf (aref arr y x)))))
+
+(defun draw-line-diag (arr x1 y1 x2 y2)
+  (if (< x1 x2)
+      (if (< y1 y2)
+          (loop for y from y1 upto y2
+                for x from x1 upto x2
+                do (incf (aref arr y x)))
+          (loop for y from y1 downto y2
+                for x from x1 upto x2
+                do (incf (aref arr y x))))
+      (if (< y1 y2)
+          (loop for y from y1 upto y2
+                for x from x1 downto x2
+                do (incf (aref arr y x)))
+          (loop for y from y1 downto y2
+                for x from x1 downto x2
+                do (incf (aref arr y x))))))
+
+(defun draw-line (b arr coords)
+  (match coords
+    ((list x1 y1 x2 y2)
+     (if (equalp x1 x2)
+         (draw-line-y arr x1 y1 y2)
+         (if (equalp y1 y2) (draw-line-x arr y1 x1 x2)
+             (when b (draw-line-diag arr x1 y1 x2 y2)))))))
+
+(defun 2d-array-to-list (array)
+  (loop for i below (array-dimension array 0)
+        collect (loop for j below (array-dimension array 1)
+                      collect (aref array i j))))
+
+(defun 05/part-a (parsed-input)
+  (let ((lines (make-array (match (mapcar #'1+ (find-max parsed-input)) ((list a b) (list b a)))))
+        (overlapping 0))
+    (loop for x in parsed-input do (draw-line nil lines x))
+    (mapcar (lambda (x) (mapcar (lambda (y) (when (> y 1) (incf overlapping))) x))
+            (2d-array-to-list lines))
+    overlapping))
+
+(defun 05/part-b (parsed-input)
+  (let ((lines (make-array (match (mapcar #'1+ (find-max parsed-input)) ((list a b) (list b a)))))
+        (overlapping 0))
+    (loop for x in parsed-input do (draw-line t lines x))
+    (mapcar (lambda (x) (mapcar (lambda (y) (when (> y 1) (incf overlapping))) x))
+            (2d-array-to-list lines))
+    overlapping))
diff --git a/src/common.lisp b/src/common.lisp
index 2c56184..c9e6e8b 100644
--- a/src/common.lisp
+++ b/src/common.lisp
@@ -15,3 +15,8 @@
 (defun trim (input)
   (string-trim '(#\Space #\Newline #\Backspace #\Tab
                  #\Linefeed #\Page #\Return #\Rubout) input))
+
+(defun fold-left (reducer initial list)
+  (loop for fold = initial then (funcall reducer fold element)
+        for element in list
+        finally (return fold)))
diff --git a/test/05.lisp b/test/05.lisp
index 8a717d0..4aa8883 100644
--- a/test/05.lisp
+++ b/test/05.lisp
@@ -20,14 +20,14 @@
 
 (deftest 05/test-ex-b (05/aoc)
   (let ((result (05/part-b (05/parse-input-direct 05/default-input))))
-    (assert-equalp 0 result)))
+    (assert-equalp 12 result)))
 
 (deftest 05/test-a (05/aoc)
   (let ((result (05/part-a (05/parse-input "inputs/05.txt"))))
-    (assert-equalp 0 result)))
+    (assert-equalp 7380 result)))
 
 (deftest 05/test-b (05/aoc)
   (let ((result (05/part-b (05/parse-input "inputs/05.txt"))))
-    (assert-equalp 0 result)))
+    (assert-equalp 21373 result)))
 
 (defun 05/run-tests () (run-suite '05/aoc))
diff --git a/top.lisp b/top.lisp
index 8a6ff40..73b1825 100644
--- a/top.lisp
+++ b/top.lisp
@@ -27,4 +27,7 @@
 (load "src/04.lisp")
 (load "test/04.lisp")
 
+(load "src/05.lisp")
+(load "test/05.lisp")
+
 (defun run-all () (clunit:run-suite 'aoc))
-- 
cgit