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.
761 lines
31 KiB
761 lines
31 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") |
|
(advent/replace-multiple-regex-buffer |
|
'(("," . " ") |
|
("^" . "(") |
|
("$" . ")") |
|
("\\[" . "\"") |
|
("\\]" . "\"") |
|
("{" . "(") |
|
("}" . ")") |
|
)) |
|
(goto-char (point-min)) |
|
(insert "(setq data '(") |
|
(goto-char (point-max)) |
|
(insert "))") |
|
(eval-buffer)) |
|
(setq machines (--map (-rotate 1 (cdr it)) data)) |
|
#+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; |
|
|
|
|
|
|
|
These are some auxiliary functions to create and deal with matrices |
|
#+begin_src emacs-lisp :results none |
|
(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))) |
|
(if (not (= 1 (abs pivot-coeff))) (setq pivot-coeff (* 1.0 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: |
|
: 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 2 machines)))) |
|
) |
|
#+end_src |
|
|
|
#+RESULTS: |
|
| 20 | 9 | 17 | 0 | 4 | 0 | 20 | 19 | |
|
|
|
#+begin_src emacs-lisp |
|
(setq rainbow (-annotate (lambda (n) (--map (mod n it) '(2 3 5 7))) (-iota (* 2 3 5 7)))) |
|
|
|
(let* ((machine (nth 4 machines)) |
|
(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 "Verifying %d / %d - found %d" (setq count (1+ count)) numcand (length solns))) |
|
(when (test-soln matrix cand) (push cand solns))))))))))) |
|
solns) |
|
#+end_src |
|
|
|
#+RESULTS: |
|
| 17 | 6 | 7 | 22 | 9 | 2 | 20 | 14 | 5 | 5 | |
|
| 9 | 10 | 15 | 16 | 9 | 0 | 24 | 8 | 1 | 11 | |
|
| 21 | 4 | 3 | 28 | 9 | 0 | 18 | 14 | 7 | 5 | |
|
| 9 | 10 | 15 | 10 | 9 | 6 | 24 | 14 | 1 | 5 | |
|
| 13 | 8 | 11 | 16 | 9 | 4 | 22 | 14 | 3 | 5 | |
|
| 17 | 6 | 7 | 24 | 9 | 0 | 20 | 12 | 5 | 7 | |
|
| 17 | 6 | 7 | 18 | 9 | 6 | 20 | 18 | 5 | 1 | |
|
| 9 | 10 | 15 | 12 | 9 | 4 | 24 | 12 | 1 | 7 | |
|
| 21 | 4 | 3 | 24 | 9 | 4 | 18 | 18 | 7 | 1 | |
|
| 9 | 10 | 15 | 6 | 9 | 10 | 24 | 18 | 1 | 1 | |
|
| 13 | 8 | 11 | 18 | 9 | 2 | 22 | 12 | 3 | 7 | |
|
| 13 | 8 | 11 | 12 | 9 | 8 | 22 | 18 | 3 | 1 | |
|
| 17 | 6 | 7 | 20 | 9 | 4 | 20 | 16 | 5 | 3 | |
|
| 9 | 10 | 15 | 14 | 9 | 2 | 24 | 10 | 1 | 9 | |
|
| 21 | 4 | 3 | 26 | 9 | 2 | 18 | 16 | 7 | 3 | |
|
| 9 | 10 | 15 | 8 | 9 | 8 | 24 | 16 | 1 | 3 | |
|
| 13 | 8 | 11 | 20 | 9 | 0 | 22 | 10 | 3 | 9 | |
|
| 13 | 8 | 11 | 14 | 9 | 6 | 22 | 16 | 3 | 3 | |
|
| 11 | 9 | 13 | 13 | 9 | 5 | 23 | 14 | 2 | 5 | |
|
| 15 | 7 | 9 | 19 | 9 | 3 | 21 | 14 | 4 | 5 | |
|
| 7 | 11 | 17 | 13 | 9 | 1 | 25 | 8 | 0 | 11 | |
|
| 19 | 5 | 5 | 25 | 9 | 1 | 19 | 14 | 6 | 5 | |
|
| 7 | 11 | 17 | 7 | 9 | 7 | 25 | 14 | 0 | 5 | |
|
| 11 | 9 | 13 | 15 | 9 | 3 | 23 | 12 | 2 | 7 | |
|
| 23 | 3 | 1 | 27 | 9 | 3 | 17 | 18 | 8 | 1 | |
|
| 11 | 9 | 13 | 9 | 9 | 9 | 23 | 18 | 2 | 1 | |
|
| 15 | 7 | 9 | 21 | 9 | 1 | 21 | 12 | 4 | 7 | |
|
| 15 | 7 | 9 | 15 | 9 | 7 | 21 | 18 | 4 | 1 | |
|
| 7 | 11 | 17 | 9 | 9 | 5 | 25 | 12 | 0 | 7 | |
|
| 19 | 5 | 5 | 21 | 9 | 5 | 19 | 18 | 6 | 1 | |
|
| 7 | 11 | 17 | 3 | 9 | 11 | 25 | 18 | 0 | 1 | |
|
| 11 | 9 | 13 | 17 | 9 | 1 | 23 | 10 | 2 | 9 | |
|
| 23 | 3 | 1 | 29 | 9 | 1 | 17 | 16 | 8 | 3 | |
|
| 11 | 9 | 13 | 11 | 9 | 7 | 23 | 16 | 2 | 3 | |
|
| 15 | 7 | 9 | 17 | 9 | 5 | 21 | 16 | 4 | 3 | |
|
| 7 | 11 | 17 | 11 | 9 | 3 | 25 | 10 | 0 | 9 | |
|
| 19 | 5 | 5 | 23 | 9 | 3 | 19 | 16 | 6 | 3 | |
|
| 7 | 11 | 17 | 5 | 9 | 9 | 25 | 16 | 0 | 3 | |
|
| 17 | 6 | 7 | 19 | 9 | 5 | 20 | 17 | 5 | 2 | |
|
| 9 | 10 | 15 | 13 | 9 | 3 | 24 | 11 | 1 | 8 | |
|
| 21 | 4 | 3 | 25 | 9 | 3 | 18 | 17 | 7 | 2 | |
|
| 9 | 10 | 15 | 7 | 9 | 9 | 24 | 17 | 1 | 2 | |
|
| 13 | 8 | 11 | 19 | 9 | 1 | 22 | 11 | 3 | 8 | |
|
| 13 | 8 | 11 | 13 | 9 | 7 | 22 | 17 | 3 | 2 | |
|
| 17 | 6 | 7 | 21 | 9 | 3 | 20 | 15 | 5 | 4 | |
|
| 21 | 4 | 3 | 27 | 9 | 1 | 18 | 15 | 7 | 4 | |
|
| 9 | 10 | 15 | 9 | 9 | 7 | 24 | 15 | 1 | 4 | |
|
| 9 | 10 | 15 | 15 | 9 | 1 | 24 | 9 | 1 | 10 | |
|
| 13 | 8 | 11 | 15 | 9 | 5 | 22 | 15 | 3 | 4 | |
|
| 17 | 6 | 7 | 23 | 9 | 1 | 20 | 13 | 5 | 6 | |
|
| 17 | 6 | 7 | 17 | 9 | 7 | 20 | 19 | 5 | 0 | |
|
| 9 | 10 | 15 | 11 | 9 | 5 | 24 | 13 | 1 | 6 | |
|
| 21 | 4 | 3 | 23 | 9 | 5 | 18 | 19 | 7 | 0 | |
|
| 9 | 10 | 15 | 5 | 9 | 11 | 24 | 19 | 1 | 0 | |
|
| 13 | 8 | 11 | 17 | 9 | 3 | 22 | 13 | 3 | 6 | |
|
| 13 | 8 | 11 | 11 | 9 | 9 | 22 | 19 | 3 | 0 | |
|
| 11 | 9 | 13 | 16 | 9 | 2 | 23 | 11 | 2 | 8 | |
|
| 23 | 3 | 1 | 28 | 9 | 2 | 17 | 17 | 8 | 2 | |
|
| 11 | 9 | 13 | 10 | 9 | 8 | 23 | 17 | 2 | 2 | |
|
| 15 | 7 | 9 | 22 | 9 | 0 | 21 | 11 | 4 | 8 | |
|
| 15 | 7 | 9 | 16 | 9 | 6 | 21 | 17 | 4 | 2 | |
|
| 7 | 11 | 17 | 10 | 9 | 4 | 25 | 11 | 0 | 8 | |
|
| 19 | 5 | 5 | 22 | 9 | 4 | 19 | 17 | 6 | 2 | |
|
| 7 | 11 | 17 | 4 | 9 | 10 | 25 | 17 | 0 | 2 | |
|
| 23 | 3 | 1 | 30 | 9 | 0 | 17 | 15 | 8 | 4 | |
|
| 11 | 9 | 13 | 12 | 9 | 6 | 23 | 15 | 2 | 4 | |
|
| 11 | 9 | 13 | 18 | 9 | 0 | 23 | 9 | 2 | 10 | |
|
| 15 | 7 | 9 | 18 | 9 | 4 | 21 | 15 | 4 | 4 | |
|
| 19 | 5 | 5 | 24 | 9 | 2 | 19 | 15 | 6 | 4 | |
|
| 7 | 11 | 17 | 6 | 9 | 8 | 25 | 15 | 0 | 4 | |
|
| 7 | 11 | 17 | 12 | 9 | 2 | 25 | 9 | 0 | 10 | |
|
| 11 | 9 | 13 | 14 | 9 | 4 | 23 | 13 | 2 | 6 | |
|
| 23 | 3 | 1 | 26 | 9 | 4 | 17 | 19 | 8 | 0 | |
|
| 11 | 9 | 13 | 8 | 9 | 10 | 23 | 19 | 2 | 0 | |
|
| 15 | 7 | 9 | 20 | 9 | 2 | 21 | 13 | 4 | 6 | |
|
| 15 | 7 | 9 | 14 | 9 | 8 | 21 | 19 | 4 | 0 | |
|
| 7 | 11 | 17 | 14 | 9 | 0 | 25 | 7 | 0 | 12 | |
|
| 19 | 5 | 5 | 26 | 9 | 0 | 19 | 13 | 6 | 6 | |
|
| 7 | 11 | 17 | 8 | 9 | 6 | 25 | 13 | 0 | 6 | |
|
| 19 | 5 | 5 | 20 | 9 | 6 | 19 | 19 | 6 | 0 | |
|
| 7 | 11 | 17 | 2 | 9 | 12 | 25 | 19 | 0 | 0 | |
|
|
|
|
|
|
|
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)) |
|
(next-row (nth (1+ i) matrix)) |
|
(i ) |
|
(j (if next-row (--find-index (not (= 0 it)) (cdr next-row)) |
|
(1- length row)))) |
|
(-iota (- j i) i))) |
|
|
|
|
|
(defun solve-row-reduced (matrix) |
|
;; we start from the last row |
|
(let* ((soln (list (-repeat (1- (length (car matrix))) 0))) |
|
(last-used-button (length (car soln))) |
|
(current-row (1- (length matrix)))) |
|
(while (<= 0 current-row) |
|
(let* ((row (nth current-row matrix)) |
|
(a (car row)) |
|
(i (--find-index (not (= 0 it)) (cdr row)))) |
|
(if i |
|
(let ((possible-indices (--filter (not (= 0 (nth it (cdr row)))) |
|
(-iota (- last-used-button i) i)))) |
|
(if (= 1 (length possible-indices)) ;no choices here, easy |
|
(setq soln (-non-nil (--map (let* ((correction (advent/dot it (-replace-at i 0 (cdr row)))) |
|
(corrected-a (- a correction)) |
|
(pushes (/ corrected-a (nth i (cdr row))))) |
|
(unless (< pushes 0) (-replace-at i pushes it))) |
|
soln)) |
|
last-used-button i |
|
current-row (1- current-row)) |
|
;;otherwise, we create a number of solutions |
|
(let* ((button (-last-item possible-indices))) |
|
(setq soln (--mapcat (let* ((correction (advent/dot it (-replace-at i 0 (cdr row)))) |
|
(corrected-a (- a correction)) |
|
(max-soln (/ corrected-a (nth button (cdr row))))) |
|
(if (< max-soln 0) (list it) |
|
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ (round max-soln)))))) |
|
soln) |
|
last-used-button button)))) |
|
(setq current-row (1- current-row))))) |
|
soln)) |
|
|
|
(setq solutions-tree nil) |
|
#+end_src |
|
|
|
This implementation works, but I need to make it recursive, so that I can memoize |
|
#+begin_src emacs-lisp |
|
(defun test-soln (matrix soln) |
|
(equal (-map 'car matrix) (-map (lambda (row) (advent/dot (cdr row) soln)) matrix))) |
|
|
|
(defun solve-well-ordered (matrix) |
|
;; we start from the last row |
|
(let* ((number-of-buttons (1- (length (car matrix)))) |
|
(soln (list (-repeat number-of-buttons 0))) |
|
(last-used-button number-of-buttons) |
|
(current-row (1- (length matrix)))) |
|
(while (>= current-row 0) |
|
(message (format "%d %d" last-used-button (length soln))) |
|
;; (setq soln (--map (-min-by (lambda (a b) (< (-sum a) (-sum b))) (cdr it)) (--group-by (test-soln matrix it) soln))) |
|
(let* ((row (nth current-row matrix)) |
|
(a (car row)) |
|
(rrow (cdr row)) |
|
(i (--find-index (not (zerop it)) (-take last-used-button rrow)))) |
|
(if i |
|
(let ((possible-indices (--filter (not (zerop (nth it rrow))) |
|
(-iota (- last-used-button i) i)))) |
|
(if (= 1 (length possible-indices)) ;no choices here, easy |
|
(setq soln (-non-nil (--map (let* ((correction (advent/dot it rrow)) |
|
(corrected-a (- a correction))) |
|
(unless (< corrected-a 0) |
|
(-replace-at i corrected-a it))) |
|
soln)) |
|
|
|
last-used-button i |
|
current-row (1- current-row)) ; this needs to change |
|
;;otherwise, we create a number of solutions |
|
(let* ((button (-last-item possible-indices))) |
|
(setq soln (--mapcat (let* ((max-soln (-min (-non-nil (-map (lambda (row) |
|
(when (= 1 (nth button (cdr row))) |
|
(- (car row) (advent/dot it (cdr row))))) |
|
matrix))))) |
|
(unless (< max-soln 0) |
|
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln) max-soln -1)))) |
|
soln) |
|
last-used-button button)))) |
|
(setq soln (--filter (= a (advent/dot it rrow)) soln) |
|
current-row (1- current-row))) |
|
(push soln solutions-tree) |
|
)) |
|
soln)) |
|
#+end_src |
|
|
|
#+RESULTS: |
|
: solve-well-ordered |
|
|
|
try to split into chunks |
|
#+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 (matrix) |
|
;; we start from the last row |
|
(let* ((soln-acc nil) |
|
(number-of-buttons (1- (length (car matrix)))) |
|
(soln (list (-repeat number-of-buttons 0))) |
|
(last-used-button number-of-buttons) |
|
(current-row (1- (length matrix))) |
|
(soln-chunks nil)) |
|
(while (or (>= current-row 0) soln-chunks) |
|
(message (format "%d %d - %d" last-used-button (length soln) (length soln-chunks))) |
|
(when (< current-row 0) |
|
(let ((chunk (pop soln-chunks))) |
|
(push soln soln-acc) |
|
(setq current-row (pop chunk) |
|
last-used-button (pop chunk) |
|
soln (pop chunk)))) |
|
;; chunkize here |
|
(when (> (length soln) 50000) |
|
(let* ((chunks (create-chunks 8000 soln)) |
|
(new-soln (car chunks)) |
|
(chunks-to-store (--map (list current-row last-used-button it) (cdr chunks)))) |
|
(setq soln new-soln |
|
soln-chunks (append chunks-to-store soln-chunks)))) |
|
(let* ((row (nth current-row matrix)) |
|
(a (car row)) |
|
(rrow (cdr row)) |
|
(i (--find-index (not (zerop it)) (-take last-used-button rrow)))) |
|
(if i |
|
(let ((possible-indices (--filter (not (zerop (nth it rrow))) |
|
(-iota (- last-used-button i) i)))) |
|
(if (= 1 (length possible-indices)) ;no choices here, easy |
|
(setq soln (-non-nil (--map (let* ((correction (advent/dot it rrow)) |
|
(corrected-a (- a correction))) |
|
(unless (< corrected-a 0) |
|
(-replace-at i corrected-a it))) |
|
soln)) |
|
|
|
last-used-button i |
|
current-row (1- current-row)) ; this needs to change |
|
;;otherwise, we create a number of solutions |
|
(let* ((button (-last-item possible-indices))) |
|
(setq soln (--mapcat (let* ((max-soln (-min (-non-nil (-map (lambda (row) |
|
(when (= 1 (nth button (cdr row))) |
|
(- (car row) (advent/dot it (cdr row))))) |
|
matrix))))) |
|
(unless (< max-soln 0) |
|
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln) max-soln -1)))) |
|
soln) |
|
last-used-button button)))) |
|
(setq soln (--filter (= a (advent/dot it rrow)) soln) |
|
current-row (1- current-row))))) |
|
(push soln soln-acc) |
|
(apply #'append soln-acc))) |
|
#+end_src |
|
|
|
#+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 (matrix) |
|
;; we start from the last row |
|
(let* ((soln-acc nil) |
|
(number-of-buttons (1- (length (car matrix)))) |
|
(soln (list (-repeat number-of-buttons 0))) |
|
(last-used-button number-of-buttons) |
|
(current-row (1- (length matrix))) |
|
(soln-chunks nil)) |
|
(while (or (>= current-row 0) soln-chunks) |
|
(message (format "%d %d - %d" last-used-button (length soln) (length soln-chunks))) |
|
(when (< current-row 0) |
|
(let ((chunk (pop soln-chunks))) |
|
(push soln soln-acc) |
|
(setq current-row (pop chunk) |
|
last-used-button (pop chunk) |
|
soln (pop chunk)))) |
|
;; chunkize here |
|
(when (> (length soln) 50000) |
|
(let* ((chunks (create-chunks 8000 soln)) |
|
(new-soln (car chunks)) |
|
(chunks-to-store (--map (list current-row last-used-button it) (cdr chunks)))) |
|
(setq soln new-soln |
|
soln-chunks (append chunks-to-store soln-chunks)))) |
|
(let* ((row (nth current-row matrix)) |
|
(a (car row)) |
|
(rrow (cdr row)) |
|
(i (--find-index (not (zerop it)) (-take last-used-button rrow)))) |
|
(if i |
|
(let ((possible-indices (--filter (not (zerop (nth it rrow))) |
|
(-iota (- last-used-button i) i)))) |
|
(if (= 1 (length possible-indices)) ;no choices here, easy |
|
(setq soln (-non-nil (--map (let* ((correction (advent/dot it rrow)) |
|
(corrected-a (- a correction))) |
|
(unless (< corrected-a 0) |
|
(-replace-at i corrected-a it))) |
|
soln)) |
|
|
|
last-used-button i |
|
current-row (1- current-row)) ; this needs to change |
|
;;otherwise, we create a number of solutions |
|
(let* ((button (-last-item possible-indices))) |
|
(setq soln (--mapcat (let* ((max-soln (-min (-non-nil (-map (lambda (row) |
|
(when (= 1 (nth button (cdr row))) |
|
(- (car row) (advent/dot it (cdr row))))) |
|
matrix))))) |
|
(unless (< max-soln 0) |
|
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln) max-soln -1)))) |
|
soln) |
|
last-used-button button)))) |
|
(setq soln (--filter (= a (advent/dot it rrow)) soln) |
|
current-row (1- current-row))))) |
|
(push soln soln-acc) |
|
(apply #'append soln-acc))) |
|
#+end_src |
|
|
|
#+RESULTS: |
|
: solve-well-ordered-chunks |
|
|
|
Try to do it recursively |
|
#+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)) |
|
(let* ((number-of-buttons (1- (length (car matrix)))) |
|
(row (-last-item matrix)) |
|
(a (car row)) |
|
(rrow (cdr row)) |
|
(possible-indices (--find-indices (not (zerop it)) rrow))) |
|
(if (not possible-indices) |
|
(when (zerop a) |
|
(solve-well-ordered-recursively (-butlast matrix))) |
|
(let ((possible-solutions |
|
(if (= 1 (length possible-indices)) (list a) |
|
(let* ((button (-last-item possible-indices)) |
|
(max-soln (-min (-non-nil (-map (lambda (row) |
|
(when (= 1 (nth button (cdr row))) (car row))) |
|
|
|
matrix))))) |
|
(when (>= max-soln 0) (-iota (1+ max-soln))))))) |
|
(-non-nil (-mapcat (lambda (a) |
|
(let* ((new-car (--map (if (= 1 (-last-item it)) (- (car it) a) (car it)) matrix))) |
|
(when (--every (>= it 0) new-car) |
|
(let* ((new-matrix (-map '-butlast (--map-indexed (cons (nth it-index new-car) (cdr it)) matrix))) ; remove one column |
|
(next (solve-well-ordered-recursively new-matrix))) |
|
(when next (if (listp next) |
|
(--map (cons a it) next) |
|
(list (list a)))))))) |
|
possible-solutions))))))) |
|
|
|
(--map (cons 'a it) '((1) (1 2) (1 3))) |
|
#+end_src |
|
|
|
|
|
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)) |
|
|
|
#+end_src |
|
|
|
#+RESULTS: |
|
: 33
|
|
|