aoc-2021/4/bingo.lisp

(defparameter *bingo-input* "./input.txt")
(ql:quickload :cl-strings)
(use-package :cl-strings)

(defun read-bingo ()
  "Read input file, returning a list of its binary diagnostics."
  (let ((input (open *bingo-input* :if-does-not-exist nil))
        (bingo-boards-raw '())
        (bingo-draws '()))
    (when input
      (setq bingo-draws (cl-strings:split
                         (read-line input nil) ","))
      (loop for line = (read-line input nil)
            while line do
              (setq bingo-boards-raw (cons line bingo-boards-raw)))
      (close input))

    (cons (map 'list (lambda (draw) (parse-integer draw)) bingo-draws)
          (reverse bingo-boards-raw))))

(defun process-raw-bingo-boards (input)
  (defun iter-boards (current-board boards rows-to-process)
    (if (eq 'nil rows-to-process)
        (cons (reverse current-board) boards)
        (let ((next-row (car rows-to-process)))
          (if (string= "" next-row)
              (iter-boards '() (cons (reverse current-board) boards)
                           (cdr rows-to-process))
              (iter-boards (cons
                            (loop for x in
                                        (remove-if (lambda (x) (string= x ""))
                                                   (cl-strings:split next-row))
                                  collecting (cons 'nil (parse-integer x)))
                            current-board)
                           boards
                           (cdr rows-to-process))))
          ))
  (reverse (remove-if (lambda (x) (eq x 'nil)) (iter-boards '() '() input))))

(defun mark-board (board square)
  (defun mark-row (row sq)
    (defun row-iter (row called-square marked-row)
      (if (eq 'nil row)
          (reverse marked-row)
          (let* ((current-square (car row))
                 (already-marked (car current-square))
                 (value (cdr current-square))
                 (marked-square (cons (or (= value called-square) already-marked) value)))
            (row-iter (cdr row) called-square (cons marked-square marked-row)))))
    (row-iter row sq '()))
  (loop for row in board collect (mark-row row square)))

(defun get-cols (board)
  (defun get-col (board)
    (defun col-iter (board reduced-board col)
      (if (eq 'nil board)
          (cons (reverse col) (reverse reduced-board))
          (col-iter (cdr board)
                    (cons (cdr (car board)) reduced-board)
                    (cons (car (car board)) col))))
    (col-iter board '() '()))
  (defun board-iter (board cols)
    (if (every (lambda (x) (not x)) board)
        cols
        (let* ((results (get-col board))
               (column (car results))
               (reduced-board (cdr results)))
          (board-iter 
           reduced-board
           (cons column cols)))))
  (reverse (board-iter board '())))

(defun winning-board (board)
  (defun winning-row (board)
    (some (lambda (row)
                  (every (lambda (square) (car square)) row))
          board))
  (defun winning-col (board)
    (winning-row (get-cols board)))
  
  (or (winning-row board)
      (winning-col board)))

(defun get-moves-and-boards ()
  (let ((data (read-bingo)))
    (cons
     (car data)
     (process-raw-bingo-boards (cdr data)))))

(defun find-winning-board ()
  (defun move-iter (moves boards)
    (let* ((boards-with-move-applied
             (map 'list (lambda (board) (mark-board board (car moves)))
                  boards))
           (winning-boards
             (remove-if-not
              (lambda (board) (winning-board board))
              boards-with-move-applied)))
      (if (not (eq 'nil winning-boards))
          (progn (format t "~A~%~A~%" winning-boards (car moves))
                 winning-boards)
          (move-iter (cdr moves) boards-with-move-applied))))
  (let* ((moves-and-boards (get-moves-and-boards))
         (moves (car moves-and-boards))
         (boards (cdr moves-and-boards)))
    (move-iter moves boards)))

(defun find-last-winning-board ()
  (defun move-iter (moves boards)
    (let* ((boards-with-move-applied
             (map 'list (lambda (board) (mark-board board (car moves)))
                  boards))
           (losing-boards
             (remove-if
              (lambda (board) (winning-board board))
              boards-with-move-applied)))
      (if (= 1 (length losing-boards))
          (progn (format t "~A~%~A~%" losing-boards (car moves))
                 losing-boards)
          (move-iter (cdr moves) losing-boards))))
  (let* ((moves-and-boards (get-moves-and-boards))
         (moves (car moves-and-boards))
         (boards (cdr moves-and-boards)))
    (move-iter moves boards)))

;; hacked together the final solution in a ... less than elegant manner.
;; the actual processing code is good, the final glue to get the answer...
;; couldn't be bothered to 'engineer' it lol

(* 73 (reduce '+ (map 'list 'cdr (remove-if (lambda (s) (car s)) '((NIL . 86) (T . 80) (NIL . 77) (T . 18)   (NIL . 87)
                                                                   (NIL . 79) (T . 93) (NIL . 52) (NIL . 17) (NIL . 20)
                                                                   (NIL . 30) (T . 68) (NIL . 48) (T . 12)   (T . 91)
                                                                   (NIL . 25) (T . 98) (NIL . 13) (NIL . 9)  (NIL . 47)
                                                                   (NIL . 45) (T . 73) (NIL . 97) (NIL . 15) (NIL . 59))))))
;; -> 58838



;; same story for finding the cute "last winner"

(* 46 (+ 17 76 29 1 13))
;; -> 6256