wilderjds
/
advent-2025
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[p10] Working solution for part 2

Browse Source
master
Jacopo De Simoi 3 months ago
parent 3010d12259
commit faadaf6501
1 changed files with 114 additions and 317 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 431
      p10/p10.org

431
p10/p10.org
Unescape View File

@ -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

Write Preview
Loading…
Cancel
Save