[p10] Another attempt

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. 161
      p10/p10.org

@ -84,7 +84,7 @@ degenerate and we have constraints;
#+end_src #+end_src
These are some auxiliary functions to create and deal with matrices 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) (defun matrix-buttons (machine)
"Takes MACHINE and returns the corresponding augmented matrix of the "Takes MACHINE and returns the corresponding augmented matrix of the
linear system. The vector of constants is the first column vector 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 : row-reduce
#+begin_src emacs-lisp #+begin_src emacs-lisp
(defun set-distance (a b) (defun set-distance (a b)
(length (-difference b a))) (length (-difference b a)))
(defun -min-or-0 (list) (defun -min-or-0 (list)
(if (not list) 0 (if (not list) 0
(-min list))) (-min list)))
(defun value (list &optional base) (defun trip-value (list &optional base)
(let ((n (* 1.0 (length list)))) (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))) (--map (+ (set-distance base it)
(/ (-min-or-0 (--remove (= 0 it) (-map (lambda (new)
(defun sort-re-value (list &optional base) (set-distance (-union base it) new))
(-map 'cdr (--sort (< (car it) (car other)) (-zip-pair (value list base) list)))) list)))
n))
(defun sort-recursively (list &optional base) list)))
(when list
(let* ((step (sort-re-value list base)) (defun sort-re-trip-value (list &optional base)
(top (car step)) (-map 'cdr (--sort (< (car it) (car other)) (-zip-pair (trip-value list base) list))))
(bottom (cdr step)))
(cons top (defun sort-recursively (list &optional base)
(sort-recursively bottom (-union top base)))))) (when list
(let* ((step (sort-re-trip-value list base))
(defun fix-machine (machine) (top (car step))
(let* ((machine-1 (cons (car machine) (sort-recursively (cdr machine)))) (bottom (cdr step)))
(sorted (-reduce '-union (cdr machine-1))) (cons top
(permutation (-grade-up '< sorted))) (sort-recursively bottom (-union top base))))))
(cons (--map-indexed (nth (nth it-index permutation) (car machine-1)) (car machine-1))
(--map (--map (nth it permutation) it) (cdr machine-1))) (defun fix-machine (machine)
)) (let* ((machine-1 (cons (car machine) (sort-recursively (cdr machine))))
(sorted (-reduce '-union (cdr machine-1)))
;(setq machines (-map #'fix-machine machines)) (permutation (-grade-up '< sorted)))
( (matrix-buttons (fix-machine (car machines)))) (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 #+end_src
#+RESULTS: #+RESULTS:
| 77 | 1 | 0 | 1 | 0 | 1 | 1 | 1 | 1 | 0 | 0 | | 51 | 1 | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 1 |
| 49 | 0 | 1 | 1 | 1 | 0 | 1 | 0 | 1 | 1 | 0 | | 74 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 1 | 0 | 1 |
| 5 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 1 | -1 | -1 | | 72 | 1 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 1 | 0 |
| 90 | 0 | 0 | 0 | 1 | 1 | 2 | 1 | 0 | 2 | 1 | | 31 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 1 |
| -12 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | | 49 | 0 | 0 | 1 | 0 | 1 | 0 | 1 | 1 | 0 | 0 |
| 68 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | -1 | | 77 | 0 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
| 38 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | | 38 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 1 | 1 |
| -18 | 0 | 0 | 0 | 0 | 0 | 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 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 need to be careful with our choices if we have more than one
@ -238,27 +258,51 @@ possibility
(setq current-row (1- current-row))))) (setq current-row (1- current-row)))))
soln)) soln))
(defun minimal-pushes (machine) (setq buttons nil)
(-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine))))))
(setq problematic (--first (not (solve-row-reduced (identity (matrix-buttons it)))) machines)) (defun solve-well-ordered (matrix)
;; we start from the last row
(minimal-pushes (cadr machines)) (let* ((number-of-buttons (1- (length (car matrix))))
(row-reduce (matrix-buttons problematic)) (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 #+end_src
#+RESULTS: #+RESULTS:
| 51.0 | 1.0 | 1.0 | 1.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 | : minimal-pushes
| 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 |
try this. create a distance in the space of buttons given by the number of elements in the difference 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)) (--filter (= rank (length it))
(-powerset (cdr machine)))))) (-powerset (cdr machine))))))
(-min (-map '-sum (-non-nil (-map 'solve--machine bunch)))))) (-min (-map '-sum (-non-nil (-map 'solve--machine bunch))))))
(-first (not ))
(-sum (-map 'solve-machine machines)) (-sum (-map 'solve-machine machines))
#+end_src #+end_src
#+RESULTS: #+RESULTS:
: 33 : 33
*
*

Loading…
Cancel
Save