[p10] Refactor the row-reduction code

p10/p10.org

@@ -4,7 +4,7 @@ This problem is pretty hard. I have not yet completely understood the
 linear algebra behind it.
 #+begin_src emacs-lisp :results none
   (with-temp-buffer
-    (insert-file-contents "input")
+    (insert-file-contents "input-test")
     (advent/replace-multiple-regex-buffer
      '(("," . " ")
        ("^" . "(")
@@ -24,39 +24,8 @@ linear algebra behind it.
 For part 1 we do not need the last item This is a linear algebra
 problem in characteristic 2; we are essentially bruteforcing the
 vector space; we easily succeed.
-#+begin_src emacs-lisp
-  (defun zero-one (n)
-    (if (eq n ?#) 1 0))
-
-  (setq cleanedup-data (--map (cons (-map #'zero-one
-                                          (advent/split-string-into-char-list (car it)))
-                                    (cdr it))
-                              data))
-
-  (setq machines (--map (-drop-last 1 it) cleanedup-data))
-
-  (defun to-bin (l)
-    (-sum  (--map-indexed (* it (expt 2 it-index)) l)))
-
-  (defun to-mask (l)
-    (-sum (--map (expt 2 it) l)))
-
-  (setq mask-machines (--map (cons (to-bin (car it))
-                                   (-map #'to-mask (cdr it)))
-                             machines))
-
-  (-sum
-   (-map (lambda (machine)
-     (-min (-map 'length  (--filter (= (car machine) (apply 'logxor it))
-                    (-powerset (cdr machine))))))
-         mask-machines))
-#+end_src
-
-#+RESULTS:
-: 7
-
 
-This approach blows the stack even for the test input
+For part 2, the same approach blows the stack even for the test input
 #+begin_src emacs-lisp
   (setq machines (--map (-rotate 1 (cdr it)) data))
 
@@ -73,11 +42,10 @@ This approach blows the stack even for the test input
   	    machines ))
 
   (-iterate 'solve-machines (list (car machines)) 19)
-
 #+end_src
 
-Instead, go depth first and memoize for the win… except that
+Instead, go depth first and memoize for the win… This works for the
-it does not work for the true input
+test input, but takes forever 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))
@@ -106,21 +74,26 @@ it does not work for the true input
 #+RESULTS:
 : 33
 
-So we need to stop being a brute and realize that this
+So we need to stop being a brute and realize that this is a linear
-is a linear algebra problem.  Gauss elimination to the rescue
+algebra problem.  Gauss elimination to the rescue.
+There is a little complication, since the matrices involved are
+degenerate and we have constraints;
+
 #+begin_src emacs-lisp :results none
-  (setq machines (--map (-rotate 1 (cdr it)) data)
+  (setq machines (--map (-rotate 1 (cdr it)) data) machines)
-        machines (--map (cons (car it) (--sort (> (length it) (length other)) (cdr it))) machines))
 #+end_src
 
+These are some auxiliary functions to create and deal with matrices
 #+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)))
+    "Takes MACHINE and returns the corresponding augmented matrix of the
-
+  linear system.  The vector of constants is the first column vector
+  instead of the last column as usual(it is more idiomatic this way)"
+    (--map-indexed (cons it (--map (if (-contains-p it it-index) 1 0)
+                                   (cdr machine)))
+                   (car machine)))
+
+  ;; These are convenience functions that we will use for row-reducing
   (defun find-pivot (row index)
     (let ((p (--find-index (not (= it 0)) (-drop index row))))
       (when p (+ p index))))
@@ -137,36 +110,55 @@ is a linear algebra problem.  Gauss elimination to the rescue
           (el-j (nth j list)))
       (-replace-at j (- el-j (* λ el-i)) list)))
 
+  (defun flip-index (i list)
+    "Flip the sign of element i"
+    (let ((el-i (nth i list)))
+      (-replace-at i (* -1 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
+  ; This is a routine for row-reducing the augmented matrix
   (defun row-reduce (matrix)
-            (let* ((v (-map #'car matrix)) ;; vector
+    (let* ((rMt (apply '-zip-lists matrix)) ;transpose
-                   (rM (-map #'cdr matrix)) ;; reduced matrix
+           (base-index 0))
-                   (rMt (apply '-zip-lists rM)) ;transpose
+      ; here we cannot use -map, since we are changing the matrix as we
-                   (base 0))
+      ; go
-              (--each (-iota (length rMt))
+      (--each (-iota (1- (length rMt)) 1) ;skip over the constant
-                (let ((pivot (find-pivot (nth it rMt) base)))
+        (let* ((original-row (nth it rMt))
-                  (when pivot
+               (pivot-index (find-pivot original-row base-index)))
-                    (setq rMt (-map (lambda (row)
+          (when pivot-index
-                                      (swap-indices base pivot row))
+            (setq rMt (--map (swap-indices base-index pivot-index it) rMt))
-                                    rMt)
+            (let* ((pivot-coeff (nth pivot-index original-row)))
-                          v (swap-indices base pivot v))
+              (when (< pivot-coeff 0)
-                    ;; hopefully we never have to divide
+                (setq rMt (--map (flip-index base-index it) rMt)))
-                    ;; now we have to clean the other bits
+              (assert (= 1 (abs pivot-coeff)))
-                                                  ;          (fwq)
+              (let* ((lambdas (append (-repeat (1+ base-index) 0)
-                    ;; this is the pivot
+                                      (-drop (1+ base-index) (nth it rMt))))
-                    (let* ((pivot-coeff (nth base (nth it rMt)))
+                     (lambdas-corrected (--map (/ it (abs pivot-coeff)) lambdas)))
-                           (lambdas (append (-repeat (1+ base) 0) (-drop (1+ base) (nth it rMt))))
+                (setq rMt (--map (subtract-composite lambdas-corrected base-index it) rMt)
-                           (lambdas-corrected (--map (/ it (* 1 pivot-coeff)) lambdas)))
+                      base-index (1+ base-index)))))))
-                      (setq rMt (--map (subtract-composite lambdas-corrected base it) rMt)
+      (apply '-zip-lists rMt)))
-                            v (subtract-composite lambdas-corrected base v)))
+#+end_src
-                    (setq base (1+ base)))))
+
-              (apply '-zip-lists (cons v rMt))))
+#+RESULTS:
+| 10 | 1 | 1 | 1 |  0 |
+| -1 | 0 | 1 | 0 | -1 |
+|  5 | 0 | 0 | 1 |  0 |
+|  0 | 0 | 0 | 0 |  0 |
+|  0 | 0 | 0 | 0 |  0 |
+|  0 | 0 | 0 | 0 |  0 |
+
+arst
+#+RESULTS:
+| 7 | 1 | 1 | 0 | 1 | 0 | 0 |
+| 5 | 0 | 1 | 0 | 0 | 0 | 1 |
+| 4 | 0 | 0 | 1 | 1 | 1 | 0 |
+| 3 | 0 | 0 | 0 | 0 | 1 | 1 |
 
+#+begin_src emacs-lisp
        (defun solve-row-reduced (matrix)
          ;; we start from the last row
          (let ((soln (-repeat (length (cdar matrix)) 0)))