From 43ba7e53f3673b853e46621e9d91c401ae381ec6 Mon Sep 17 00:00:00 2001 From: Jacopo De Simoi Date: Sat, 13 Dec 2025 16:41:04 -0500 Subject: [PATCH] [p10] Another attempt MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This still blows the stack, but at least gets past the first 24 matrices… --- p10/p10.org | 161 ++++++++++++++++++++++++++++++++-------------------- 1 file changed, 101 insertions(+), 60 deletions(-) diff --git a/p10/p10.org b/p10/p10.org index bdce139..92cbf3d 100644 --- a/p10/p10.org +++ b/p10/p10.org @@ -84,7 +84,7 @@ degenerate and we have constraints; #+end_src These are some auxiliary functions to create and deal with matrices -#+begin_src emacs-lisp +#+begin_src emacs-lisp :results none (defun matrix-buttons (machine) "Takes MACHINE and returns the corresponding augmented matrix of the linear system. The vector of constants is the first column vector @@ -148,49 +148,69 @@ 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 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-value (list &optional base) - (-map 'cdr (--sort (< (car it) (car other)) (-zip-pair (value list base) list)))) - - (defun sort-recursively (list &optional base) - (when list - (let* ((step (sort-re-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 (--map-indexed (nth (nth it-index permutation) (car machine-1)) (car machine-1)) - (--map (--map (nth it permutation) it) (cdr machine-1))) - )) - - ;(setq machines (-map #'fix-machine machines)) - ( (matrix-buttons (fix-machine (car 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)) + (matrix-buttons (fix-machine (cadr machines))) #+end_src #+RESULTS: -| 77 | 1 | 0 | 1 | 0 | 1 | 1 | 1 | 1 | 0 | 0 | -| 49 | 0 | 1 | 1 | 1 | 0 | 1 | 0 | 1 | 1 | 0 | -| 5 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 1 | -1 | -1 | -| 90 | 0 | 0 | 0 | 1 | 1 | 2 | 1 | 0 | 2 | 1 | -| -12 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | -| 68 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | -1 | -| 38 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | -| -18 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | -1 | +| 51 | 1 | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 1 | +| 74 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 1 | 0 | 1 | +| 72 | 1 | 1 | 1 | 1 | 1 | 0 | 0 | 0 | 1 | 0 | +| 31 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 1 | +| 49 | 0 | 0 | 1 | 0 | 1 | 0 | 1 | 1 | 0 | 0 | +| 77 | 0 | 0 | 0 | 1 | 0 | 1 | 1 | 1 | 1 | 1 | +| 38 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 1 | 1 | +| 61 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 | 1 | 1 | + + +#+RESULTS: +| 7 | 1 | 0 | 1 | 1 | 0 | +| 5 | 0 | 0 | 0 | 1 | 1 | +| 12 | 1 | 1 | 0 | 1 | 1 | +| 7 | 1 | 1 | 0 | 0 | 1 | +| 2 | 1 | 0 | 1 | 0 | 1 | + + + +#+begin_src emacs-lisp + + + (-min (-map '-sum (solve-well-ordered (matrix-buttons (fix-machine (cadr machines)))))) +#+end_src 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 @@ -238,27 +258,51 @@ possibility (setq current-row (1- current-row))))) soln)) - (defun minimal-pushes (machine) - (-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine)))))) - + (setq buttons nil) - (setq problematic (--first (not (solve-row-reduced (identity (matrix-buttons it)))) machines)) - - (minimal-pushes (cadr machines)) - (row-reduce (matrix-buttons problematic)) + (defun solve-well-ordered (matrix) + ;; we start from the last row + (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) + (push last-used-button buttons) + (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 (-replace-at i 0 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) + (-map (lambda (candidate) (-replace-at button candidate it)) (-iota (1+ max-soln))))) + soln) + last-used-button button)))) + (setq soln (-non-nil (--map (when (= a (advent/dot it rrow)) it) soln)) + current-row (1- current-row))))) + soln)) + (defun minimal-pushes (machine) + (-min (-map #'-sum (solve-row-reduced (row-reduce (matrix-buttons machine)))))) + last-used-button #+end_src #+RESULTS: -| 51.0 | 1.0 | 1.0 | 1.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 | -| 31.0 | 0.0 | 1.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | -| 43.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 1.0 | -| 10.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 1.0 | -1.0 | 0.0 | 0.0 | 0.0 | -| 16.0 | 0.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | -| 23.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 1.0 | -1.0 | 0.0 | -| 33.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 1.0 | 0.0 | 2.0 | 1.0 | -| 19.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 0.0 | 2.0 | -1.0 | 0.0 | +: minimal-pushes try this. create a distance in the space of buttons given by the number of elements in the difference @@ -294,13 +338,10 @@ try this. create a distance in the space of buttons given by the number of eleme (--filter (= rank (length it)) (-powerset (cdr machine)))))) (-min (-map '-sum (-non-nil (-map 'solve--machine bunch)))))) - + (-first (not )) (-sum (-map 'solve-machine machines)) #+end_src #+RESULTS: : 33 -* - -*