diff --git a/p10/p10.org b/p10/p10.org index ad0800f..180a203 100644 --- a/p10/p10.org +++ b/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