(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))))