Day 04 in Common Lisp

04/example_input

@@ -0,0 +1,19 @@
+7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1
+
+22 13 17 11  0
+ 8  2 23  4 24
+21  9 14 16  7
+ 6 10  3 18  5
+ 1 12 20 15 19
+
+ 3 15  0  2 22
+ 9 18 13 17  5
+19  8  7 25 23
+20 11 10 24  4
+14 21 16 12  6
+
+14 21 17 24  4
+10 16 15  9 19
+18  8 23 26 20
+22 11 13  6  5
+ 2  0 12  3  7

04/solution.lisp

@@ -0,0 +1,108 @@
+(ql:quickload 'split-sequence)
+
+(defun read-data (path)
+  (with-open-file (stream path)
+    (loop for line = (read-line stream nil)
+          while line collect line)))
+
+(defparameter *input-source*
+  (cadr *posix-argv*))
+
+;; Useful in testing
+;; (defparameter *input-source* "example_input")
+;; (defparameter *input-source* "input")
+
+(defparameter *data* (read-data *input-source*))
+
+(defstruct board
+  board
+  x-marked-count
+  y-marked-count
+  value-index
+  unmarked-sum)
+
+(defun build-value-index (arr)
+  (destructuring-bind (x y) (array-dimensions arr)
+    (loop for i from 0 below x
+          with table = (make-hash-table)
+          do (loop for j from 0 below y
+                   do (setf (gethash (aref arr i j) table) (list i j)))
+          finally (return table))))
+
+(defun sum-values (arr)
+  (destructuring-bind (x y) (array-dimensions arr)
+    (loop for i from 0 below x
+          sum (loop for j from 0 below y
+                    sum (aref arr i j)))))
+
+(defun new-board (numbers)
+  (let* ((dimension-x (length numbers))
+         (dimension-y (length (car numbers)))
+         (arr (make-array (list dimension-x dimension-y)
+                          :initial-contents numbers)))
+    (make-board :board arr
+                :x-marked-count (make-array dimension-x)
+                :y-marked-count (make-array dimension-y)
+                :value-index (build-value-index arr)
+                :unmarked-sum (sum-values arr))))
+
+(defun mark-drawn-number (number board)
+  (when (gethash number (board-value-index board))
+    (destructuring-bind (x y) (gethash number (board-value-index board))
+      (setf (board-unmarked-sum board) (- (board-unmarked-sum board) number))
+      (setf (aref (board-x-marked-count board) x) (1+ (aref (board-x-marked-count board) x)))
+      (setf (aref (board-y-marked-count board) y) (1+ (aref (board-y-marked-count board) y))))))
+
+(defun board-win-p (board)
+  (destructuring-bind (x y) (array-dimensions (board-board board))
+    (or (some (lambda (v) (= v x)) (board-x-marked-count board))
+        (some (lambda (v) (= v y)) (board-y-marked-count board)))))
+
+(defun parse-draws (draws)
+  (map 'list #'parse-integer
+       (split-sequence:split-sequence #\, draws)))
+
+(defun parse-board-row (row)
+  (map 'list #'parse-integer
+       (split-sequence:split-sequence #\Space row :remove-empty-subseqs T)))
+
+(defun parse-board (board)
+  (new-board (map 'list #'parse-board-row board)))
+
+
+(defun parse-boards (boards)
+  (map 'list #'parse-board boards))
+
+(defun parse-input (lines)
+  (let ((groups (split-sequence:split-sequence "" lines :test #'string=)))
+    (values (parse-draws (car (car groups)))
+            (parse-boards (cdr groups)))))
+
+(defun play-bingo (draws boards)
+  (loop for number in draws
+        with winning-boards = '()
+        with playing-boards = boards
+        do (dolist (board playing-boards)
+             (mark-drawn-number number board))
+        do (setf winning-boards (remove-if-not #'board-win-p playing-boards))
+        do (setf playing-boards (remove-if #'board-win-p playing-boards))
+        when winning-boards
+          collect (list number winning-boards)
+        while playing-boards))
+
+(defun part1 (scores)
+  (destructuring-bind (number boards) (car scores)
+    (* number
+       (board-unmarked-sum (car boards)))))
+
+(defun part2 (scores)
+  (destructuring-bind (number boards) (car (last scores))
+    (* number
+       (board-unmarked-sum (car (last boards))))))
+
+(time
+ (multiple-value-bind (draws boards) (parse-input *data*)
+   (let ((scores (play-bingo draws boards)))
+     (format t "Part 1: ~A~%" (part1 scores))
+     (format t "Part 2: ~A~%" (part2 scores)))))
+