[p10] Maaaaaaybe

p10/p10.org

@@ -2,7 +2,7 @@
 
 #+begin_src emacs-lisp :results none
   (with-temp-buffer
-    (insert-file-contents "input")
+    (insert-file-contents "input-test")
     (advent/replace-multiple-regex-buffer
      '(("," . " ")
        ("^" . "(")
@@ -25,8 +25,6 @@
   (setq cleanedup-data (--map (cons (-map #'zero-one (advent/split-string-into-char-list (car it))) (cdr it)) data))
   #+end_src
 
-
-
 for part 1 we do not need the last item
 #+begin_src emacs-lisp
   (setq machines (--map (-drop-last 1 it) cleanedup-data))
@@ -40,16 +38,16 @@ for part 1 we do not need the last item
   (setq mask-machines (--map (cons (to-bin (car it)) (-map #'to-mask (cdr it))) machines))
 
   (-sum
-   (-map (lambda (machine) 
+   (-map (lambda (machine)
   	 (-min (-map 'length  (--filter (= (car machine) (apply 'logxor it))
   					(-powerset (cdr machine))))))
          mask-machines))
 #+end_src
 
 #+RESULTS:
-: 404
+: 7
 
-This approach blows the stack
+This approach blows the stack even for the test input
 #+begin_src emacs-lisp
   (setq machines (--map (-rotate 1 (cdr it)) data))
 
@@ -69,7 +67,8 @@ This approach blows the stack
 
 #+end_src
 
-Instead, go depth first and memoize for the win
+Instead, go depth first and memoize for the win… except that
+it does not work for the true input
 #+begin_src emacs-lisp
   (setq machines (--map (-rotate 1 (cdr it)) data)
         machines (--map (cons (car it) (--sort (> (length it) (length other)) (cdr it))) machines))
@@ -77,35 +76,154 @@ Instead, go depth first and memoize for the win
   (defun apply-button (joltage button)
     (--map-indexed (if (-contains-p button it-index) (- it 1) it) joltage))
 
-    (defun good-buttons (machine)
+  (defun good-buttons (machine)
-      (-filter (lambda (button) (--every (< 0 (nth it (car machine))) button)) (cdr machine)))
+    (-filter (lambda (button) (--every (< 0 (nth it (car machine))) button)) (cdr machine)))
-
-    (defun or-min (l)
-      (when l (-min l)))
 
-    (defun nil-1+ (l)
+  (defun or-min (l)
-      (when l (1+ l)))
+    (when l (-min l)))
 
-    (defun solve-machine (machine)
+  (defun nil-1+ (l)
-      (when machine
+    (when l (1+ l)))
-        (if (= 0 (-sum (car machine))) 0
-  	(nil-1+ (solve-machine (-first 'solve-machine (--map (cons it (cdr machine)) (--map (apply-button (car machine) it) (good-buttons machine)))))))))
 
-    (memoize 'solve-machine)
+  (defun solve-machine (machine)
-  (let ((a))
+    (when machine
-  (setq num 0
+      (if (= 0 (-sum (car machine))) 0
-  	res nil)
+        (nil-1+ (solve-machine (-first 'solve-machine (--map (cons it (cdr machine)) (--map (apply-button (car machine) it) (good-buttons machine)))))))))
-  (--each machines (progn (message (format "%d" (setq num (1+ num))))
-  			(push (solve-machine it) res)))
-  (-sum res))
 
-  (cadr machines)
+  (memoize 'solve-machine)
-  (solve-machine (cadr machines))
+  (-sum (-map 'solve-machine machines))
-  (length machines)151
 #+end_src
 
 #+RESULTS:
 : 33
 
+So we need to stop being a brute and realize that this
+is a linear algebra problem.  Gauss elimination to the rescue
+#+begin_src emacs-lisp :results none
+  (setq machines (--map (-rotate 1 (cdr it)) data)
+        machines (--map (cons (car it) (--sort (> (length it) (length other)) (cdr it))) machines))
+#+end_src
+
+#+begin_src emacs-lisp
+   ;; Now take a machine, create an "augmented" matrix to be reduced
+   ;; Notice that the "augmentation" is the first column for
+   ;;  reasons of making things more idiomatic
+
+   (defun matrix-buttons (machine)
+     (--map-indexed (cons it (--map (if (-contains-p it it-index) 1 0) (cdr machine))) (car machine)))
+
+   (defun find-pivot (row index)
+     (let ((p (--find-index (not (= it 0)) (-drop index row))))
+       (when p (+ p index))))
+
+   (defun swap-indices (i j list)
+     (if (= i j) list
+       (let ((el-i (nth i list))
+             (el-j (nth j list)))
+         (-replace-at j el-i (-replace-at i el-j list)))))
+
+   (defun subtract-indices (λ i j list)
+     "Subtracts λ× element i from element j"
+     (let ((el-i (nth i list))
+           (el-j (nth j list)))
+       (-replace-at j (- el-j (* λ el-i)) list)))
+
+   (defun subtract-composite (lambdas i list)
+     (--each (-iota (length lambdas))
+       (setq list (subtract-indices (nth it lambdas) i it list)))
+     list)
+
+   ;; Here we row-reduce; this is non-unique
+   (defun row-reduce (matrix)
+     (let* ((v (-map #'car matrix)) ;; vector
+            (rM (-map #'cdr matrix)) ;; reduced matrix
+            (rMt (apply '-zip-lists rM)) ;transpose
+            (base 0))
+       (--each (-iota (length rMt))
+         (let ((pivot (find-pivot (nth it rMt) base)))
+           (when pivot
+             (setq rMt (-map (lambda (row)
+                               (swap-indices base pivot row))
+                             rMt)
+                   v (swap-indices base pivot v))
+             ;; hopefully we never have to divide
+             ;; now we have to clean the other bits
+                                           ;          (fwq)
+             ;; this is the pivot
+             (let* ((pivot-coeff (nth base (nth it rMt)))
+                    (lambdas (append (-repeat (1+ base) 0) (-drop (1+ base) (nth it rMt))))
+                    (lambdas-corrected (--map (/ it (* 1 pivot-coeff)) lambdas)))
+               (setq rMt (--map (subtract-composite lambdas-corrected base it) rMt)
+                     v (subtract-composite lambdas-corrected base v)))
+             (setq base (1+ base)))))
+       (apply '-zip-lists (cons v rMt))))
+
+   (defun solve-row-reduced (matrix)
+     ;; we start from the last row
+     (let ((soln (-repeat (length (cdar matrix)) 0)))
+       (--each (-iota (length matrix) (- (length matrix) 1) -1)
+         (let* ((row (nth it matrix))
+                (a (car row))
+                (i (--find-index (not (= 0 it)) (cdr row))))
+           (when i
+             (setq correction (advent/dot soln (append (-repeat (1+ i) 0) (drop (1+ i) (cdr row))))
+                   soln (-replace-at i (/ (- a correction) (nth i (cdr row))) soln)))))
+       soln))
+
+   (solve-row-reduced (row-reduce (matrix-buttons (caddr machines))))
+   ;; now, this is correct, but we need a positive solution that has
+   ;; fewest button presses possible.
+
+   (defun unshadowed-buttons (matrix)
+     (let ((result))
+       (--each (-iota (length matrix) (- (length matrix) 1) -1)
+         (let* ((row (nth it matrix))
+                (i (--find-index (not (= 0 it)) (cdr row))))
+           (when i (push i result))))
+       result))
+
+   (defun shadowed-buttons (matrix)
+     (-difference (-iota (length (cdar matrix))) (unshadowed-buttons matrix)))
+
+   (defun shadowed-button-solution (i matrix)
+     (solve-row-reduced (let ((transpose (apply '-zip-lists matrix)))
+        (apply '-zip-lists (cons (nth (1+ i) transpose) (cdr transpose))))))
+
+   (defun solve-machine (machine)
+     (let* ((reduced-mat (row-reduce (matrix-buttons machine)))
+            (candidate (solve-row-reduced reduced-mat)))
+       (if (--every (<= 0 it) candidate) candidate
+         (let ((shadowed (shadowed-buttons reduced-mat)))
+           ;; try replacing the shadowed button with the previous one
+           (solve-machine
+            (swap-indices (car shadowed) (1+ (car shadowed))  machine))))))
+
+  (defun vector- (v1 v2)
+    (--map (- (car it) (cdr it)) (-zip-pair v1 v2)))
+
+  (defun push-button (i machine-matrix)
+    (let ((tr (apply '-zip-lists machine)))
+      (apply '-zip-lists (cons (vector- (car tr) (nth (1+ i) tr)) (cdr tr)))))
+
+  (defun machine-valid-p (machine)
+    (arst)
+    (--every (>= it 0) (-map #'car machine)))
+
+   (defun solve-machine (machine)
+     (let* ((reduced-mat (row-reduce (matrix-buttons machine)))
+            (shadowed (shadowed-buttons reduced-mat))
+            (max-iter (-max (car machine))))
+       ;; we create a bunch of machines pushing the shadowed buttons a number of times.
+       max-iter
+       ))
 
+  (push-button 0 (car machines))
 
+  (car machines)
+  (-map 'solve-machine machines)
+#+end_src
+
+#+RESULTS:
+| 5 | 1 |  3 | 0 | 1 | 0 |
+| 2 | 0 |  5 | 5 | 0 |   |
+| 6 | 5 | -1 | 0 |   |   |