From fe45251624e59f9c1087eac7069c2a1acfc121a3 Mon Sep 17 00:00:00 2001 From: Jacopo De Simoi Date: Thu, 11 Dec 2025 16:31:58 -0500 Subject: [PATCH] [p10] Maaaaaaybe --- p10/p10.org | 174 +++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 146 insertions(+), 28 deletions(-) diff --git a/p10/p10.org b/p10/p10.org index 28b6e5a..f7ab351 100644 --- a/p10/p10.org +++ b/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) - (-filter (lambda (button) (--every (< 0 (nth it (car machine))) button)) (cdr machine))) - - (defun or-min (l) - (when l (-min l))) + (defun good-buttons (machine) + (-filter (lambda (button) (--every (< 0 (nth it (car machine))) button)) (cdr machine))) - (defun nil-1+ (l) - (when l (1+ l))) + (defun or-min (l) + (when l (-min 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))))))))) + (defun nil-1+ (l) + (when l (1+ l))) - (memoize 'solve-machine) - (let ((a)) - (setq num 0 - res nil) - (--each machines (progn (message (format "%d" (setq num (1+ num)))) - (push (solve-machine it) res))) - (-sum res)) + (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))))))))) - (cadr machines) - (solve-machine (cadr machines)) - (length machines)151 + (memoize 'solve-machine) + (-sum (-map 'solve-machine machines)) #+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 | | |