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
Split 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
(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

Write Preview
Loading…
Cancel
Save