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

[p10] Maaaaaaybe

Browse Source
master
Jacopo De Simoi 6 months ago
parent 9628410549
commit fe45251624
1 changed files with 146 additions and 28 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. 172
      p10/p10.org

172
p10/p10.org
Unescape View File

@ -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))
@ -47,9 +45,9 @@ for part 1 we do not need the last item
#+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 | | |

Write Preview
Loading…
Cancel
Save