[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 #+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
@ -320,45 +379,39 @@ Try to do it recursively
(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)
(if (not matrix) t
(let* ((number-of-buttons (1- (length (car matrix)))) (let* ((number-of-buttons (1- (length (car matrix))))
(soln (list (-repeat number-of-buttons 0))) (row (-last-item matrix))
(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)) (a (car row))
(rrow (cdr row)) (rrow (cdr row))
(i (--find-index (not (zerop it)) (-take last-used-button rrow)))) (possible-indices (--find-indices (not (zerop it)) rrow)))
(if i (if (not possible-indices)
(let ((possible-indices (--filter (not (zerop (nth it rrow))) (when (zerop a)
(-iota (- last-used-button i) i)))) (solve-well-ordered-recursively (-butlast matrix)))
(if (= 1 (length possible-indices)) ;no choices here, easy (let ((possible-solutions
(setq soln (-non-nil (--map (let* ((correction (advent/dot it rrow)) (if (= 1 (length possible-indices)) (list a)
(corrected-a (- a correction))) (let* ((button (-last-item possible-indices))
(unless (< corrected-a 0) (max-soln (-min (-non-nil (-map (lambda (row)
(-replace-at i corrected-a it))) (when (= 1 (nth button (cdr row))) (car row)))
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))))) matrix)))))
(unless (< max-soln 0) (when (>= max-soln 0) (-iota (1+ max-soln)))))))
(-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln))))) (-non-nil (-mapcat (lambda (a)
soln) (let* ((new-car (--map (if (= 1 (-last-item it)) (- (car it) a) (car it)) matrix)))
last-used-button button)))) (when (--every (>= it 0) new-car)
(setq soln (--filter (= a (advent/dot it rrow)) soln) (let* ((new-matrix (-map '-butlast (--map-indexed (cons (nth it-index new-car) (cdr it)) matrix))) ; remove one column
current-row (1- current-row))) (next (solve-well-ordered-recursively new-matrix)))
(push soln solutions-tree) (when next (if (listp next)
)) (--map (cons a it) next)
soln)) (list (list a))))))))
possible-solutions)))))))
#+end_src #+end_src

Loading…
Cancel
Save