You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
211 lines
7.3 KiB
211 lines
7.3 KiB
#+title: Solution to p10 |
|
|
|
This problem is pretty hard. I have not yet completely understood the |
|
linear algebra behind it. |
|
#+begin_src emacs-lisp :results none |
|
(with-temp-buffer |
|
(insert-file-contents "input-test") |
|
(advent/replace-multiple-regex-buffer |
|
'(("," . " ") |
|
("^" . "(") |
|
("$" . ")") |
|
("\\[" . "\"") |
|
("\\]" . "\"") |
|
("{" . "(") |
|
("}" . ")") |
|
)) |
|
(goto-char (point-min)) |
|
(insert "(setq data '(") |
|
(goto-char (point-max)) |
|
(insert "))") |
|
(eval-buffer)) |
|
#+end_src |
|
|
|
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. |
|
|
|
For part 2, the same approach blows the stack even for the test input |
|
#+begin_src emacs-lisp |
|
(setq machines (--map (-rotate 1 (cdr it)) data)) |
|
|
|
(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 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 )) |
|
|
|
(-iterate 'solve-machines (list (car machines)) 19) |
|
#+end_src |
|
|
|
Instead, go depth first and memoize for the win… This works for the |
|
test input, but takes 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)) |
|
|
|
(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 nil-1+ (l) |
|
(when l (1+ 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))))))))) |
|
|
|
(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. |
|
There is a little complication, since the matrices involved are |
|
degenerate and we have constraints; |
|
|
|
#+begin_src emacs-lisp :results none |
|
(setq machines (--map (-rotate 1 (cdr it)) data) machines) |
|
#+end_src |
|
|
|
These are some auxiliary functions to create and deal with matrices |
|
#+begin_src emacs-lisp |
|
(defun matrix-buttons (machine) |
|
"Takes MACHINE and returns the corresponding augmented matrix of the |
|
linear system. The vector of constants is the first column vector |
|
instead of the last column as usual(it is more idiomatic this way)" |
|
(--map-indexed (cons it (--map (if (-contains-p it it-index) 1 0) |
|
(cdr machine))) |
|
(car machine))) |
|
|
|
;; These are convenience functions that we will use for row-reducing |
|
(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 flip-index (i list) |
|
"Flip the sign of element i" |
|
(let ((el-i (nth i list))) |
|
(-replace-at i (* -1 el-i) list))) |
|
|
|
(defun subtract-composite (lambdas i list) |
|
(--each (-iota (length lambdas)) |
|
(setq list (subtract-indices (nth it lambdas) i it list))) |
|
list) |
|
|
|
; This is a routine for row-reducing the augmented matrix |
|
(defun row-reduce (matrix) |
|
(let* ((rMt (apply '-zip-lists matrix)) ;transpose |
|
(base-index 0)) |
|
; here we cannot use -map, since we are changing the matrix as we |
|
; go |
|
(--each (-iota (1- (length rMt)) 1) ;skip over the constant |
|
(let* ((original-row (nth it rMt)) |
|
(pivot-index (find-pivot original-row base-index))) |
|
(when pivot-index |
|
(setq rMt (--map (swap-indices base-index pivot-index it) rMt)) |
|
(let* ((pivot-coeff (nth pivot-index original-row))) |
|
(when (< pivot-coeff 0) |
|
(setq rMt (--map (flip-index base-index it) rMt))) |
|
(assert (= 1 (abs pivot-coeff))) |
|
(let* ((lambdas (append (-repeat (1+ base-index) 0) |
|
(-drop (1+ base-index) (nth it rMt)))) |
|
(lambdas-corrected (--map (/ it (abs pivot-coeff)) lambdas))) |
|
(setq rMt (--map (subtract-composite lambdas-corrected base-index it) rMt) |
|
base-index (1+ base-index))))))) |
|
(apply '-zip-lists rMt))) |
|
#+end_src |
|
|
|
#+RESULTS: |
|
| 10 | 1 | 1 | 1 | 0 | |
|
| -1 | 0 | 1 | 0 | -1 | |
|
| 5 | 0 | 0 | 1 | 0 | |
|
| 0 | 0 | 0 | 0 | 0 | |
|
| 0 | 0 | 0 | 0 | 0 | |
|
| 0 | 0 | 0 | 0 | 0 | |
|
|
|
arst |
|
#+RESULTS: |
|
| 7 | 1 | 1 | 0 | 1 | 0 | 0 | |
|
| 5 | 0 | 1 | 0 | 0 | 0 | 1 | |
|
| 4 | 0 | 0 | 1 | 1 | 1 | 0 | |
|
| 3 | 0 | 0 | 0 | 0 | 1 | 1 | |
|
|
|
#+begin_src emacs-lisp |
|
(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: |
|
: 33
|
|
|