;; https://adventofcode.com/2022/day/19
(defpackage :day-19
  (:use :cl))
(in-package :day-19)

(ql:quickload 'cl-ppcre)

(defparameter *all-types* '(:geode :obsidian :clay :ore))

(defclass state ()
  ((resources :accessor resources :initform nil :initarg :resources)
   (robots :accessor robots :initform (list :ore 1) :initarg :robots)
   (minute :accessor minute :initarg :minute :initform 1 )
   (cur-found-max :initform nil :accessor cur-found-max :allocation :class) ; would be nice to add types
   ))

(defmethod print-object ((obj state) stream)
  (print-unreadable-object (obj stream :type t)
    (with-slots (resources robots)
        obj
      (format stream "collected: ~a, with robots: ~a"
              resources robots))))

;; example of blueprint:
(defparameter *test-blueprint*
  '(:ore (:ore 4)
    :clay (:ore 2)
    :obsidian (:ore 3 :clay 14)
    :geode (:ore 2 :obsidian 7)))

;; thank you blambert & stackoverflow
;; https://stackoverflow.com/questions/11067899/is-there-a-generic-method-for-cloning-clos-objects
;; oh, but this is shallow copy and lists reused. crap

(defmethod copy-state ((s state))
  (make-instance 'state :resources (copy-list (resources s))
                        :robots (copy-list (robots s))
                        :minute (minute s)))

(defmethod can-create-robot (blueprints type (s state))
  (let ((this-robot-costs (getf blueprints type)))
    (loop for (resource amount) on this-robot-costs by #'cddr
          always (>= (getf (resources s) resource 0) amount))))

(defmethod create-robot (blueprints type (s state))
  (when (can-create-robot blueprints type s)
    (let ((this-robot-costs (getf blueprints type))
          (copied-state (copy-state s)))
      (loop for (resource amount) on this-robot-costs by #'cddr
            do (incf (getf (resources copied-state) resource 0) (- amount)))
      (incf (getf (robots copied-state) type 0))
      copied-state)))

(defmethod calc-resources-to-be-collected ((s state))
  (robots s))

(defmethod add-resources (new-resources (s state))
  (loop for (resource amount) on new-resources by #'cddr
        do (incf (getf (resources s) resource 0) amount)))

;; robot is unnecessary if resouce it brings is alreay produced
;; at amount of maximal possible per-turn expence
(defmethod max-need (blueprints (s state) resource-type)
  (loop
    for (la blueprint) on blueprints by #'cddr
    ;; do (print blueprint)
    maximize (getf blueprint resource-type 0)))

(defmethod any-use-of-creating-robot (blueprints (s state) robot-type)
  (if (eq :geode robot-type)
      t                                 ; always reason to build more geode robots
      (let ((max-need (max-need blueprints s robot-type))
            (state-production (getf (robots s) robot-type 0)))
        ;; (format t "comparing need ~a with prod ~a" max-need state-production)
        (> max-need state-production))))

(defmethod get-possible-bot-builds (blueprints (s state))
  (remove-if-not (lambda (robot-type)
                   (any-use-of-creating-robot blueprints s robot-type))
                 (remove-if-not (lambda (robot-type)
                                  (can-create-robot blueprints robot-type s))
                                *all-types*)))

;; true when no longer need to build secondary robots
(defmethod is-satiated-p (blueprints (s state))
  (loop for type in '(:ore :clay :obsidian)
        never (any-use-of-creating-robot blueprints s type)))

(defmethod a-dominates-b-p (blueprints (a state) (b state))
  ;; (declare (optimize (debug 3)))
  (when (is-satiated-p blueprints a) ; when not a satiated - don't know
    (and
     (<= (minute a) (minute b))         ; a earlier than b
     (or
      (not (is-satiated-p blueprints b))
      (loop for resource-type in *all-types* ; for both satiated compare all resources
            always (and (>= (getf (resources a) resource-type 0)
                            (getf (resources b) resource-type 0))
                        (>= (getf (robots a) resource-type 0)
                            (getf (robots b) resource-type 0))))))))

;; loose bound on geodes
(defmethod estimate ((s state))
  (let ((time-left (- 25 (minute s))))
    (+ (getf (resources s) :geode 0)
       (* time-left (getf (robots s) :geode 0))
       (/ (* time-left (1- time-left)) 2))))

(defmethod find-max-geod-2 (blueprints (s state))
  (declare (optimize (speed 3)))
  ;; (declare (optimize (debug 3)))
  ;; (format t "in step for ~a; with ~a~%" (minute s) s)
  (cond
    (
     (= 33 (minute s))                  ; exit condition fully calculated
     ;; (= 25 (minute s))                  ; exit condition fully calculated
     (getf (resources s) :geode 0))
    ((< (estimate s) (cur-found-max s))
     ;; (print "pruning")
     0)                           ; pruning this branch
    (t                                  ; default check
     (progn
       (let* ((will-collect-this-minute (calc-resources-to-be-collected s))
              (possible-bot-builds (get-possible-bot-builds blueprints s))
              (max-if-building
                (when possible-bot-builds
                  (loop
                    for bot-type in possible-bot-builds
                    for state-with-new-bot = (create-robot blueprints bot-type s)
                    when state-with-new-bot
                      maximize (progn
                                 (add-resources will-collect-this-minute state-with-new-bot)
                                 (incf (minute state-with-new-bot))
                                 (find-max-geod-2 blueprints state-with-new-bot )))))
              (if-not-building
                (let ((state-copy (copy-state s)))
                  ;; (break)
                  (add-resources will-collect-this-minute state-copy)
                  (incf (minute state-copy))
                  (find-max-geod-2 blueprints state-copy )))
              (recursed-max (max (or max-if-building 0) if-not-building)))
         ;; (break)
         ;; (format t "would build ~a~%" possible-bot-builds)
         (when (> recursed-max (cur-found-max s))
           (setf (cur-found-max s) recursed-max))
         recursed-max
         )))))


(defun blueprint-line-to-plist (line)
  (destructuring-bind
      (ore-cost-in-ore clay-cost-in-ore obs-cost-in-ore obs-cost-in-clay
       geod-cost-in-ore geod-cost-in-obs)
      (rest (remove-if-not #'identity
                           (mapcar (lambda (str) (parse-integer str :junk-allowed t))
                                   (ppcre:split " " line))))
    `(:ore (:ore ,ore-cost-in-ore)
      :clay (:ore ,clay-cost-in-ore)
      :obsidian (:ore ,obs-cost-in-ore :clay ,obs-cost-in-clay)
      :geode (:ore ,geod-cost-in-ore :obsidian ,geod-cost-in-obs))))

(defun read-and-calc-part-1 (filename)
  (with-open-file (in filename)
    (loop
      for line = (read-line in nil nil)
      for n from 1
      for blueprints = (when line  (blueprint-line-to-plist line))
      for max-geo = (when blueprints
                      (progn
                        (setf (cur-found-max *test-state*)
                              0)
                        (format t "Starting processing for ~a" line)
                        (timing (find-max-geod-2 blueprints (make-instance 'state)))))
      while blueprints
      do (format t "processed ~a. its max is ~a~%" n max-geo)
      summing (* n max-geo))))

(defun read-and-calc-part-2 (filename)
  (with-open-file (in filename)
    (loop
      for line = (read-line in nil nil)
      for n from 1
      for blueprints = (when line  (progn
                                     (format t "Starting processing for ~a~%" line)
                                     (blueprint-line-to-plist line)))
      for max-geo = (when blueprints
                      (progn
                        (setf (cur-found-max *test-state*) 0)
                        (timing (find-max-geod-2 blueprints (make-instance 'state)))))
      while blueprints
      do (format t "processed ~a. its max is ~a~%" n max-geo)
      collecting max-geo into maxes
      finally (return (apply #'* maxes)))))