day-11.lisp (1597B)
1 (defpackage #:aoc/day-11 2 (:use #:cl #:aoc/utils) 3 (:export #:day-11)) 4 (in-package #:aoc/day-11) 5 6 (declaim (inline number-of-digits) 7 (ftype (function (fixnum) fixnum) number-of-digits)) 8 9 (defun number-of-digits (number) 10 (floor (1+ (log number 10)))) 11 12 (defun blink (stones target-depth) 13 (let ((memo (make-hash-table :test #'equal))) 14 (labels ((%blink (stone depth) 15 (when (= depth target-depth) 16 (return-from %blink 1)) 17 (let ((num-digits (or (zerop stone) 18 (number-of-digits stone))) 19 (new-depth (1+ depth))) 20 (cond 21 ((zerop stone) 22 (%blink-memo 1 new-depth)) 23 ((evenp num-digits) 24 (let ((divisor (expt 10 (/ num-digits 2)))) 25 (multiple-value-bind (left right) 26 (floor stone divisor) 27 (+ (%blink-memo left new-depth) 28 (%blink-memo right new-depth))))) 29 ((oddp num-digits) 30 (%blink-memo (* stone 2024) new-depth))))) 31 (%blink-memo (stone depth) 32 (let ((key (list stone depth))) 33 (or (gethash key memo) 34 (setf (gethash key memo) 35 (%blink stone depth)))))) 36 (loop for stone in stones 37 sum (%blink-memo stone 0))))) 38 39 (defun day-11 (input) 40 (let ((stones (read-number-list (read-line input)))) 41 (values (blink stones 25) 42 (blink stones 75))))