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.
14 KiB
14 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))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;
(setq machines (--map (-rotate 1 (cdr it)) data))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))
(matrix-buttons (fix-machine (cadr machines)))| 51 | 1 | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 1 |
| 74 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 1 | 0 | 1 |
| 72 | 1 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 1 | 0 |
| 31 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 1 |
| 49 | 0 | 0 | 1 | 0 | 1 | 0 | 1 | 1 | 0 | 0 |
| 77 | 0 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
| 38 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 1 | 1 |
| 61 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | 1 | 1 |
(setq buttons nil)
(solve-well-ordered (matrix-buttons (fix-machine (nth 1 machines))))
(-min (-map '-sum (solve-well-ordered (matrix-buttons (fix-machine (cadr machines))))))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
(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 buttons nil)
(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 (> last-used-button 0)
(push last-used-button buttons)
(message (format "%d" (length 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 (-replace-at i 0 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* ((correction (advent/dot it (-replace-at i 0 rrow)))
(max-soln (- a correction)))
(if (< max-soln 0) (list it)
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln)))))
soln)
; remove solutions that are not feasible
soln (--filter (--every (>= it 0) (-map (lambda (row)
(let ((correction (advent/dot it (cdr row))))
(- (car row) correction)))
matrix))
soln)
last-used-button button))))
(setq soln (--filter (= a (advent/dot it rrow)) soln)
current-row (1- current-row)))))
soln))
(defun minimal-pushes (machine)
(-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine))))))minimal-pushes
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