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
Split 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
#+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

Write Preview
Loading…
Cancel
Save