From e7ba194a87e3cd25cfceb91a9a789611ad1e36f5 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Thu, 12 Jan 2023 17:27:35 +0100
Subject: Working. Use fset a lot more

---
 AoC2022/19/solver.lisp | 70 ++++++++++++++++++++++++++++++++------------------
 1 file changed, 45 insertions(+), 25 deletions(-)

(limited to 'AoC2022/19/solver.lisp')

diff --git a/AoC2022/19/solver.lisp b/AoC2022/19/solver.lisp
index b939bea..d3af8e0 100644
--- a/AoC2022/19/solver.lisp
+++ b/AoC2022/19/solver.lisp
@@ -57,31 +57,31 @@
 
 (defun probe2 (current-state blueprints)
   (destructuring-bind (robots resources) current-state
-    (reduce
+    (fset:reduce
      (lambda (acc bot-type)
-       (multiple-value-bind (new-robots new-states)
+       (multiple-value-bind (new-robots new-resources)
            (next-step2 bot-type
                        robots
                        resources
                        blueprints)
-         (if new-robots (cons (list new-robots new-states) acc) acc)))
+         (if new-robots (fset:with acc (list new-robots new-resources)) acc)))
      (propose-builds robots (max-cost blueprints))
-     :initial-value (list (list robots (material-collect robots resources))))))
+     :initial-value (fset:set (list robots (material-collect robots resources))))))
 
 (defun advance (robot-resource-list blueprints)
-  (reduce
+  (fset:reduce
    (lambda (new-states current-state)
-     (union new-states
+     (fset:union new-states
             (probe2 current-state blueprints)
-            :test #'equal))
+            ))
    robot-resource-list
-   :initial-value nil))
+   :initial-value (fset:empty-set)))
 
-(resource-increase
- (list (fset:bag :obsidian :ore) (fset:bag :clay)) 2)
+;; (resource-increase
+;;  (list (fset:bag :obsidian :ore) (fset:bag :clay)) 2)
 
-(defun materials< (m1 m2)
-  (eq :less
+(defun materials> (m1 m2)
+  (eq :greater
       (fset:reduce (lambda (result material)
                      (if (eq result :equal)
                          (let ((c1 (fset:multiplicity m1 material))
@@ -94,18 +94,38 @@
                    '(:geode :obsidian :clay :ore)
                    :initial-value :equal)))
 
-(materials< (fset:bag :clay) (fset:bag :obsidian :ore))
+(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
-    (loop for s = resources then (fset:bag-sum s robots)
-          repeat time-left
-          finally (return s))))
+    (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)
+(defun find-best (robot-resource-list blueprints time-left state-truncation)
   (if (zerop time-left)
-      robot-resource-list
-      (find-best (advance robot-resource-list blueprints) blueprints (1- 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
@@ -164,7 +184,8 @@
                       (probe (fset:bag :ore) (fset:empty-bag) recipes time-left)))
                   blueprints))
 
-(let ((factory (cdar (get-blueprints "/home/titan/dev/scratch/AoC2022/19/eg-in"))))
+(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:->
@@ -177,11 +198,10 @@
   ;;  (advance factory)
   ;;  (advance factory)
   ;;  )
-  (sort
-   ;; (mapcar (lambda (state)
-   ;;           (fset:multiplicity (cadr state) :ore)))
-   (find-best (list (list (fset:bag :ore) (fset:bag))) factory 5)
-   #'materials< :key (lambda (state) (resource-increase state 5))))
+  ;; (max-cost factory)
+  (time
+   (find-best (list (list (fset:bag :ore) (fset:bag))) factory 32 1024))
+  )
 
 
 ;; (require :sb-sprof)
-- 
cgit v1.2.3