1 files changed, 83 insertions, 0 deletions
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))