(ql:quickload '(fiveam uiop cl-ppcre fset lparallel arrows))
;; (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))))))

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

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

(defun advance (robot-resource-list blueprints)
  (fset:reduce
   (lambda (new-states current-state)
     (fset:union new-states
            (probe2 current-state blueprints)
            ))
   robot-resource-list
   :initial-value (fset:empty-set)))

;; (resource-increase
;;  (list (fset:bag :obsidian :ore) (fset:bag :clay)) 2)

(defun materials> (m1 m2)
  (eq :greater
      (fset:reduce (lambda (result material)
                     (if (eq result :equal)
                         (let ((c1 (fset:multiplicity m1 material))
                               (c2 (fset:multiplicity m2 material)))
                           (cond
                             ((< c1 c2) :less)
                             ((= c1 c2) :equal)
                             ((> c1 c2) :greater)))
                         result))
                   '(:geode :obsidian :clay :ore)
                   :initial-value :equal)))

(defun leading-configs (robot-resource-list time-left truncate)
  (let ((len (fset:size robot-resource-list)))
    (format t "time-left: ~a, list: ~a~%" time-left len))
  (fset:subseq
   (fset:sort robot-resource-list
              #'materials> :key (lambda (state) (resource-increase state time-left)))
   0 truncate))

(fset:subseq
 (fset:sort (fset:set 5 4 4 5 8 2) #'> ) 0 15)

;; (materials< (fset:bag :clay) (fset:bag :obsidian :ore))

(defun resource-increase (current-state time-left)
  (destructuring-bind (robots resources) current-state
    (reduce (lambda (acc material)
              (fset:with acc material
                         (* time-left (fset:multiplicity robots material))))
            '(:geode :obsidian :clay :ore)
            :initial-value resources)))

(defun find-best (robot-resource-list blueprints time-left state-truncation)
  (if (zerop time-left)
      (arrows:-> robot-resource-list
                 (fset:subseq 0 3)
                 ;; (cadar)
                 ;; (fset:multiplicity :geode)
                 )
      (find-best (leading-configs
                  (advance robot-resource-list blueprints)
                  (1- time-left) state-truncation)
                 blueprints (1- time-left) state-truncation)))

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

(let ((factory (cdar (get-blueprints "/home/titan/dev/scratch/AoC2022/19/eg-in")))
      (time-left 30))
  ;; (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)
  ;;  )
  ;; (max-cost factory)
  (time
   (find-best (list (list (fset:bag :ore) (fset:bag))) factory 32 1024))
  )


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