[p10] recursive implementation

needs some further debugging…
master
Jacopo De Simoi 6 months ago
parent 0392d65d50
commit 227635f603
  1. 141
      p10/p10.org

@ -200,16 +200,75 @@ These are some auxiliary functions to create and deal with matrices
#+begin_src emacs-lisp #+begin_src emacs-lisp
(setq solutions-tree nil) (setq solutions-tree nil)
(solve-well-ordered (-distinct (matrix-buttons (fix-machine (nth 1 machines))))) (solve-well-ordered (-distinct (matrix-buttons (fix-machine (nth 2 machines)))))
#+end_src #+end_src
#+RESULTS: #+RESULTS:
| 8 | 15 | 11 | 6 | 10 | 0 | 32 | 1 |
| 8 | 15 | 11 | 6 | 9 | 1 | 32 | 1 |
| 8 | 15 | 11 | 6 | 8 | 2 | 32 | 1 |
| 8 | 15 | 11 | 6 | 7 | 3 | 32 | 1 |
| 8 | 15 | 11 | 6 | 6 | 4 | 32 | 1 |
| 8 | 15 | 11 | 6 | 5 | 5 | 32 | 1 |
| 8 | 15 | 11 | 6 | 4 | 6 | 32 | 1 |
| 8 | 15 | 11 | 6 | 3 | 7 | 32 | 1 |
| 8 | 15 | 11 | 6 | 2 | 8 | 32 | 1 |
| 8 | 15 | 11 | 6 | 1 | 9 | 32 | 1 |
| 8 | 15 | 11 | 6 | 0 | 10 | 32 | 1 |
| 10 | 14 | 12 | 5 | 9 | 0 | 30 | 4 |
| 10 | 14 | 12 | 5 | 8 | 1 | 30 | 4 |
| 10 | 14 | 12 | 5 | 7 | 2 | 30 | 4 |
| 10 | 14 | 12 | 5 | 6 | 3 | 30 | 4 |
| 10 | 14 | 12 | 5 | 5 | 4 | 30 | 4 |
| 10 | 14 | 12 | 5 | 4 | 5 | 30 | 4 |
| 10 | 14 | 12 | 5 | 3 | 6 | 30 | 4 |
| 10 | 14 | 12 | 5 | 2 | 7 | 30 | 4 |
| 10 | 14 | 12 | 5 | 1 | 8 | 30 | 4 |
| 10 | 14 | 12 | 5 | 0 | 9 | 30 | 4 |
| 12 | 13 | 13 | 4 | 8 | 0 | 28 | 7 |
| 12 | 13 | 13 | 4 | 7 | 1 | 28 | 7 |
| 12 | 13 | 13 | 4 | 6 | 2 | 28 | 7 |
| 12 | 13 | 13 | 4 | 5 | 3 | 28 | 7 |
| 12 | 13 | 13 | 4 | 4 | 4 | 28 | 7 |
| 12 | 13 | 13 | 4 | 3 | 5 | 28 | 7 |
| 12 | 13 | 13 | 4 | 2 | 6 | 28 | 7 |
| 12 | 13 | 13 | 4 | 1 | 7 | 28 | 7 |
| 12 | 13 | 13 | 4 | 0 | 8 | 28 | 7 |
| 14 | 12 | 14 | 3 | 7 | 0 | 26 | 10 |
| 14 | 12 | 14 | 3 | 6 | 1 | 26 | 10 |
| 14 | 12 | 14 | 3 | 5 | 2 | 26 | 10 |
| 14 | 12 | 14 | 3 | 4 | 3 | 26 | 10 |
| 14 | 12 | 14 | 3 | 3 | 4 | 26 | 10 |
| 14 | 12 | 14 | 3 | 2 | 5 | 26 | 10 |
| 14 | 12 | 14 | 3 | 1 | 6 | 26 | 10 |
| 14 | 12 | 14 | 3 | 0 | 7 | 26 | 10 |
| 16 | 11 | 15 | 2 | 6 | 0 | 24 | 13 |
| 16 | 11 | 15 | 2 | 5 | 1 | 24 | 13 |
| 16 | 11 | 15 | 2 | 4 | 2 | 24 | 13 |
| 16 | 11 | 15 | 2 | 3 | 3 | 24 | 13 |
| 16 | 11 | 15 | 2 | 2 | 4 | 24 | 13 |
| 16 | 11 | 15 | 2 | 1 | 5 | 24 | 13 |
| 16 | 11 | 15 | 2 | 0 | 6 | 24 | 13 |
| 18 | 10 | 16 | 1 | 5 | 0 | 22 | 16 |
| 18 | 10 | 16 | 1 | 4 | 1 | 22 | 16 |
| 18 | 10 | 16 | 1 | 3 | 2 | 22 | 16 |
| 18 | 10 | 16 | 1 | 2 | 3 | 22 | 16 |
| 18 | 10 | 16 | 1 | 1 | 4 | 22 | 16 |
| 18 | 10 | 16 | 1 | 0 | 5 | 22 | 16 |
| 20 | 9 | 17 | 0 | 4 | 0 | 20 | 19 |
| 20 | 9 | 17 | 0 | 3 | 1 | 20 | 19 |
| 20 | 9 | 17 | 0 | 2 | 2 | 20 | 19 |
| 20 | 9 | 17 | 0 | 1 | 3 | 20 | 19 |
| 20 | 9 | 17 | 0 | 0 | 4 | 20 | 19 |
#+begin_src emacs-lisp #+begin_src emacs-lisp
(solve-well-ordered-recursively (-distinct (matrix-buttons (fix-machine (nth 2 machines)))))
#+end_src
#+RESULTS:
| 19 | 20 | 0 | 4 | 0 | 17 | 9 | 20 |
#+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 solutions-tree
#+end_src #+end_src
@ -292,7 +351,7 @@ This implementation works, but I need to make it recursive, so that I can memoiz
(unless (< corrected-a 0) (unless (< corrected-a 0)
(-replace-at i corrected-a it))) (-replace-at i corrected-a it)))
soln)) soln))
last-used-button i last-used-button i
current-row (1- current-row)) ; this needs to change current-row (1- current-row)) ; this needs to change
;;otherwise, we create a number of solutions ;;otherwise, we create a number of solutions
@ -301,7 +360,7 @@ This implementation works, but I need to make it recursive, so that I can memoiz
(when (= 1 (nth button (cdr row))) (when (= 1 (nth button (cdr row)))
(- (car row) (advent/dot it (cdr row))))) (- (car row) (advent/dot it (cdr row)))))
matrix))))) matrix)))))
(unless (< max-soln 0) (unless (< max-soln 0)
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln))))) (-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln)))))
soln) soln)
last-used-button button)))) last-used-button button))))
@ -315,50 +374,44 @@ This implementation works, but I need to make it recursive, so that I can memoiz
#+RESULTS: #+RESULTS:
: minimal-pushes : minimal-pushes
Try to do it recursively Try to do it recursively
#+begin_src emacs-lisp #+begin_src emacs-lisp
(defun test-soln (matrix soln) (defun test-soln (matrix soln)
(-map (lambda (row) (advent/dot (cdr row) soln)) matrix)) (-map (lambda (row) (advent/dot (cdr row) soln)) matrix))
(defun apply-until-non-nil (fn list)
"Apply FN to each element of LIST until it yields non nil and then return the result"
(let ((result nil))
(while (and list (not result))
(setq result (funcall fn (pop list))))
result))
(defun solve-well-ordered-recursively (matrix) (defun solve-well-ordered-recursively (matrix)
(let* ((number-of-buttons (1- (length (car matrix)))) (if (not matrix) t
(soln (list (-repeat number-of-buttons 0))) (let* ((number-of-buttons (1- (length (car matrix))))
(last-used-button number-of-buttons) (row (-last-item matrix))
(current-row (1- (length matrix)))) (a (car row))
(while (> last-used-button 0) (rrow (cdr row))
(message (format "%d %d" last-used-button (length soln))) (possible-indices (--find-indices (not (zerop it)) rrow)))
;; (setq soln (--map (-min-by (lambda (a b) (< (-sum a) (-sum b))) (cdr it)) (--group-by (test-soln matrix it) soln))) (if (not possible-indices)
(let* ((row (nth current-row matrix)) (when (zerop a)
(a (car row)) (solve-well-ordered-recursively (-butlast matrix)))
(rrow (cdr row)) (let ((possible-solutions
(i (--find-index (not (zerop it)) (-take last-used-button rrow)))) (if (= 1 (length possible-indices)) (list a)
(if i (let* ((button (-last-item possible-indices))
(let ((possible-indices (--filter (not (zerop (nth it rrow))) (max-soln (-min (-non-nil (-map (lambda (row)
(-iota (- last-used-button i) i)))) (when (= 1 (nth button (cdr row))) (car row)))
(if (= 1 (length possible-indices)) ;no choices here, easy matrix)))))
(setq soln (-non-nil (--map (let* ((correction (advent/dot it rrow)) (when (>= max-soln 0) (-iota (1+ max-soln)))))))
(corrected-a (- a correction))) (-non-nil (-mapcat (lambda (a)
(unless (< corrected-a 0) (let* ((new-car (--map (if (= 1 (-last-item it)) (- (car it) a) (car it)) matrix)))
(-replace-at i corrected-a it))) (when (--every (>= it 0) new-car)
soln)) (let* ((new-matrix (-map '-butlast (--map-indexed (cons (nth it-index new-car) (cdr it)) matrix))) ; remove one column
(next (solve-well-ordered-recursively new-matrix)))
last-used-button i (when next (if (listp next)
current-row (1- current-row)) ; this needs to change (--map (cons a it) next)
;;otherwise, we create a number of solutions (list (list a))))))))
(let* ((button (-last-item possible-indices))) possible-solutions)))))))
(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 #+end_src

Loading…
Cancel
Save