From faadaf6501a33d8f4b00e1f7c6d3b8a0ea68f8d9 Mon Sep 17 00:00:00 2001 From: Jacopo De Simoi Date: Sat, 20 Dec 2025 08:58:02 -0500 Subject: [PATCH] [p10] Working solution for part 2 --- p10/p10.org | 431 ++++++++++++++-------------------------------------- 1 file changed, 114 insertions(+), 317 deletions(-) diff --git a/p10/p10.org b/p10/p10.org index 45ba165..d7c1563 100644 --- a/p10/p10.org +++ b/p10/p10.org @@ -26,29 +26,35 @@ the inefficiencies of elisp. Anyways. here it is: 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 :results none + (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)) +#+end_src - -For part 2, the same approach would blows the stack even for the test -input #+begin_src emacs-lisp - (setq machines (--map (-rotate 1 (cdr it)) data)) + (setq machines (--map (-drop-last 1 it) cleanedup-data)) - (defun apply-button (joltage button) - (--map-indexed (if (-contains-p button it-index) (- it 1) it) joltage)) + (defun to-bin (l) + (-sum (--map-indexed (* it (expt 2 it-index)) l))) - (defun good-buttons (machine) - (-filter (lambda (button) (--every (< 0 (nth it (car machine))) button)) (cdr machine))) + (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)) - (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 )) + (-sum + (-map (lambda (machine) + (-min (-map 'length (--filter (= (car machine) (apply 'logxor it)) + (-powerset (cdr machine)))))) + mask-machines)) #+end_src -Instead, go depth first and memoize for the win… This works for the -test input, but takes forever for the true input. +For part 2, the same approach would blow the stack even for the test +input. As a first attempt, go depth first and memoize for the win… +This works for the test input, but appears to take 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)) @@ -78,13 +84,12 @@ test input, but takes forever for the true input. : 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; - - +algebra problem. Gauss elimination could work, but in general leads +to matrices with negative entries. These are some auxiliary functions to create and deal with matrices +I leave here a row-reducing routine for posterity, but I am not using +it in the actual solution #+begin_src emacs-lisp :results none (defun matrix-buttons (machine) "Takes MACHINE and returns the corresponding augmented matrix of the @@ -142,241 +147,7 @@ These are some auxiliary functions to create and deal with matrices (setq rMt (--map (subtract-composite lambdas-corrected base-index it) rMt) base-index (1+ base-index))))))) (apply '-zip-lists rMt))) - - #+end_src - -#+RESULTS: -: row-reduce - -#+begin_src emacs-lisp - (defun set-distance (a b) - (length (-difference b a))) - - (defun -min-or-0 (list) - (if (not list) 0 - (-min list))) - - (defun trip-value (list &optional base) - (let ((n (* 1.0 (length list)))) - (--map (+ (set-distance base it) - (/ (-min-or-0 (--remove (= 0 it) (-map (lambda (new) - (set-distance (-union base it) new)) - list))) - n)) - list))) - - (defun sort-re-trip-value (list &optional base) - (-map 'cdr (--sort (< (car it) (car other)) (-zip-pair (trip-value list base) list)))) - - (defun sort-recursively (list &optional base) - (when list - (let* ((step (sort-re-trip-value list base)) - (top (car step)) - (bottom (cdr step))) - (cons top - (sort-recursively bottom (-union top base)))))) - - (defun fix-machine (machine) - (let* ((machine-1 (cons (car machine) (sort-recursively (cdr machine)))) - (sorted (-reduce '-union (cdr machine-1))) - (permutation (-grade-up '< sorted))) - (cons (-select-by-indices sorted (car machine-1)) - (--map (--map (nth it permutation) it) (cdr machine-1))))) - - (matrix-buttons (cadr machines)) - (-distinct - (matrix-buttons (fix-machine (nth 71 machines))) - ) -#+end_src - -#+RESULTS: -| 242 | 1 | 1 | 0 | 1 | 1 | 0 | 0 | 1 | 0 | 1 | 0 | 0 | 1 | -| 116 | 1 | 0 | 1 | 1 | 0 | 0 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | -| 282 | 1 | 1 | 1 | 1 | 0 | 1 | 1 | 1 | 0 | 1 | 0 | 1 | 1 | -| 295 | 0 | 1 | 0 | 1 | 0 | 0 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | -| 305 | 0 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | 1 | 1 | 1 | -| 110 | 0 | 0 | 1 | 1 | 0 | 1 | 1 | 0 | 1 | 1 | 1 | 1 | 1 | -| 116 | 0 | 0 | 0 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | -| 76 | 0 | 0 | 0 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 1 | -| 83 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | 0 | 0 | 1 | 1 | 1 | 1 | -| 78 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | 1 | 1 | 1 | - - -#+begin_src emacs-lisp - (solve-well-ordered-chunks (-distinct (matrix-buttons (fix-machine (nth 7 machines)))) - ) -#+end_src - -#+RESULTS: -| 19 | 16 | 12 | 11 | 0 | 8 | 14 | 3 | 8 | - - -#+begin_src emacs-lisp - (setq rainbow (-annotate (lambda (n) (--map (mod n it) '(2 3 5 7))) (-iota (* 2 3 5 7)))) - - - (defun process-machine (machine) - (let* ((matrix (-distinct (matrix-buttons (fix-machine machine)))) - (solmod (--map (solve-well-ordered-chunks-mod matrix it) '(2 3 5 7))) - (solns nil) - (numcand (apply '* (-map 'length solmod))) - (count 0)) - ;; Oh Programming Gods, have mercy of me for I have sinned - (-each (car solmod) - (lambda (a) - (-each (cadr solmod) - (lambda (b) - (-each (caddr solmod) - (lambda (c) - (-each (cadddr solmod) - (lambda (d) - (let ((cand (--map (cdr (assoc it rainbow)) (-zip-lists a b c d)))) - (message (format "machine %d. Verifying %d / %d - found %d" machine-id (setq count (1+ count)) numcand (length solns))) - (when (test-soln matrix cand) (push cand solns))))))))))) - ; (-min (-map '-sum - solns - ; )) - ) - - ) - (setq machine-id -1) - (-sum (--map (progn - (setq machine-id (1+ machine-id)) - (-min (-map '-sum (process-machine it)))) machines) ) -#+end_src - -#+RESULTS: -: 16474 - -#+RESULTS: -(process-machine (nth 51 machines)) - -This is it. -It will take forever. -Hopefully, it won't blow the stack. - -#+begin_src emacs-lisp - (setq machine-no 0 - min-presses nil) - - (--each machines - (push (-min (-map '-sum (let ((matrix (matrix-buttons (fix-machine it)))) - (solve-well-ordered-chunks matrix)))) - min-presses) - (setq machine-no (1+ machine-no))) - - (-sum min-presses) -#+end_src - -#+RESULTS: -: 33 - -#+begin_src emacs-lisp - (let ((matrix (matrix-buttons (fix-machine (nth 1 machines))))) - (solve-well-ordered-chunks matrix)) -#+end_src - -#+RESULTS: -| 25 | 1 | 6 | 16 | 10 | 0 | 21 | 12 | 14 | 14 | -| 24 | 1 | 7 | 16 | 10 | 1 | 20 | 12 | 14 | 14 | -| 23 | 1 | 8 | 16 | 10 | 2 | 19 | 12 | 14 | 14 | -| 22 | 1 | 9 | 16 | 10 | 3 | 18 | 12 | 14 | 14 | -| 21 | 1 | 10 | 16 | 10 | 4 | 17 | 12 | 14 | 14 | -| 20 | 1 | 11 | 16 | 10 | 5 | 16 | 12 | 14 | 14 | -| 19 | 1 | 12 | 16 | 10 | 6 | 15 | 12 | 14 | 14 | -| 18 | 1 | 13 | 16 | 10 | 7 | 14 | 12 | 14 | 14 | -| 17 | 1 | 14 | 16 | 10 | 8 | 13 | 12 | 14 | 14 | -| 16 | 1 | 15 | 16 | 10 | 9 | 12 | 12 | 14 | 14 | -| 15 | 1 | 16 | 16 | 10 | 10 | 11 | 12 | 14 | 14 | -| 14 | 1 | 17 | 16 | 10 | 11 | 10 | 12 | 14 | 14 | -| 13 | 1 | 18 | 16 | 10 | 12 | 9 | 12 | 14 | 14 | -| 12 | 1 | 19 | 16 | 10 | 13 | 8 | 12 | 14 | 14 | -| 11 | 1 | 20 | 16 | 10 | 14 | 7 | 12 | 14 | 14 | -| 10 | 1 | 21 | 16 | 10 | 15 | 6 | 12 | 14 | 14 | -| 9 | 1 | 22 | 16 | 10 | 16 | 5 | 12 | 14 | 14 | -| 8 | 1 | 23 | 16 | 10 | 17 | 4 | 12 | 14 | 14 | -| 7 | 1 | 24 | 16 | 10 | 18 | 3 | 12 | 14 | 14 | -| 6 | 1 | 25 | 16 | 10 | 19 | 2 | 12 | 14 | 14 | -| 5 | 1 | 26 | 16 | 10 | 20 | 1 | 12 | 14 | 14 | -| 4 | 1 | 27 | 16 | 10 | 21 | 0 | 12 | 14 | 14 | -| 23 | 3 | 4 | 16 | 11 | 0 | 18 | 16 | 15 | 12 | -| 22 | 3 | 5 | 16 | 11 | 1 | 17 | 16 | 15 | 12 | -| 21 | 3 | 6 | 16 | 11 | 2 | 16 | 16 | 15 | 12 | -| 20 | 3 | 7 | 16 | 11 | 3 | 15 | 16 | 15 | 12 | -| 19 | 3 | 8 | 16 | 11 | 4 | 14 | 16 | 15 | 12 | -| 18 | 3 | 9 | 16 | 11 | 5 | 13 | 16 | 15 | 12 | -| 17 | 3 | 10 | 16 | 11 | 6 | 12 | 16 | 15 | 12 | -| 16 | 3 | 11 | 16 | 11 | 7 | 11 | 16 | 15 | 12 | -| 15 | 3 | 12 | 16 | 11 | 8 | 10 | 16 | 15 | 12 | -| 14 | 3 | 13 | 16 | 11 | 9 | 9 | 16 | 15 | 12 | -| 13 | 3 | 14 | 16 | 11 | 10 | 8 | 16 | 15 | 12 | -| 12 | 3 | 15 | 16 | 11 | 11 | 7 | 16 | 15 | 12 | -| 11 | 3 | 16 | 16 | 11 | 12 | 6 | 16 | 15 | 12 | -| 10 | 3 | 17 | 16 | 11 | 13 | 5 | 16 | 15 | 12 | -| 9 | 3 | 18 | 16 | 11 | 14 | 4 | 16 | 15 | 12 | -| 8 | 3 | 19 | 16 | 11 | 15 | 3 | 16 | 15 | 12 | -| 7 | 3 | 20 | 16 | 11 | 16 | 2 | 16 | 15 | 12 | -| 6 | 3 | 21 | 16 | 11 | 17 | 1 | 16 | 15 | 12 | -| 5 | 3 | 22 | 16 | 11 | 18 | 0 | 16 | 15 | 12 | -| 21 | 5 | 2 | 16 | 12 | 0 | 15 | 20 | 16 | 10 | -| 20 | 5 | 3 | 16 | 12 | 1 | 14 | 20 | 16 | 10 | -| 19 | 5 | 4 | 16 | 12 | 2 | 13 | 20 | 16 | 10 | -| 18 | 5 | 5 | 16 | 12 | 3 | 12 | 20 | 16 | 10 | -| 17 | 5 | 6 | 16 | 12 | 4 | 11 | 20 | 16 | 10 | -| 16 | 5 | 7 | 16 | 12 | 5 | 10 | 20 | 16 | 10 | -| 15 | 5 | 8 | 16 | 12 | 6 | 9 | 20 | 16 | 10 | -| 14 | 5 | 9 | 16 | 12 | 7 | 8 | 20 | 16 | 10 | -| 13 | 5 | 10 | 16 | 12 | 8 | 7 | 20 | 16 | 10 | -| 12 | 5 | 11 | 16 | 12 | 9 | 6 | 20 | 16 | 10 | -| 11 | 5 | 12 | 16 | 12 | 10 | 5 | 20 | 16 | 10 | -| 10 | 5 | 13 | 16 | 12 | 11 | 4 | 20 | 16 | 10 | -| 9 | 5 | 14 | 16 | 12 | 12 | 3 | 20 | 16 | 10 | -| 8 | 5 | 15 | 16 | 12 | 13 | 2 | 20 | 16 | 10 | -| 7 | 5 | 16 | 16 | 12 | 14 | 1 | 20 | 16 | 10 | -| 6 | 5 | 17 | 16 | 12 | 15 | 0 | 20 | 16 | 10 | -| 19 | 7 | 0 | 16 | 13 | 0 | 12 | 24 | 17 | 8 | -| 18 | 7 | 1 | 16 | 13 | 1 | 11 | 24 | 17 | 8 | -| 17 | 7 | 2 | 16 | 13 | 2 | 10 | 24 | 17 | 8 | -| 16 | 7 | 3 | 16 | 13 | 3 | 9 | 24 | 17 | 8 | -| 15 | 7 | 4 | 16 | 13 | 4 | 8 | 24 | 17 | 8 | -| 14 | 7 | 5 | 16 | 13 | 5 | 7 | 24 | 17 | 8 | -| 13 | 7 | 6 | 16 | 13 | 6 | 6 | 24 | 17 | 8 | -| 12 | 7 | 7 | 16 | 13 | 7 | 5 | 24 | 17 | 8 | -| 11 | 7 | 8 | 16 | 13 | 8 | 4 | 24 | 17 | 8 | -| 10 | 7 | 9 | 16 | 13 | 9 | 3 | 24 | 17 | 8 | -| 9 | 7 | 10 | 16 | 13 | 10 | 2 | 24 | 17 | 8 | -| 8 | 7 | 11 | 16 | 13 | 11 | 1 | 24 | 17 | 8 | -| 7 | 7 | 12 | 16 | 13 | 12 | 0 | 24 | 17 | 8 | -| 15 | 9 | 0 | 16 | 14 | 2 | 7 | 28 | 18 | 6 | -| 14 | 9 | 1 | 16 | 14 | 3 | 6 | 28 | 18 | 6 | -| 13 | 9 | 2 | 16 | 14 | 4 | 5 | 28 | 18 | 6 | -| 12 | 9 | 3 | 16 | 14 | 5 | 4 | 28 | 18 | 6 | -| 11 | 9 | 4 | 16 | 14 | 6 | 3 | 28 | 18 | 6 | -| 10 | 9 | 5 | 16 | 14 | 7 | 2 | 28 | 18 | 6 | -| 9 | 9 | 6 | 16 | 14 | 8 | 1 | 28 | 18 | 6 | -| 8 | 9 | 7 | 16 | 14 | 9 | 0 | 28 | 18 | 6 | -| 11 | 11 | 0 | 16 | 15 | 4 | 2 | 32 | 19 | 4 | -| 10 | 11 | 1 | 16 | 15 | 5 | 1 | 32 | 19 | 4 | -| 9 | 11 | 2 | 16 | 15 | 6 | 0 | 32 | 19 | 4 | - - -arst -#+RESULTS: -: 114 - - - -#+begin_src emacs-lisp - ; (-min (-map '-sum (solve-well-ordered (matrix-buttons (fix-machine (cadr machines)))))) - solutions-tree #+end_src - -#+RESULTS: - -This is the tricky part; we want solve the row-reduced form, but we -need to be careful with our choices if we have more than one -possibility - #+begin_src emacs-lisp (defun find-possible-indices (matrix i) (let* ((row (nth i matrix)) @@ -418,11 +189,57 @@ possibility last-used-button button)))) (setq current-row (1- current-row))))) soln)) +#+end_src + - (setq solutions-tree nil) +Instead of using row-reduction we sort the buttons and the list of +buttons in a (arbitrary) way that makes the matrix "triangular". The +sorting is what I thought would be a good idea, but possibly it is +inefficient in the long run. In any case, it does what it needs to, +which is present the matrix in a way that has zeros in the bottom left +corner. +#+begin_src emacs-lisp + (defun set-distance (a b) + (length (-difference b a))) + + (defun -min-or-0 (list) + (if (not list) 0 + (-min list))) + + (defun trip-value (list &optional base) + (let ((n (* 1.0 (length list)))) + (--map (+ (set-distance base it) + (/ (-min-or-0 (--remove (= 0 it) (-map (lambda (new) + (set-distance (-union base it) new)) + list))) + n)) + list))) + + (defun sort-re-trip-value (list &optional base) + (-map 'cdr (--sort (< (car it) (car other)) (-zip-pair (trip-value list base) list)))) + + (defun sort-recursively (list &optional base) + (when list + (let* ((step (sort-re-trip-value list base)) + (top (car step)) + (bottom (cdr step))) + (cons top + (sort-recursively bottom (-union top base)))))) + + (defun fix-machine (machine) + (let* ((machine-1 (cons (car machine) (sort-recursively (cdr machine)))) + (sorted (-reduce '-union (cdr machine-1))) + (permutation (-grade-up '< sorted))) + (cons (-select-by-indices sorted (car machine-1)) + (--map (--map (nth it permutation) it) (cdr machine-1))))) #+end_src -This implementation works, but I need to make it recursive, so that I can memoize +This is the tricky part; we want solve the row-reduced form, but we +need to be careful with our choices if we have more than one +possibility. The following implementation works, but it may blow the +stack if the matrix is particularly degenerate; this is a breadth +first implementation that I use to check other solutions + #+begin_src emacs-lisp (defun test-soln (matrix soln) (equal (-map 'car matrix) (-map (lambda (row) (advent/dot (cdr row) soln)) matrix))) @@ -472,9 +289,11 @@ This implementation works, but I need to make it recursive, so that I can memoiz #+RESULTS: : solve-well-ordered -try to split into chunks -#+begin_src emacs-lisp +Breadth first may yield too many vectors to check. Subdivide into +chunks if this happens and go breadth first on each chunk +separately. The size at which we chunkize is arbitrary +#+begin_src emacs-lisp (defun create-chunks (n list) (let ((result nil)) (while list @@ -482,8 +301,6 @@ try to split into chunks (setq list (-drop n list))) result)) - (create-chunks 3 '(a b c d e)) - (defun solve-well-ordered-chunks (matrix) ;; we start from the last row (let* ((soln-acc nil) @@ -539,17 +356,10 @@ try to split into chunks (apply #'append soln-acc))) #+end_src +Even with the chunks, the bruteforcing was not going through. I now +solve mod a prime for a few primes and then use the Chinese Remainder +Theorem to go back to ℤ. This routine solves the matrix over ℤ_prime #+begin_src emacs-lisp - - (defun create-chunks (n list) - (let ((result nil)) - (while list - (push (-take n list) result) - (setq list (-drop n list))) - result)) - - (create-chunks 3 '(a b c d e)) - (defun solve-well-ordered-chunks-mod (matrix prime) ;; we start from the last row (let* ((soln-acc nil) @@ -603,18 +413,9 @@ try to split into chunks #+RESULTS: : solve-well-ordered-chunks-mod -Try to do it recursively +This is a recursive implementation, but it is super-slow and I ended +up not using it #+begin_src emacs-lisp - (defun test-soln (matrix soln) - (-map (lambda (row) (advent/dot (cdr row) soln)) matrix)) - - (defun apply-until-non-nil (fn list) - "Apply FN to each element of LIST until it yields non nil and then return the result" - (let ((result nil)) - (while (and list (not result)) - (setq result (funcall fn (pop list)))) - result)) - (defun solve-well-ordered-recursively (matrix) (if (not matrix) t (setq matrix (-distinct matrix)) @@ -647,44 +448,40 @@ Try to do it recursively (--map (cons 'a it) '((1) (1 2) (1 3))) #+end_src +Here we compute solutions modulo 2 3 5 and 7, then try to check +possible solutions in ℤ by hand. Computing solutions modulo a prime +is far cheaper bruteforcing. -try this. create a distance in the space of buttons given by the number of elements in the difference #+begin_src emacs-lisp - - - - - - - ;; 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)))) - - (defun solve--machine (machine) - (let ((candidate (solve-row-reduced (row-reduce (matrix-buttons machine))))) - (and (--every (= (round it) it) candidate) - (--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 (= rank (length it)) - (-powerset (cdr machine)))))) - (-min (-map '-sum (-non-nil (-map 'solve--machine bunch)))))) - (-first (not )) - (-sum (-map 'solve-machine machines)) - + (setq rainbow (-annotate (lambda (n) (--map (mod n it) '(2 3 5 7))) (-iota (* 2 3 5 7)))) + + + (defun process-machine (machine) + (let* ((matrix (-distinct (matrix-buttons (fix-machine machine)))) + (solmod (--map (solve-well-ordered-chunks-mod matrix it) '(2 3 5 7))) + (solns nil) + (numcand (apply '* (-map 'length solmod))) + (count 0)) + ;; Oh Programming Gods, have mercy of me for I have sinned + (-each (car solmod) + (lambda (a) + (-each (cadr solmod) + (lambda (b) + (-each (caddr solmod) + (lambda (c) + (-each (cadddr solmod) + (lambda (d) + (let ((cand (--map (cdr (assoc it rainbow)) (-zip-lists a b c d)))) + (message (format "machine %d. Verifying %d / %d - found %d" machine-id (setq count (1+ count)) numcand (length solns))) + (when (test-soln matrix cand) (push cand solns))))))))))) + solns)) + + (setq machine-id -1) + (-sum (--map (progn + (setq machine-id (1+ machine-id)) + (-min (-map '-sum (process-machine it)))) + machines)) #+end_src #+RESULTS: -: 33 +: 16474