aoc2021 day14

aoc2021-day14.lisp

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

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

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

(defstruct state
  (digraphs (make-hash-table :test 'equal))
  (chars (make-hash-table)))

(defun make-state-from-string (string)
  (let ((state (make-state)))
    (dotimes (i (length string))
      (incf (gethash (char string i) (state-chars state) 0))
      (when (< i (1- (length string)))
        (incf (gethash (subseq string i (+ 2 i)) (state-digraphs state) 0))))
    state))

(defun make-rules (rulespec)
  (let ((rules (make-hash-table :test 'equal)))
    (loop for (lhs -> rhs) in rulespec
          do (setf (gethash lhs rules) (character rhs)))
    rules))

(defun find-rule-char (rules digraph)
  (or (gethash digraph rules)
      (error "Can't find digraph ~S in rules ~S." digraph rules)))

(defun make-digraph-incrementer (digraphs)
  (let ((digraph-storage (make-string 2)))
    (lambda (char1 char2 k)
      (setf (aref digraph-storage 0) char1)
      (setf (aref digraph-storage 1) char2)
      (if (gethash digraph-storage digraphs)
          (incf (gethash digraph-storage digraphs) k)
          (setf (gethash (copy-seq digraph-storage) digraphs) k)))))

(defun rewrite (state rules)
  (let* ((new-state (make-state))
         (inc-digraph (make-digraph-incrementer (state-digraphs new-state))))
    (loop for digraph being each hash-key of (state-digraphs state)
          using (hash-value k)
          for rule-char = (find-rule-char rules digraph)
          do (incf (gethash rule-char (state-chars new-state) 0) k)
             (funcall inc-digraph (aref digraph 0) rule-char k)
             (funcall inc-digraph rule-char (aref digraph 1) k))
    (loop for char being each hash-key of (state-chars state)
          using (hash-value k)
          do (incf (gethash char (state-chars new-state) 0) k))
    new-state))

(defun grow (initial-state rules num-iterations)
  (loop for state = initial-state then (rewrite state rules)
        repeat num-iterations
        finally (return state)))

(defun quantity (state)
  (loop for k being each hash-value of (state-chars state)
        maximize k into max-k
        minimize k into min-k
        finally (return (- max-k min-k))))

(defun day14 (input)
  (let ((initial-state (make-state-from-string (caar input)))
        (rules (make-rules (cddr input))))
    (list (quantity (grow initial-state rules 10))
          (quantity (grow initial-state rules 40)))))