aoc2021 day13

aoc2021-day13.lisp

;;;; +----------------------------------------------------------------+
;;;; | Advent of Code 2021                                            |
;;;; +----------------------------------------------------------------+

(defpackage #:snippets/aoc2021/day13
  (:use #:cl)
  (:export
   #:day13))

(in-package #:snippets/aoc2021/day13)

(defstruct paper
  dots-by-row
  num-rows
  num-columns)

(defun parse (lines)
  (let ((dots-by-row (make-hash-table))
        (max-row 0)
        (max-column 0)
        (folds '()))
    (dolist (line lines)
      (cond ((equal line ""))
            ((plusp (mismatch "fold along " line))
             (let ((k (parse-integer line :start 13)))
               (push (list (ecase (char line 11)
                             (#\x 'fold-left)
                             (#\y 'fold-up))
                           k)
                     folds)))
            (t
             (let* ((comma (or (position #\, line)
                               (error "Weird line ~S." line)))
                    (column (parse-integer line :end comma))
                    (row (parse-integer line :start (1+ comma))))
               (setf max-row (max max-row row))
               (setf max-column (max max-column column))
               (push column (gethash row dots-by-row))))))
    (values
     (make-paper :dots-by-row dots-by-row
                 :num-rows (1+ max-row)
                 :num-columns (1+ max-column))
     (nreverse folds))))

(defun fold-up (paper k)
  (do ((row-below-fold (1+ k) (1+ row-below-fold))
       (row-above-fold (1- k) (1- row-above-fold)))
      ((>= row-below-fold (paper-num-rows paper))
       (setf (paper-num-rows paper) k)
       paper)
    (dolist (column (gethash row-below-fold (paper-dots-by-row paper)))
      (pushnew column (gethash row-above-fold (paper-dots-by-row paper))))
    (remhash row-below-fold (paper-dots-by-row paper))))

(defun transpose (paper)
  (let ((dots-by-column (make-hash-table)))
    (loop for row being each hash-key of (paper-dots-by-row paper)
          using (hash-value columns)
          do (dolist (column columns)
               (push row (gethash column dots-by-column))))
    (make-paper :dots-by-row dots-by-column
                :num-rows (paper-num-columns paper)
                :num-columns (paper-num-rows paper))))

(defun fold-left (paper k)
  (transpose (fold-up (transpose paper) k)))

(defun count-visible-dots (paper)
  (loop for dots being each hash-value of (paper-dots-by-row paper)
        sum (length dots)))

(defun show (paper)
  (let ((line (make-string (paper-num-columns paper))))
    (dotimes (row (paper-num-rows paper))
      (fill line #\.)
      (dolist (column (gethash row (paper-dots-by-row paper)))
        (setf (aref line column) #\#))
      (format t "~A~%" line))))

(defun clone (paper)
  (let ((dots-by-row (make-hash-table)))
    (loop for row being each hash-key of (paper-dots-by-row paper)
          using (hash-value columns)
          do (setf (gethash row dots-by-row) (copy-list columns)))
    (make-paper :dots-by-row dots-by-row
                :num-rows (paper-num-rows paper)
                :num-columns (paper-num-columns paper))))

(defun fold (paper folds)
  (reduce (lambda (paper fold)
            (funcall (car fold) paper (cadr fold)))
          folds
          :initial-value (clone paper)))

(defun day13 (input)
  (multiple-value-bind (paper folds)
      (parse input)
    (list (count-visible-dots (fold paper (list (first folds))))
          (with-output-to-string (*standard-output*)
            (show (fold paper folds))))))