wilderjds
/
advent-2025
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[p10] Refactor the row-reduction code

Browse Source
master
Jacopo De Simoi 6 months ago
parent c5179fed61
commit 47e567b8f8
1 changed files with 131 additions and 139 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 130
      p10/p10.org

130
p10/p10.org
Unescape View File

@ -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,21 +74,26 @@ 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
;; 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)))
"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))))
@ -137,36 +110,55 @@ is a linear algebra problem. Gauss elimination to the rescue
(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)
;; Here we row-reduce; this is non-unique
; This is a routine for row-reducing the augmented matrix
(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))))
(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
(defun solve-row-reduced (matrix)
;; we start from the last row
(let ((soln (-repeat (length (cdar matrix)) 0)))

Write Preview
Loading…
Cancel
Save