|
|
|
@ -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)))))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(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)) |
|
|
|
|
|
|
|
|
|
|
|
(setq problematic (--first (not (solve-row-reduced (identity (matrix-buttons it)))) machines)) |
|
|
|
(defun minimal-pushes (machine) |
|
|
|
|
|
|
|
(-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine)))))) |
|
|
|
(minimal-pushes (cadr machines)) |
|
|
|
|
|
|
|
(row-reduce (matrix-buttons problematic)) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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 |
|
|
|
* |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
* |
|
|
|
|
|
|
|
|