From c82fbdebcfbcc468c356d91e72ed0822e4e8880d Mon Sep 17 00:00:00 2001 From: Jacopo De Simoi Date: Thu, 11 Dec 2025 22:01:03 -0500 Subject: [PATCH] [p10] This still does not work --- p10/p10.org | 221 ++++++++++++++++++++++++---------------------------- 1 file changed, 101 insertions(+), 120 deletions(-) diff --git a/p10/p10.org b/p10/p10.org index f7ab351..7d5055e 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-test") + (insert-file-contents "input") (advent/replace-multiple-regex-buffer '(("," . " ") ("^" . "(") @@ -105,125 +105,106 @@ is a linear algebra problem. Gauss elimination to the rescue #+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) + ;; 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 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 #+end_src #+RESULTS: -| 5 | 1 | 3 | 0 | 1 | 0 | -| 2 | 0 | 5 | 5 | 0 | | -| 6 | 5 | -1 | 0 | | | +: 33