(ql:quickload '(fiveam uiop cl-ppcre fset lparallel))
;; (setf lparallel:*kernel* (lparallel:make-kernel 8))

(declaim (optimize (speed 0) (space 0) (debug 3)))

(defun material (string)
  (cond
    ((string= string "ore") :ore)
    ((string= string "clay") :clay)
    ((string= string "obsidian") :obsidian)
    ((string= string "geode") :geode)))

(defun parse-robot-recipe (line)
  (cl-ppcre:register-groups-bind ((#'material robot) (#'parse-integer fq) (#'material fm) (#'parse-integer sq) (#'material sm))
      ("(\\w+) robot costs (\\d+) (\\w+)(?: and (\\d+) (\\w+))?" line)
    (let ((first-material (fset:with (fset:empty-bag) fm fq)))
      (fset:map (robot
                 (if sm (fset:with first-material sm sq)
                     first-material))))))


(defun can-build-robot-pm (requirements available)
  (fset:subbag? requirements available))

(defun consume (requirements available)
  (fset:bag-difference available requirements))

(defun material-collect (bots available-materials)
  (fset:bag-sum bots available-materials))

(defun bot-requirements (type recipes)
  (fset:lookup recipes type))

(defun next-step (build-next robots resources blueprints time-left)
  (if (zerop time-left)
      ;; (list robots resources)
      (fset:multiplicity resources :geode)
      ;; resources
      (let ((req (bot-requirements build-next blueprints)))
        (if (can-build-robot-pm req resources)
            (let ((new-robots (fset:with robots build-next))
                  (resources-left (consume req resources)))
              (probe new-robots
                     (material-collect robots resources-left)
                     blueprints (1- time-left)))
            (next-step build-next
                       robots
                       (material-collect robots resources)
                       blueprints (1- time-left))))))

  (if (zerop time-left)
      (values robots resources time-left))

(defun next-step2 (build-next robots resources blueprints)
  (let ((req (bot-requirements build-next blueprints)))
    (when (can-build-robot-pm req resources)
      (let ((new-robots (fset:with robots build-next))
            (resources-left (consume req resources)))
        (values new-robots (material-collect robots resources-left))))))


(let ((factory (cdar (get-blueprints "/home/titan/dev/scratch/AoC2022/19/eg-in"))))
  ;; (next-step2 :clay (fset:bag :ore) (fset:bag :ore :ore) factory)
  ;; (probe2 (list (fset:bag :ore :clay) (fset:bag :ore :ore)) factory)
  ;; (arrows:->
  ;;  (list (list (fset:bag :ore :clay) (fset:bag :ore :ore)))
  ;;  (advance factory)
  ;;  (advance factory)
  ;;  (advance factory)
  ;;  (advance factory)
  ;;  (advance factory)
  ;;  (advance factory)
  ;;  (advance factory)
  ;;  )
  (find-best (list (list (fset:bag :ore) (fset:bag))) factory 9))

(defun probe2 (current-state blueprints)
  (destructuring-bind (robots resources) current-state
    (reduce
     (lambda (acc bot-type)
       (multiple-value-bind (new-robots new-states)
           (next-step2 bot-type
                       robots
                       resources
                       blueprints)
         (if new-robots (cons (list new-robots new-states) acc) acc)))
     (propose-builds robots (max-cost blueprints))
     :initial-value (list (list robots (material-collect robots resources))))))

(defun advance (robot-resource-list blueprints)
  (reduce
   (lambda (new-states current-state)
     (union new-states
            (probe2 current-state blueprints)
            :test #'equal))
   robot-resource-list
   :initial-value nil))

(defun find-best (robot-resource-list blueprints time-left)
  (if (zerop time-left)
      robot-resource-list
      (find-best (advance robot-resource-list blueprints) blueprints (1- time-left))))

(defun max-cost (blueprint)
  (fset:reduce
   (lambda (acc key value)
     (declare (ignore key))
     (fset:union value acc))
   blueprint
   :initial-value (fset:empty-bag)))

(defun can-build (bots)
  (append
   (list :clay :ore)
   (when (plusp (fset:multiplicity bots :clay)) (list :obsidian))
   (when (plusp (fset:multiplicity bots :obsidian)) (list :geode))))

(defun propose-builds (bots costs)
  (loop for try in (can-build bots)
        when (or (eq :geode try)
                 (< (fset:multiplicity bots try)
                    (fset:multiplicity costs try)))
          collect try))

(defun probe (robots resources blueprints time-left)
  (reduce #'max
          (mapcar
           (lambda (next)
             (next-step next
                        robots
                        resources
                        blueprints time-left))
           (propose-builds robots (max-cost blueprints)))))

(defun get-blueprints (filename)
  (mapcar
   (lambda (l)
     (let ((blueprint (uiop:split-string l :separator ":.")))
       (cons (car blueprint)
             (reduce #'fset:map-union
                     (mapcar #'parse-robot-recipe (butlast (cdr blueprint)))))))
   (uiop:read-file-lines filename)))

(defun solver (blueprints time-left)
  (apply #'+
         (lparallel:pmap 'list
                         (lambda (bp)
                           (destructuring-bind (name . recipes) bp
                             (* (parse-integer name :start 10)
                                (probe (fset:bag :ore) (fset:empty-bag) recipes time-left))))
                         blueprints)))

(defun solver2 (blueprints time-left)
  (lparallel:pmap 'list
                  (lambda (bp)
                    (destructuring-bind (name . recipes) bp
                      (declare (ignore name))
                      (probe (fset:bag :ore) (fset:empty-bag) recipes time-left)))
                  blueprints))

;; (require :sb-sprof)
;; (progn
;;   (sb-sprof:start-profiling)
;;   (time
;;    (probe (fset:bag :ore) (fset:empty-bag) (cdar (get-blueprints "eg-in")) 25))
;;   (sb-sprof:stop-profiling)
;;   (sb-sprof:report))

(step
 (probe (fset:bag :ore) (fset:empty-bag) (cdar (get-blueprints "/home/titan/dev/scratch/AoC2022/19/eg-in")) 22))



(fiveam:test solution
  ;; part1
  ;; (fiveam:is (= 33 (solver (get-blueprints "eg-in") 24)))
  (fiveam:is (= 1266 (solver (get-blueprints "/home/titan/dev/scratch/AoC2022/19/input") 24)))
  )

;; (let ((blueprints
;;         ;; (cdadr)
;;         (get-blueprints "input")
;;         )
;;       ;; (materials '(:ore 8 :clay 20))
;;       (materials (start-resources))
;;       (bots (start-bots))
;;       ;; (bots '(:geode 1 :ore 8 :clay 20))
;;       (time-left 24))
;;   (time
;;    (apply #'+
;;           (lparallel:pmap 'list
;;                           (lambda (bp)
;;                             (destructuring-bind (name . recipes) bp
;;                               (* (parse-integer name :start 10)
;;                                  (probe bots materials recipes time-left))))
;;                           blueprints)))

;;   ;; (time
;;   ;;  (print (probe bots materials blueprints 24)))
;;   )