aoc-cl/src/2024/day11.lisp
2024-12-11 11:37:35 +01:00

137 lines
3.5 KiB
Common Lisp

(defpackage :aoc/2024/11
(:use :cl :aoc :alexandria :trivia :lla)
(:export
#:sample-data
#:sample-data2
#:part1
#:part2
#:parse-line
#:evolve-stone
#:evolve-stones
))
(in-package :aoc/2024/11)
(defun parse-line (line)
(mapcar #'parse-integer (cl-ppcre:split " " line)))
(defun parse-input (lines)
(parse-line lines))
(defparameter input-text (first (test-input 2024 11)))
(defparameter input-data (parse-input input-text))
(defparameter sample-text "125 17")
(defparameter sample-data
(parse-input sample-text))
(defun n-digits (x)
(ceiling (log (1+ x) 10)))
(defun evolve-stone (stone)
(let* ((n (n-digits stone))
(split-factor (expt 10 (/ n 2))))
(cond
((= 0 stone) (list 1))
((evenp n) (list
(floor (/ stone split-factor))
(mod stone split-factor)))
(t (list (* 2024 stone)))))
)
(defun evolve-stones (stones)
(loop for stone in stones
append (evolve-stone stone)))
(defun evolve-stones-n (stones n)
(loop for i from 1 to n
do (setf stones (evolve-stones stones))
finally (return stones)))
(defun number-stones-after-n-evolutions (stones n)
(length (evolve-stones-n stones n))
)
(defparameter stone-map-25-cache (make-hash-table :size 1000))
(defun map-stone-25 (stone)
(let ((rslt (gethash stone stone-map-25-cache)))
(or rslt
(let ((stones (evolve-stones-n (list stone) 25))
(stone-map (make-hash-table)))
(loop for s in stones
do (incf (gethash s stone-map 0)))
(setf (gethash stone stone-map-25-cache) stone-map)))))
(defun merge-stone-map (map1 map2 &optional (multiplier 1))
(let ((result (copy-hash-table map1)))
(loop
for k being the hash-keys of map2
for v being the hash-values of map2
do (incf (gethash k result 0) (* v multiplier)))
result))
(defun evolve-stone-map-25 (stone-map)
(let ((result (make-hash-table :size 1000)))
(loop
for k being the hash-keys of stone-map
for v being the hash-values of stone-map
do (setf result (merge-stone-map result (map-stone-25 k) v)))
result))
(defun stones-to-stone-map (stones)
(let ((result (make-hash-table :size (length stones))))
(loop
for k in stones
do (setf (gethash k result) 1))
result))
(defun total-stones (stone-map)
(loop for v being the hash-values of stone-map sum v))
(defparameter stone-map-cache (make-hash-table :size 1000))
(defun map-stone (stone)
(let ((rslt (gethash stone stone-map-cache)))
(or rslt
(let ((stones (evolve-stone stone))
(stone-map (make-hash-table)))
(loop for s in stones
do (incf (gethash s stone-map 0)))
(setf (gethash stone stone-map-cache) stone-map)))))
(defun evolve-stone-map (stone-map)
(let ((result (make-hash-table :size 1000)))
(loop
for k being the hash-keys of stone-map
for v being the hash-values of stone-map
do (setf result (merge-stone-map result (map-stone k) v)))
result))
(defun evolve-stone-map-n (stone-map n)
(loop
for i from 1 to n
with sm = stone-map
do (setf sm (evolve-stone-map sm))
finally (return sm)))
(defun part1 (data)
(format nil "~A" (total-stones (evolve-stone-map-n (stones-to-stone-map data) 25))))
(defun part2 (data)
(format nil "~A" (total-stones (evolve-stone-map-n (stones-to-stone-map data) 75))))
(defun solve-day ()
(format t "part1: ~A~%" (part1 input-data))
(format t "part2: ~A~%" (part2 input-data)))
(defun submit ()
(let ((p1 (part1 input-data))
(p2 (part2 input-data)))
(if p1 (submit-part1 2024 11 p1))
(if p2 (submit-part2 2024 11 p2))))