diff --git a/p10/p10.org b/p10/p10.org index 42ecb77..ad0800f 100644 --- a/p10/p10.org +++ b/p10/p10.org @@ -148,42 +148,44 @@ These are some auxiliary functions to create and deal with matrices : row-reduce #+begin_src emacs-lisp - (defun set-distance (a b) - (length (-difference b a))) - - (defun -min-or-0 (list) - (if (not list) 0 - (-min list))) - - (defun trip-value (list &optional base) - (let ((n (* 1.0 (length list)))) - (--map (+ (set-distance base it) - (/ (-min-or-0 (--remove (= 0 it) (-map (lambda (new) - (set-distance (-union base it) new)) - list))) - n)) - list))) - - (defun sort-re-trip-value (list &optional base) - (-map 'cdr (--sort (< (car it) (car other)) (-zip-pair (trip-value list base) list)))) - - (defun sort-recursively (list &optional base) - (when list - (let* ((step (sort-re-trip-value list base)) - (top (car step)) - (bottom (cdr step))) - (cons top - (sort-recursively bottom (-union top base)))))) - - (defun fix-machine (machine) - (let* ((machine-1 (cons (car machine) (sort-recursively (cdr machine)))) - (sorted (-reduce '-union (cdr machine-1))) - (permutation (-grade-up '< sorted))) - (cons (-select-by-indices sorted (car machine-1)) - (--map (--map (nth it permutation) it) (cdr machine-1))))) - - (matrix-buttons (cadr machines)) - (matrix-buttons (fix-machine (cadr machines))) + (defun set-distance (a b) + (length (-difference b a))) + + (defun -min-or-0 (list) + (if (not list) 0 + (-min list))) + + (defun trip-value (list &optional base) + (let ((n (* 1.0 (length list)))) + (--map (+ (set-distance base it) + (/ (-min-or-0 (--remove (= 0 it) (-map (lambda (new) + (set-distance (-union base it) new)) + list))) + n)) + list))) + + (defun sort-re-trip-value (list &optional base) + (-map 'cdr (--sort (< (car it) (car other)) (-zip-pair (trip-value list base) list)))) + + (defun sort-recursively (list &optional base) + (when list + (let* ((step (sort-re-trip-value list base)) + (top (car step)) + (bottom (cdr step))) + (cons top + (sort-recursively bottom (-union top base)))))) + + (defun fix-machine (machine) + (let* ((machine-1 (cons (car machine) (sort-recursively (cdr machine)))) + (sorted (-reduce '-union (cdr machine-1))) + (permutation (-grade-up '< sorted))) + (cons (-select-by-indices sorted (car machine-1)) + (--map (--map (nth it permutation) it) (cdr machine-1))))) + + (matrix-buttons (cadr machines)) + ; (-distinct + (matrix-buttons (fix-machine (nth 1 machines))) + ;) #+end_src #+RESULTS: @@ -197,18 +199,23 @@ These are some auxiliary functions to create and deal with matrices | 61 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | 1 | 1 | #+begin_src emacs-lisp - (setq buttons nil) - (solve-well-ordered (matrix-buttons (fix-machine (nth 1 machines)))) + (setq solutions-tree nil) + (solve-well-ordered (-distinct (matrix-buttons (fix-machine (nth 1 machines))))) #+end_src +#+RESULTS: + #+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 #+end_src +#+RESULTS: + This is the tricky part; we want solve the row-reduced form, but we need to be careful with our choices if we have more than one possibility @@ -255,7 +262,13 @@ possibility (setq current-row (1- current-row))))) soln)) - (setq buttons nil) + (setq solutions-tree nil) +#+end_src + +This implementation works, but I need to make it recursive, so that I can memoize +#+begin_src emacs-lisp + (defun test-soln (matrix soln) + (-map (lambda (row) (advent/dot (cdr row) soln)) matrix)) (defun solve-well-ordered (matrix) ;; we start from the last row @@ -264,8 +277,8 @@ possibility (last-used-button number-of-buttons) (current-row (1- (length matrix)))) (while (> last-used-button 0) - (push last-used-button buttons) - (message (format "%d" (length soln))) + (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)) @@ -274,40 +287,80 @@ possibility (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 (-replace-at i 0 rrow))) + (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* ((correction (advent/dot it (-replace-at i 0 rrow))) - (max-soln (- a correction))) - (if (< max-soln 0) (list it) + (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) - ; remove solutions that are not feasible - soln (--filter (--every (>= it 0) (-map (lambda (row) - (let ((correction (advent/dot it (cdr row)))) - (- (car row) correction))) - matrix)) - soln) last-used-button button)))) (setq soln (--filter (= a (advent/dot it rrow)) soln) - current-row (1- current-row))))) + current-row (1- current-row))) + (push soln solutions-tree) + )) soln)) - - (defun minimal-pushes (machine) - (-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine)))))) - - #+end_src #+RESULTS: : minimal-pushes +Try to do it recursively +#+begin_src emacs-lisp + (defun test-soln (matrix soln) + (-map (lambda (row) (advent/dot (cdr row) soln)) matrix)) + + (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)) +#+end_src + try this. create a distance in the space of buttons given by the number of elements in the difference #+begin_src emacs-lisp