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.
31 KiB
31 KiB
Solution to p10
This problem is pretty hard. I have not yet completely understood the linear algebra behind it.
(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))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
(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)Instead, go depth first and memoize for the win… This works for the test input, but takes forever for the true input.
(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))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
(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)))row-reduce
(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)))
)| 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 |
(solve-well-ordered-chunks (-distinct (matrix-buttons (fix-machine (nth 2 machines))))
)| 20 | 9 | 17 | 0 | 4 | 0 | 20 | 19 |
(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)| 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.
(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)33
(let ((matrix (matrix-buttons (fix-machine (nth 1 machines)))))
(solve-well-ordered-chunks matrix))| 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
114
; (-min (-map '-sum (solve-well-ordered (matrix-buttons (fix-machine (cadr machines))))))
solutions-treeThis 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
(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)This implementation works, but I need to make it recursive, so that I can memoize
(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))solve-well-ordered
try to split into chunks
(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)))
(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)))solve-well-ordered-chunks
Try to do it recursively
(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)))try this. create a distance in the space of buttons given by the number of elements in the difference
;; 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))33