wilderjds
/
advent-2025
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[p10] one cm closer

Browse Source 
[p10] pass the ball
master
Jacopo De Simoi 6 months ago
parent e5dab89541
commit 0392d65d50
1 changed files with 111 additions and 58 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 169
      p10/p10.org

169
p10/p10.org
Unescape View File

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

Write Preview
Loading…
Cancel
Save