[p10] one cm closer

[p10] pass the ball
master
Jacopo De Simoi 6 months ago
parent e5dab89541
commit 0392d65d50
  1. 99
      p10/p10.org

@ -183,7 +183,9 @@ These are some auxiliary functions to create and deal with matrices
(--map (--map (nth it permutation) it) (cdr machine-1)))))
(matrix-buttons (cadr machines))
(matrix-buttons (fix-machine (cadr machines)))
; (-distinct
(matrix-buttons (fix-machine (nth 1 machines)))
;)
#+end_src
#+RESULTS:
@ -197,18 +199,23 @@ These are some auxiliary functions to create and deal with matrices
| 61 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | 1 | 1 |
#+begin_src emacs-lisp
(setq buttons nil)
(solve-well-ordered (matrix-buttons (fix-machine (nth 1 machines))))
(setq solutions-tree nil)
(solve-well-ordered (-distinct (matrix-buttons (fix-machine (nth 1 machines)))))
#+end_src
#+RESULTS:
#+begin_src emacs-lisp
(-min (-map '-sum (solve-well-ordered (matrix-buttons (fix-machine (cadr machines))))))
; (-min (-map '-sum (solve-well-ordered (matrix-buttons (fix-machine (cadr machines))))))
solutions-tree
#+end_src
#+RESULTS:
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
possibility
@ -255,7 +262,13 @@ possibility
(setq current-row (1- current-row)))))
soln))
(setq buttons nil)
(setq solutions-tree nil)
#+end_src
This implementation works, but I need to make it recursive, so that I can memoize
#+begin_src emacs-lisp
(defun test-soln (matrix soln)
(-map (lambda (row) (advent/dot (cdr row) soln)) matrix))
(defun solve-well-ordered (matrix)
;; we start from the last row
@ -264,8 +277,8 @@ possibility
(last-used-button number-of-buttons)
(current-row (1- (length matrix))))
(while (> last-used-button 0)
(push last-used-button buttons)
(message (format "%d" (length soln)))
(message (format "%d %d" last-used-button (length soln)))
;; (setq soln (--map (-min-by (lambda (a b) (< (-sum a) (-sum b))) (cdr it)) (--group-by (test-soln matrix it) soln)))
(let* ((row (nth current-row matrix))
(a (car row))
(rrow (cdr row))
@ -274,40 +287,80 @@ possibility
(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)))
(setq soln (-non-nil (--map (let* ((correction (advent/dot it 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)
(setq soln (--mapcat (let* ((max-soln (-min (-non-nil (-map (lambda (row)
(when (= 1 (nth button (cdr row)))
(- (car row) (advent/dot it (cdr row)))))
matrix)))))
(unless (< max-soln 0)
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln)))))
soln)
; remove solutions that are not feasible
soln (--filter (--every (>= it 0) (-map (lambda (row)
(let ((correction (advent/dot it (cdr row))))
(- (car row) correction)))
matrix))
soln)
last-used-button button))))
(setq soln (--filter (= a (advent/dot it rrow)) soln)
current-row (1- current-row)))))
current-row (1- current-row)))
(push soln solutions-tree)
))
soln))
(defun minimal-pushes (machine)
(-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine))))))
#+end_src
#+RESULTS:
: minimal-pushes
Try to do it recursively
#+begin_src emacs-lisp
(defun test-soln (matrix soln)
(-map (lambda (row) (advent/dot (cdr row) soln)) matrix))
(defun solve-well-ordered-recursively (matrix)
(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)
(message (format "%d %d" last-used-button (length soln)))
;; (setq soln (--map (-min-by (lambda (a b) (< (-sum a) (-sum b))) (cdr it)) (--group-by (test-soln matrix it) soln)))
(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 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* ((max-soln (-min (-non-nil (-map (lambda (row)
(when (= 1 (nth button (cdr row)))
(- (car row) (advent/dot it (cdr row)))))
matrix)))))
(unless (< max-soln 0)
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln)))))
soln)
last-used-button button))))
(setq soln (--filter (= a (advent/dot it rrow)) soln)
current-row (1- current-row)))
(push soln solutions-tree)
))
soln))
#+end_src
try this. create a distance in the space of buttons given by the number of elements in the difference
#+begin_src emacs-lisp

Loading…
Cancel
Save