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

[p10] Another attempt

Browse Source 
This still blows the stack, but at least gets past the first 24 matrices…
master
Jacopo De Simoi 6 months ago
parent 11bf716cb8
commit 43ba7e53f3
1 changed files with 101 additions and 60 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. 161
      p10/p10.org

161
p10/p10.org
Unescape View File

@ -84,7 +84,7 @@ degenerate and we have constraints;
#+end_src
These are some auxiliary functions to create and deal with matrices
#+begin_src emacs-lisp
#+begin_src emacs-lisp :results none
(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
@ -148,49 +148,69 @@ These are some auxiliary functions to create and deal with matrices
: row-reduce
#+begin_src emacs-lisp
(defun set-distance (a b)
(length (-difference b a)))
(defun -min-or-0 (list)
(if (not list) 0
(-min list)))
(defun 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-value (list &optional base)
(-map 'cdr (--sort (< (car it) (car other)) (-zip-pair (value list base) list))))
(defun sort-recursively (list &optional base)
(when list
(let* ((step (sort-re-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 (--map-indexed (nth (nth it-index permutation) (car machine-1)) (car machine-1))
(--map (--map (nth it permutation) it) (cdr machine-1)))
))
;(setq machines (-map #'fix-machine machines))
( (matrix-buttons (fix-machine (car machines))))
(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)))
#+end_src
#+RESULTS:
| 77 | 1 | 0 | 1 | 0 | 1 | 1 | 1 | 1 | 0 | 0 |
| 49 | 0 | 1 | 1 | 1 | 0 | 1 | 0 | 1 | 1 | 0 |
| 5 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 1 | -1 | -1 |
| 90 | 0 | 0 | 0 | 1 | 1 | 2 | 1 | 0 | 2 | 1 |
| -12 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 |
| 68 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | -1 |
| 38 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 |
| -18 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | -1 |
| 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 |
#+RESULTS:
| 7 | 1 | 0 | 1 | 1 | 0 |
| 5 | 0 | 0 | 0 | 1 | 1 |
| 12 | 1 | 1 | 0 | 1 | 1 |
| 7 | 1 | 1 | 0 | 0 | 1 |
| 2 | 1 | 0 | 1 | 0 | 1 |
#+begin_src emacs-lisp
(-min (-map '-sum (solve-well-ordered (matrix-buttons (fix-machine (cadr machines))))))
#+end_src
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
@ -238,27 +258,51 @@ possibility
(setq current-row (1- current-row)))))
soln))
(defun minimal-pushes (machine)
(-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine))))))
(setq buttons nil)
(setq problematic (--first (not (solve-row-reduced (identity (matrix-buttons it)))) machines))
(minimal-pushes (cadr machines))
(row-reduce (matrix-buttons problematic))
(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)
(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)
last-used-button button))))
(setq soln (-non-nil (--map (when (= a (advent/dot it rrow)) it) soln))
current-row (1- current-row)))))
soln))
(defun minimal-pushes (machine)
(-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine))))))
last-used-button
#+end_src
#+RESULTS:
| 51.0 | 1.0 | 1.0 | 1.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 |
| 31.0 | 0.0 | 1.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 |
| 43.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 1.0 |
| 10.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 1.0 | -1.0 | 0.0 | 0.0 | 0.0 |
| 16.0 | 0.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 |
| 23.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 1.0 | -1.0 | 0.0 |
| 33.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 2.0 | 1.0 |
| 19.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 2.0 | -1.0 | 0.0 |
: minimal-pushes
try this. create a distance in the space of buttons given by the number of elements in the difference
@ -294,13 +338,10 @@ try this. create a distance in the space of buttons given by the number of eleme
(--filter (= rank (length it))
(-powerset (cdr machine))))))
(-min (-map '-sum (-non-nil (-map 'solve--machine bunch))))))
(-first (not ))
(-sum (-map 'solve-machine machines))
#+end_src
#+RESULTS:
: 33
*
*

Write Preview
Loading…
Cancel
Save