diff --git a/p10/p10.org b/p10/p10.org index 59f91ab..39da603 100644 --- a/p10/p10.org +++ b/p10/p10.org @@ -4,7 +4,7 @@ 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") + (insert-file-contents "input-test") (advent/replace-multiple-regex-buffer '(("," . " ") ("^" . "(") @@ -24,39 +24,8 @@ linear algebra behind it. 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. -#+begin_src emacs-lisp - (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)) - - (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)) -#+end_src - -#+RESULTS: -: 7 - -This approach blows the stack even for the test input +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)) @@ -73,11 +42,10 @@ This approach blows the stack even for the test input machines )) (-iterate 'solve-machines (list (car machines)) 19) - #+end_src -Instead, go depth first and memoize for the win… except that -it does not work for the true input +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)) @@ -106,113 +74,137 @@ it does not work for the true input #+RESULTS: : 33 -So we need to stop being a brute and realize that this -is a linear algebra problem. Gauss elimination to the rescue +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 (--map (cons (car it) (--sort (> (length it) (length other)) (cdr it))) machines)) + (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 - ;; 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 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 + (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: