# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1639531140 18000
# Node ID cec05589a84cd300069b24b4038a7a0e9965cdf4
# Parent  68bbcb0ce4f762657746571a0db75b6df26b90cc
2021/14

diff -r 68bbcb0ce4f7 -r cec05589a84c data/2021/14.txt
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/data/2021/14.txt	Tue Dec 14 20:19:00 2021 -0500
@@ -0,0 +1,102 @@
+PSVVKKCNBPNBBHNSFKBO
+
+CF -> H
+PP -> H
+SP -> V
+NO -> C
+SF -> F
+FS -> H
+OF -> P
+PN -> B
+SH -> V
+BO -> K
+ON -> V
+VP -> S
+HN -> B
+PS -> P
+FV -> H
+NC -> N
+FN -> S
+PF -> F
+BF -> F
+NB -> O
+HS -> C
+SC -> V
+PC -> K
+KF -> K
+HC -> C
+OK -> H
+KS -> P
+VF -> C
+NV -> S
+KK -> F
+HV -> H
+SV -> V
+KC -> N
+HF -> P
+SN -> F
+VS -> P
+VN -> F
+VH -> C
+OB -> K
+VV -> O
+VC -> O
+KP -> V
+OP -> C
+HO -> S
+NP -> K
+HB -> C
+CS -> S
+OO -> S
+CV -> K
+BS -> F
+BH -> P
+HP -> P
+PK -> B
+BB -> H
+PV -> N
+VO -> P
+SS -> B
+CC -> F
+BC -> V
+FF -> S
+HK -> V
+OH -> N
+BV -> C
+CP -> F
+KN -> K
+NN -> S
+FB -> F
+PH -> O
+FH -> N
+FK -> P
+CK -> V
+CN -> S
+BP -> K
+CH -> F
+FP -> K
+HH -> N
+NF -> C
+VB -> B
+FO -> N
+PB -> C
+KH -> K
+PO -> K
+OV -> F
+NH -> H
+KV -> B
+OS -> K
+OC -> K
+FC -> H
+SO -> H
+KO -> P
+NS -> F
+CB -> C
+CO -> F
+KB -> V
+BK -> K
+NK -> O
+SK -> C
+SB -> B
+VK -> O
+BN -> H
diff -r 68bbcb0ce4f7 -r cec05589a84c src/2021/days/day-14.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/2021/days/day-14.lisp	Tue Dec 14 20:19:00 2021 -0500
@@ -0,0 +1,82 @@
+(advent:defpackage* :advent/2021/14)
+(in-package :advent/2021/14)
+
+(defun parse (stream &aux (template (read-line stream)))
+  (values
+    ;; Initial state { (a . b): 1, …}
+    (frequencies (map 'list #'cons template (subseq template 1)) :test #'equal)
+    ;; Last character
+    (char template (1- (length template))) ; last char
+    ;; Rules { pair: (new-left-pair . new-right-pair), …}
+    (iterate
+      (for line :in-stream stream :using #'read-line)
+      (ppcre:register-groups-bind (((rcurry #'char 0) l r m))
+          ("(.)(.) -> (.)" line)
+        (collect-hash ((cons l r) (cons (cons l m) (cons m r))) :test #'equal)))))
+
+(defun polymerize (polymer rules steps)
+  (do-repeat steps
+    (iterate
+      ;; Unfortunately we can't walk the hash table because we're modifying it.
+      (for (k . v) :in (alexandria:hash-table-alist polymer))
+      (unless (zerop v)
+        (for (l . r) = (gethash k rules))
+        (incf (gethash l polymer 0) v)
+        (incf (gethash r polymer 0) v)
+        (decf (gethash k polymer 0) v))))
+  polymer)
+
+(defun single-counts (polymer last)
+  (let ((counts (make-hash-table)))
+    (maphash (lambda (k v) (incf (gethash (car k) counts 0) v)) polymer)
+    (incf (gethash last counts 0))
+    (alexandria:hash-table-values counts)))
+
+(defun polydiff (polymer last)
+  (multiple-value-call #'- (extrema #'> (single-counts polymer last))))
+
+(define-problem (2021 14) (stream) (2584 3816397135460)
+  (multiple-value-bind (template last rules) (parse stream)
+    (values
+      (polydiff (polymerize (alexandria:copy-hash-table template) rules 10) last)
+      (polydiff (polymerize (alexandria:copy-hash-table template) rules 40) last))))
+
+#; Scratch --------------------------------------------------------------------
+
+;; old implementation with HAMTs
+(defun parse (stream)
+  (values
+    (read-line stream)
+    (iterate
+      (with-result result = (make-hash-table))
+      (for line :in-stream stream :using #'read-line)
+      (ppcre:register-groups-bind (((rcurry #'char 0) l r m))
+          ("(.)(.) -> (.)" line)
+        (setf (gethash r (alexandria:ensure-gethash l result (make-hash-table))) m)))))
+
+(defun dict-inc (dict key &optional (n 1))
+  (hamt:dict-insert dict key (+ n (or (hamt:dict-lookup dict key) 0))))
+
+(defun dict+ (dict1 dict2)
+  (hamt:dict-reduce #'dict-inc dict1 dict2))
+
+(defun polymerize (template rules steps)
+  (iterate
+    (with cache = (make-hash-table :test #'equal))
+    (with counts = (hamt:empty-dict))
+    (for l :in-string template)
+    (for r :in-string template :from 1)
+    (for chunk = (recursively ((l l) (r r) (steps steps))
+                   (alexandria:ensure-gethash (list l r steps) cache
+                     (if (zerop steps)
+                       (hamt:empty-dict)
+                       (let ((m (gethash r (gethash l rules))))
+                         (dict-inc (dict+ (recur l m (1- steps))
+                                          (recur m r (1- steps)))
+                                   m))))))
+    (setf counts (dict+ counts chunk))
+    (returning (reduce #'dict-inc template :initial-value counts))))
+
+(defun polydiff (polymer)
+  (multiple-value-call #'- (extrema #'> (mapcar #'cdr (hamt:dict->alist polymer)))))
+