[p10] recursive implementation

needs some further debugging…
master
Jacopo De Simoi 6 months ago
parent 0392d65d50
commit 227635f603
  1. 127
      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
@ -320,45 +379,39 @@ Try to do it recursively
(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)
(if (not matrix) t
(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))
(row (-last-item 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)))))
(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)))))
(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))
(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