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

[p10] This still does not work

Browse Source
master
Jacopo De Simoi 6 months ago
parent fe45251624
commit c82fbdebcf
1 changed files with 101 additions and 120 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 221
      p10/p10.org

221
p10/p10.org
Unescape View File

@ -2,7 +2,7 @@
#+begin_src emacs-lisp :results none #+begin_src emacs-lisp :results none
(with-temp-buffer (with-temp-buffer
(insert-file-contents "input-test") (insert-file-contents "input")
(advent/replace-multiple-regex-buffer (advent/replace-multiple-regex-buffer
'(("," . " ") '(("," . " ")
("^" . "(") ("^" . "(")
@ -105,125 +105,106 @@ is a linear algebra problem. Gauss elimination to the rescue
#+end_src #+end_src
#+begin_src emacs-lisp #+begin_src emacs-lisp
;; Now take a machine, create an "augmented" matrix to be reduced ;; Now take a machine, create an "augmented" matrix to be reduced
;; Notice that the "augmentation" is the first column for ;; Notice that the "augmentation" is the first column for
;; reasons of making things more idiomatic ;; reasons of making things more idiomatic
(defun matrix-buttons (machine) (defun matrix-buttons (machine)
(--map-indexed (cons it (--map (if (-contains-p it it-index) 1 0) (cdr machine))) (car machine))) (--map-indexed (cons it (--map (if (-contains-p it it-index) 1 0) (cdr machine))) (car machine)))
(defun find-pivot (row index) (defun find-pivot (row index)
(let ((p (--find-index (not (= it 0)) (-drop index row)))) (let ((p (--find-index (not (= it 0)) (-drop index row))))
(when p (+ p index)))) (when p (+ p index))))
(defun swap-indices (i j list) (defun swap-indices (i j list)
(if (= i j) list (if (= i j) list
(let ((el-i (nth i list)) (let ((el-i (nth i list))
(el-j (nth j list))) (el-j (nth j list)))
(-replace-at j el-i (-replace-at i el-j list))))) (-replace-at j el-i (-replace-at i el-j list)))))
(defun subtract-indices (λ i j list) (defun subtract-indices (λ i j list)
"Subtracts λ× element i from element j" "Subtracts λ× element i from element j"
(let ((el-i (nth i list)) (let ((el-i (nth i list))
(el-j (nth j list))) (el-j (nth j list)))
(-replace-at j (- el-j (* λ el-i)) list))) (-replace-at j (- el-j (* λ el-i)) list)))
(defun subtract-composite (lambdas i list) (defun subtract-composite (lambdas i list)
(--each (-iota (length lambdas)) (--each (-iota (length lambdas))
(setq list (subtract-indices (nth it lambdas) i it list))) (setq list (subtract-indices (nth it lambdas) i it list)))
list) list)
;; Here we row-reduce; this is non-unique ;; Here we row-reduce; this is non-unique
(defun row-reduce (matrix) (defun row-reduce (matrix)
(let* ((v (-map #'car matrix)) ;; vector (let* ((v (-map #'car matrix)) ;; vector
(rM (-map #'cdr matrix)) ;; reduced matrix (rM (-map #'cdr matrix)) ;; reduced matrix
(rMt (apply '-zip-lists rM)) ;transpose (rMt (apply '-zip-lists rM)) ;transpose
(base 0)) (base 0))
(--each (-iota (length rMt)) (--each (-iota (length rMt))
(let ((pivot (find-pivot (nth it rMt) base))) (let ((pivot (find-pivot (nth it rMt) base)))
(when pivot (when pivot
(setq rMt (-map (lambda (row) (setq rMt (-map (lambda (row)
(swap-indices base pivot row)) (swap-indices base pivot row))
rMt) rMt)
v (swap-indices base pivot v)) v (swap-indices base pivot v))
;; hopefully we never have to divide ;; hopefully we never have to divide
;; now we have to clean the other bits ;; now we have to clean the other bits
; (fwq) ; (fwq)
;; this is the pivot ;; this is the pivot
(let* ((pivot-coeff (nth base (nth it rMt))) (let* ((pivot-coeff (nth base (nth it rMt)))
(lambdas (append (-repeat (1+ base) 0) (-drop (1+ base) (nth it rMt)))) (lambdas (append (-repeat (1+ base) 0) (-drop (1+ base) (nth it rMt))))
(lambdas-corrected (--map (/ it (* 1 pivot-coeff)) lambdas))) (lambdas-corrected (--map (/ it (* 1 pivot-coeff)) lambdas)))
(setq rMt (--map (subtract-composite lambdas-corrected base it) rMt) (setq rMt (--map (subtract-composite lambdas-corrected base it) rMt)
v (subtract-composite lambdas-corrected base v))) v (subtract-composite lambdas-corrected base v)))
(setq base (1+ base))))) (setq base (1+ base)))))
(apply '-zip-lists (cons v rMt)))) (apply '-zip-lists (cons v rMt))))
(defun solve-row-reduced (matrix) (defun solve-row-reduced (matrix)
;; we start from the last row ;; we start from the last row
(let ((soln (-repeat (length (cdar matrix)) 0))) (let ((soln (-repeat (length (cdar matrix)) 0)))
(--each (-iota (length matrix) (- (length matrix) 1) -1) (--each (-iota (length matrix) (- (length matrix) 1) -1)
(let* ((row (nth it matrix)) (let* ((row (nth it matrix))
(a (car row)) (a (car row))
(i (--find-index (not (= 0 it)) (cdr row)))) (i (--find-index (not (= 0 it)) (cdr row))))
(when i (when i
(setq correction (advent/dot soln (append (-repeat (1+ i) 0) (drop (1+ i) (cdr row)))) (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 (-replace-at i (/ (- a correction) (nth i (cdr row))) soln)))))
soln)) soln))
(solve-row-reduced (row-reduce (matrix-buttons (caddr machines)))) (solve-row-reduced (row-reduce (matrix-buttons (caddr machines))))
;; now, this is correct, but we need a positive solution that has ;; now, this is correct, but we need a positive solution that has
;; fewest button presses possible. ;; fewest button presses possible.
(defun unshadowed-buttons (matrix) (defun rank (matrix)
(let ((result)) (length (-non-nil (--map (--find-index (not (= 0 it)) (cdr it)) matrix))))
(--each (-iota (length matrix) (- (length matrix) 1) -1)
(let* ((row (nth it matrix)) (defun matrix-appl (matrix vector)
(i (--find-index (not (= 0 it)) (cdr row)))) (--map (advent/dot it vector) matrix))
(when i (push i result))))
result)) (defun solution-p (machine candidate)
(--every (= 0 it) (matrix-appl (matrix-buttons machine) (cons -1 candidate)))
(defun shadowed-buttons (matrix) )
(-difference (-iota (length (cdar matrix))) (unshadowed-buttons matrix))) (setq current-machine nil)
(defun solve--machine (machine)
(defun shadowed-button-solution (i matrix) (setq current-machine machine)
(solve-row-reduced (let ((transpose (apply '-zip-lists matrix))) (let ((candidate (solve-row-reduced (row-reduce (matrix-buttons machine)))))
(apply '-zip-lists (cons (nth (1+ i) transpose) (cdr transpose)))))) (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))) (defun solve-machine (machine)
(candidate (solve-row-reduced reduced-mat))) (let* ((reduced-mat (row-reduce (matrix-buttons machine)))
(if (--every (<= 0 it) candidate) candidate (rank (rank reduced-mat))
(let ((shadowed (shadowed-buttons reduced-mat))) (bunch (--map (cons (car machine) it)
;; try replacing the shadowed button with the previous one (--filter 'identity
(solve-machine ;(<= rank (length it))
(swap-indices (car shadowed) (1+ (car shadowed)) machine)))))) (-powerset (cdr machine))))))
(-min (-map '-sum (-non-nil (-map 'solve--machine bunch))))
(defun vector- (v1 v2) ))
(--map (- (car it) (cdr it)) (-zip-pair v1 v2)))
(-sum (-map 'solve-machine machines))
(defun push-button (i machine-matrix) current-machine
(let ((tr (apply '-zip-lists machine))) (solve--machine machine)
(apply '-zip-lists (cons (vector- (car tr) (nth (1+ i) tr)) (cdr tr))))) canca
(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 #+end_src
#+RESULTS: #+RESULTS:
| 5 | 1 | 3 | 0 | 1 | 0 | : 33
| 2 | 0 | 5 | 5 | 0 | |
| 6 | 5 | -1 | 0 | | |

Write Preview
Loading…
Cancel
Save