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.
7.8 KiB
7.8 KiB
Solution to p10
(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)) (defun zero-one (n)
(if (eq n ?#) 1 0))
(setq cleanedup-data (--map (cons (-map #'zero-one (advent/split-string-into-char-list (car it))) (cdr it)) data))for part 1 we do not need the last item
(setq machines (--map (-drop-last 1 it) cleanedup-data))
(defun to-bin (l)
(-sum (--map-indexed (* it (expt 2 it-index)) l)))
(defun to-mask (l)
(-sum (--map (expt 2 it) l)))
(setq mask-machines (--map (cons (to-bin (car it)) (-map #'to-mask (cdr it))) machines))
(-sum
(-map (lambda (machine)
(-min (-map 'length (--filter (= (car machine) (apply 'logxor it))
(-powerset (cdr machine))))))
mask-machines))7
This 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… except that it does not work 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
(setq machines (--map (-rotate 1 (cdr it)) data)
machines (--map (cons (car it) (--sort (> (length it) (length other)) (cdr it))) 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 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)| 5 | 1 | 3 | 0 | 1 | 0 |
| 2 | 0 | 5 | 5 | 0 | |
| 6 | 5 | -1 | 0 |