advent-2025/p10/p10.org

Solution to p10

This problem is pretty hard. I have not yet completely understood the linear algebra behind it.

  (with-temp-buffer
    (insert-file-contents "input-test")
    (advent/replace-multiple-regex-buffer
     '(("," . " ")
       ("^" . "(")
       ("$" . ")")
       ("\\[" . "\"")
       ("\\]" . "\"")
       ("{" . "(")
       ("}" . ")")
       ))
    (goto-char (point-min))
    (insert "(setq data '(")
    (goto-char (point-max))
    (insert "))")
    (eval-buffer))

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.

For part 2, the same approach blows the stack even for the test input

  (setq machines (--map (-rotate 1 (cdr it)) data))

  (defun apply-button (joltage button)
    (--map-indexed (if (-contains-p button it-index) (- it 1) it) joltage))

  (defun good-buttons (machine)
    (-filter (lambda (button) (--every (< 0 (nth it (car machine))) button)) (cdr machine)))

  (defun solve-machines (machines)
    (-mapcat (lambda (machine)
  	     (if (= 0 (-sum (car machine))) (list machine)
  	       (--map (cons it (cdr machine)) (--map (apply-button (car machine) it) (good-buttons machine)))))
  	    machines ))

  (-iterate 'solve-machines (list (car machines)) 19)

Instead, go depth first and memoize for the win… This works for the test input, but takes forever for the true input.

  (setq machines (--map (-rotate 1 (cdr it)) data)
        machines (--map (cons (car it) (--sort (> (length it) (length other)) (cdr it))) machines))

  (defun apply-button (joltage button)
    (--map-indexed (if (-contains-p button it-index) (- it 1) it) joltage))

  (defun good-buttons (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)
    (when l (1+ l)))

  (defun solve-machine (machine)
    (when machine
      (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)
  (-sum (-map 'solve-machine machines))

33

So we need to stop being a brute and realize that this is a linear algebra problem. Gauss elimination to the rescue. There is a little complication, since the matrices involved are degenerate and we have constraints;

  (setq machines (--map (-rotate 1 (cdr it)) data) machines)

These are some auxiliary functions to create and deal with matrices

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

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

  ; This is a routine for row-reducing the augmented matrix
  (defun row-reduce (matrix)
    (let* ((rMt (apply '-zip-lists matrix)) ;transpose
           (base-index 0))
      ; here we cannot use -map, since we are changing the matrix as we
      ; go
      (--each (-iota (1- (length rMt)) 1) ;skip over the constant
        (let* ((original-row (nth it rMt))
               (pivot-index (find-pivot original-row base-index)))
          (when pivot-index
            (setq rMt (--map (swap-indices base-index pivot-index it) rMt))
            (let* ((pivot-coeff (nth pivot-index original-row)))
              (when (< pivot-coeff 0)
                (setq rMt (--map (flip-index base-index it) rMt)))
              (assert (= 1 (abs pivot-coeff)))
              (let* ((lambdas (append (-repeat (1+ base-index) 0)
                                      (-drop (1+ base-index) (nth it rMt))))
                     (lambdas-corrected (--map (/ it (abs pivot-coeff)) lambdas)))
                (setq rMt (--map (subtract-composite lambdas-corrected base-index it) rMt)
                      base-index (1+ base-index)))))))
      (apply '-zip-lists rMt)))

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

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

       (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 rank (matrix)
        (length (-non-nil (--map (--find-index (not (= 0 it)) (cdr it)) matrix))))

      (defun matrix-appl (matrix vector)
        (--map (advent/dot it vector) matrix))

      (defun solution-p (machine candidate)
        (--every (= 0 it) (matrix-appl (matrix-buttons machine) (cons -1 candidate)))
        )
    (setq current-machine nil)
      (defun solve--machine (machine)
        (setq current-machine machine)
        (let ((candidate (solve-row-reduced (row-reduce (matrix-buttons machine)))))
     (setq canca candidate)
          (and (--every (>= it 0) candidate) (solution-p machine candidate) candidate)))

      (defun solve-machine (machine)
        (let* ((reduced-mat (row-reduce (matrix-buttons machine)))
               (rank (rank reduced-mat))
          (bunch (--map (cons (car machine) it)
                    (--filter 'identity
         ;(<= rank (length it))
         (-powerset (cdr machine))))))
          (-min (-map '-sum (-non-nil (-map 'solve--machine bunch))))
          ))

      (-sum (-map 'solve-machine machines))
      current-machine
  (solve--machine machine)
  canca

33