[p10] recursive implementation

needs some further debugging…
master
Jacopo De Simoi 3 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
(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
#+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
(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))))))
solutions-tree
#+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)
(-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
@ -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)))
(- (car row) (advent/dot it (cdr row)))))
matrix)))))
(unless (< max-soln 0)
(unless (< max-soln 0)
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln)))))
soln)
last-used-button button))))
@ -315,50 +374,44 @@ This implementation works, but I need to make it recursive, so that I can memoiz
#+RESULTS:
: minimal-pushes
Try to do it recursively
Try to do it recursively
#+begin_src emacs-lisp
(defun test-soln (matrix soln)
(-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)
(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))
(if (not matrix) t
(let* ((number-of-buttons (1- (length (car matrix))))
(row (-last-item matrix))
(a (car row))
(rrow (cdr row))
(possible-indices (--find-indices (not (zerop it)) rrow)))
(if (not possible-indices)
(when (zerop a)
(solve-well-ordered-recursively (-butlast matrix)))
(let ((possible-solutions
(if (= 1 (length possible-indices)) (list a)
(let* ((button (-last-item possible-indices))
(max-soln (-min (-non-nil (-map (lambda (row)
(when (= 1 (nth button (cdr row))) (car row)))
matrix)))))
(when (>= max-soln 0) (-iota (1+ max-soln)))))))
(-non-nil (-mapcat (lambda (a)
(let* ((new-car (--map (if (= 1 (-last-item it)) (- (car it) a) (car it)) matrix)))
(when (--every (>= it 0) new-car)
(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)))
(when next (if (listp next)
(--map (cons a it) next)
(list (list a))))))))
possible-solutions)))))))
#+end_src

Loading…
Cancel
Save