[p10] Another attempt

This still blows the stack, but at least gets past the first 24 matrices…

p10/p10.org

@@ -84,7 +84,7 @@ degenerate and we have constraints;
 #+end_src
 
 These are some auxiliary functions to create and deal with matrices
-#+begin_src emacs-lisp
+#+begin_src emacs-lisp :results none
   (defun matrix-buttons (machine)
     "Takes MACHINE and returns the corresponding augmented matrix of the
   linear system.  The vector of constants is the first column vector
@@ -155,16 +155,21 @@ These are some auxiliary functions to create and deal with matrices
         (if (not list) 0
           (-min list)))
 
-  (defun value (list &optional base)
+      (defun trip-value (list &optional base)
         (let ((n (* 1.0 (length list))))
-      (--map (+ (set-distance base it) (/ (-min-or-0 (--remove (= 0 it) (-map (lambda (new) (set-distance (-union base it) new)) list))) n)) list)))
+          (--map (+ (set-distance base it)
+                    (/ (-min-or-0 (--remove (= 0 it) (-map (lambda (new)
+                                                             (set-distance (-union base it) new))
+                                                           list)))
+                       n))
+                 list)))
 
-  (defun sort-re-value (list &optional base)
+      (defun sort-re-trip-value (list &optional base)
-    (-map 'cdr (--sort (< (car it) (car other))  (-zip-pair (value list base) list))))
+        (-map 'cdr (--sort (< (car it) (car other))  (-zip-pair (trip-value list base) list))))
 
       (defun sort-recursively (list &optional base)
         (when list
-      (let* ((step (sort-re-value list base))
+          (let* ((step (sort-re-trip-value list base))
            (top (car step))
            (bottom (cdr step)))
             (cons top
@@ -174,23 +179,38 @@ These are some auxiliary functions to create and deal with matrices
         (let* ((machine-1 (cons (car machine) (sort-recursively (cdr machine))))
          (sorted (-reduce '-union (cdr machine-1)))
          (permutation (-grade-up '< sorted)))
-      (cons (--map-indexed (nth (nth it-index permutation) (car machine-1)) (car machine-1))
+          (cons (-select-by-indices sorted (car machine-1))
-  	  (--map (--map (nth it permutation) it) (cdr machine-1)))
+          (--map (--map (nth it permutation) it) (cdr machine-1)))))
-      ))
 
-  ;(setq machines (-map #'fix-machine machines))
+    (matrix-buttons (cadr machines))
-  ( (matrix-buttons (fix-machine (car machines))))
+      (matrix-buttons (fix-machine (cadr machines)))
 #+end_src
 
 #+RESULTS:
-|  77 | 1 | 0 | 1 | 0 | 1 | 1 | 1 | 1 |  0 |  0 |
+| 51 | 1 | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 1 |
-|  49 | 0 | 1 | 1 | 1 | 0 | 1 | 0 | 1 |  1 |  0 |
+| 74 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 1 | 0 | 1 |
-|   5 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 1 | -1 | -1 |
+| 72 | 1 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 1 | 0 |
-|  90 | 0 | 0 | 0 | 1 | 1 | 2 | 1 | 0 |  2 |  1 |
+| 31 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 1 |
-| -12 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 |  0 |  0 |
+| 49 | 0 | 0 | 1 | 0 | 1 | 0 | 1 | 1 | 0 | 0 |
-|  68 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 1 |  1 | -1 |
+| 77 | 0 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
-|  38 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 |  1 |  1 |
+| 38 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 1 | 1 |
-| -18 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |  1 | -1 |
+| 61 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | 1 | 1 |
+
+
+#+RESULTS:
+|  7 | 1 | 0 | 1 | 1 | 0 |
+|  5 | 0 | 0 | 0 | 1 | 1 |
+| 12 | 1 | 1 | 0 | 1 | 1 |
+|  7 | 1 | 1 | 0 | 0 | 1 |
+|  2 | 1 | 0 | 1 | 0 | 1 |
+
+
+
+#+begin_src emacs-lisp
+
+
+  (-min (-map '-sum (solve-well-ordered (matrix-buttons (fix-machine (cadr machines))))))
+#+end_src
 
 This is the tricky part; we want solve the row-reduced form, but we
 need to be careful with our choices if we have more than one
@@ -238,27 +258,51 @@ possibility
             (setq current-row (1- current-row)))))
       soln))
 
-  (defun minimal-pushes (machine)
+  (setq buttons nil)
-    (-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine))))))
-
 
-  (setq problematic (--first (not (solve-row-reduced (identity (matrix-buttons it)))) machines))
+  (defun solve-well-ordered (matrix)
-
+    ;; we start from the last row
-  (minimal-pushes (cadr machines))
+    (let* ((number-of-buttons (1- (length (car matrix))))
-  (row-reduce (matrix-buttons problematic))
+           (soln (list (-repeat number-of-buttons 0)))
+           (last-used-button number-of-buttons)
+           (current-row (1- (length matrix))))
+      (while (> last-used-button 0)
+        (push last-used-button buttons)
+        (let* ((row (nth current-row matrix))
+               (a (car row))
+               (rrow (cdr row))
+               (i (--find-index (not (zerop it)) (-take last-used-button rrow))))
+          (if i
+              (let ((possible-indices (--filter (not (zerop (nth it rrow)))
+                                                (-iota (- last-used-button i) i))))
+                (if (= 1 (length possible-indices)) ;no choices here, easy
+                    (setq soln (-non-nil (--map (let* ((correction (advent/dot it (-replace-at i 0 rrow)))
+                                                       (corrected-a (- a correction)))
+                                                  (unless (< corrected-a 0)
+                                                    (-replace-at i corrected-a it)))
+                                                soln))
+                          last-used-button i
+                          current-row (1- current-row)) ; this needs to change
+                  ;;otherwise, we create a number of solutions
+                  (let* ((button (-last-item possible-indices)))
+                    (setq soln (--mapcat (let* ((correction (advent/dot it (-replace-at i 0 rrow)))
+                                                (max-soln (- a correction)))
+                                           (if (< max-soln 0) (list it)
+                                             (-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln)))))
+                                         soln)
+                          last-used-button button))))
+            (setq soln (-non-nil (--map (when (= a (advent/dot it rrow)) it) soln))
+                  current-row (1- current-row)))))
+      soln))
 
+  (defun minimal-pushes (machine)
+    (-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine))))))
 
+  last-used-button
 #+end_src
 
 #+RESULTS:
-| 51.0 | 1.0 | 1.0 | 1.0 | 0.0 | 0.0 | 0.0 |  1.0 | 0.0 |  0.0 | 0.0 |
+: minimal-pushes
-| 31.0 | 0.0 | 1.0 | 0.0 | 0.0 | 1.0 | 0.0 |  0.0 | 0.0 |  1.0 | 0.0 |
-| 43.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 |  1.0 | 0.0 |  0.0 | 1.0 |
-| 10.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 1.0 | -1.0 | 0.0 |  0.0 | 0.0 |
-| 16.0 | 0.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 |  0.0 | 0.0 |  0.0 | 0.0 |
-| 23.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 1.0 |  0.0 | 1.0 | -1.0 | 0.0 |
-| 33.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 |  1.0 | 0.0 |  2.0 | 1.0 |
-| 19.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 |  0.0 | 2.0 | -1.0 | 0.0 |
 
 
 try this. create a distance in the space of buttons given by the number of elements in the difference
@@ -294,13 +338,10 @@ try this. create a distance in the space of buttons given by the number of eleme
                     (--filter (= rank (length it))
                               (-powerset (cdr machine))))))
           (-min (-map '-sum (-non-nil (-map 'solve--machine bunch))))))
-  
+  (-first (not ))
   (-sum (-map 'solve-machine machines))
 
 #+end_src
 
 #+RESULTS:
 : 33
-* 
-
-*