aoc2020 day17

aoc2020-day17.lisp

;;;; +----------------------------------------------------------------+
;;;; | Advent of Code 2020                                            |
;;;; +----------------------------------------------------------------+

(defpackage #:snippets/aoc2020/day17
  (:use #:cl)
  (:export
   #:day17))

(in-package #:snippets/aoc2020/day17)

(defstruct (grid
            (:constructor %make-grid)
            (:print-function print-grid))
  (active (make-hash-table))
  (bits-per-dimension 15)
  (rank)
  (bounds))

(defun make-grid (rank)
  (%make-grid :rank rank
              :bounds (make-array (* 2 rank)
                                  :element-type '(signed-byte 32)
                                  :initial-element 0)))

(defun print-grid (grid stream depth)
  (declare (ignore depth))
  (let ((bounds (grid-bounds grid))
        (rank (grid-rank grid)))
    (format stream "#<GRID (~{~D~^,~})-(~{~D~^,~}) [~D]>"
            (loop for i from 0 below rank
                  collect (aref bounds (* i 2)))
            (loop for i from 0 below rank
                  collect (aref bounds (1+ (* i 2))))
            (count-active grid))))

(defun encode-coords (grid coords)
  (let ((bits-per-dimension (grid-bits-per-dimension grid))
        (key 0))
    (loop for coord in coords
          for position from 0 by bits-per-dimension
          do (setf (ldb (byte bits-per-dimension position) key) coord))
    key))

(defun decode-coords (grid key)
  (let ((bits-per-dimension (grid-bits-per-dimension grid))
        (rank (grid-rank grid)))
    (flet ((to-signed (x)
             (if (= 1 (ldb (byte 1 (1- bits-per-dimension)) x))
                 (- x (ash 1 bits-per-dimension))
                 x)))
      (loop for position from 0 by bits-per-dimension
            repeat rank
            collect (to-signed (ldb (byte bits-per-dimension position) key))))))

(defun activep (grid key)
  (values (gethash key (grid-active grid))))

(defun (setf activep) (new-value grid key)
  (cond (new-value
         (let ((coords (decode-coords grid key))
               (bounds (grid-bounds grid)))
           (loop for coord in coords
                 for i upfrom 0 by 2
                 do (setf (aref bounds i) (min (aref bounds i) (1- coord)))
                    (setf (aref bounds (1+ i)) (max (aref bounds (1+ i)) (1+ coord)))))
         (setf (gethash key (grid-active grid)) new-value))
        (t
         (remhash key (grid-active grid))))
  new-value)

(defun parse (input rank)
  (let ((grid (make-grid rank))
        (zeros (make-list (- rank 2) :initial-element 0)))
    (loop for y upfrom 0
          for line in input
          do (loop for x upfrom 0
                   for char across line
                   for key = (encode-coords grid (list* x y zeros))
                   do (setf (activep grid key)
                            (char= char #\#))))
    grid))

(defun map-neighbors (grid key function)
  (let ((coords (decode-coords grid key))
        (rank (grid-rank grid)))
    (labels ((rec (i deltas)
               (cond ((= i rank)
                      (unless (every #'zerop deltas)
                        (let ((neighbor-coords (mapcar #'+ coords deltas)))
                          (funcall function
                                   (encode-coords grid neighbor-coords)))))
                     (t
                      (dolist (d '(-1 0 +1))
                        (rec (1+ i) (cons d deltas)))))))
      (rec 0 '()))))

(defmacro do-neighbors ((var grid key) &body forms)
  `(block nil (map-neighbors ,grid ,key (lambda (,var) ,@forms))))

(defun count-neighbors (grid key)
  (let ((n 0))
    (do-neighbors (neighbor grid key)
      (when (activep grid neighbor)
        (incf n)))
    n))

(defun clear (grid)
  (clrhash (grid-active grid))
  (fill (grid-bounds grid) 0))

(defun map-active (grid function)
  (maphash (lambda (key active)
             (when active
               (funcall function key)))
           (grid-active grid)))

(defmacro do-active ((var grid) &body forms)
  `(block nil (map-active ,grid (lambda (,var) ,@forms))))

(defun count-active (grid)
  (let ((n 0))
    (do-active (key grid)
      (declare (ignore key))
      (incf n))
    n))

(defun map-grid (grid function)
  (let ((bounds (grid-bounds grid))
        (rank (grid-rank grid)))
    (labels ((rec (i coords)
               (cond ((minusp i)
                      (funcall function (encode-coords grid coords)))
                     (t
                      (do ((c (aref bounds i) (1+ c)))
                          ((> c (aref bounds (1+ i))))
                        (rec (- i 2) (cons c coords)))))))
      (rec (* 2 (1- rank)) '()))))

(defmacro do-grid ((var grid) &body forms)
  `(block nil (map-grid ,grid (lambda (,var) ,@forms))))

(defun cycle (input-grid output-grid)
  (clear output-grid)
  (do-grid (key input-grid)
    (let ((n (count-neighbors input-grid key))
          (active (activep input-grid key)))
      (setf (activep output-grid key)
            (if active
                (or (= n 2) (= n 3))
                (= n 3)))))
  output-grid)

(defun simulate (initial-grid num-cycles)
  (let ((a (make-grid (grid-rank initial-grid)))
        (b (make-grid (grid-rank initial-grid))))
    (dotimes (i num-cycles)
      (cycle (if (zerop i) initial-grid a) b)
      (rotatef a b))
    a))

(defun day17 (input)
  (list (count-active (simulate (parse input 3) 6))
        (count-active (simulate (parse input 4) 6))))