wilderjds
/
advent-2024
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
89 Commits
1 Branch
0 Tags
1.2 MiB
 
Tag: Branch: Tree: main
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'main'
${ noResults }
advent-2024/p24/p24.org

682 lines
20 KiB
Raw Permalink Blame History

#+title: Solution to p24
This is particularly tricky I find
#+begin_src emacs-lisp :results none
(require 'dash)
(with-temp-buffer
(insert-file-contents "input")
(goto-char (point-min))
(advent/replace-multiple-regex-buffer
'(("^\\(.*\\):\\(.*\\)$" . "\\1 \\2")
("^$" . ")\n (setq gates '( ")
("^\\(.*\\) \\(.*\\) \\(.*\\) -> \\(.*\\)$" .
"((\\1 \\3) \\2 \\4)")))
(insert "(setq ")
(goto-char (point-max))
(insert "))")
(eval-buffer))
(defun symbol< (x y)
(string< (symbol-name x) (symbol-name y)))
(setq wires (let ((wires-tmp (--mapcat (append (car it) (cddr it)) gates)))
(-sort #'symbol<
(-distinct wires-tmp))))
(defun good-vars (a b)
(and (boundp a) (eval a)
(boundp b) (eval b)))
(defun XOR (a b)
(when (good-vars a b)
(logxor (eval a) (eval b))))
(defun OR (a b)
(when (good-vars a b)
(logior (eval a) (eval b))))
(defun AND (a b)
(when (good-vars a b)
(logand (eval a) (eval b))))
#+end_src
Create an actual lisp function from the gate list
#+begin_src emacs-lisp :results none
(defun update-function (gates)
"Each element of gates is ((input1 input2) operation output"
(with-temp-buffer
(insert "(defun step-ng ()\n (setq ")
(--each gates
(let ((in1 (caar it))
(in2 (cadar it))
(out (caddr it))
(op (cadr it)))
(insert (format "%s (%s '%s '%s)\n"
(symbol-name out)
(symbol-name op)
(symbol-name in1)
(symbol-name in2)))))
(insert "))")
(eval-buffer)))
(update-function gates)
#+end_src
According to the following check, the code is symmetric in x and y
#+begin_src emacs-lisp
(defun check-symmetry (gates)
(--every (eq (-elem-index (car (-intersection it used-xxx)) used-xxx)
(-elem-index (car (-intersection it used-yyy)) used-yyy))
(-map #'car
(--filter (or (-intersection (car it) used-xxx)
(-intersection (car it) used-yyy))
gates))))
(check-symmetry gates)
#+end_src
#+RESULTS:
: t
Create a list of all x, y and z bits
#+begin_src emacs-lisp :results none
(setq
used-xxx (--filter
(string-match-p "^x.*" (symbol-name it)) wires)
used-yyy (--filter
(string-match-p "^y.*" (symbol-name it)) wires)
used-zzz (--filter
(string-match-p "^z.*" (symbol-name it)) wires))
#+end_src
Now we rename the wires in some more meaningful way
First create a bunch of aux labels for the wires
#+begin_src emacs-lisp :results none
(let ((bits (-iterate #'1+ 0 (length used-zzz))))
(setq X-wires (--map (intern (format "X%02d" it)) bits)
A-wires (--map (intern (format "A%02d" it)) bits)))
#+end_src
Then we begin by renaming the input layer XOR gates and the AND gates
#+begin_src emacs-lisp
(defun rename-gate-1 (gate)
(unless (-contains? used-zzz (caddr gate))
(when (-intersection (car gate) used-xxx)
(let ((index (-elem-index (car (-intersection (car gate) used-xxx)) used-xxx))
(aux-list (if (eq (cadr gate) 'XOR) X-wires A-wires)))
(cons (caddr gate) (nth index aux-list))))))
(defun create-list-rename-wires-1 (gates)
(-non-nil (-map #'rename-gate-1 gates)))
(defun replace-in-list (al li)
"replace an element of list with the corresponding element listed in al"
(--map (let ((to (assoc it al))) (if to (cdr to) it)) li))
(defun replace-wire (al gate)
(let ((gate (replace-in-list al gate)))
(list (replace-in-list al (car gate)) (cadr gate) (caddr gate))))
(defun replace-wires (al gates)
(--map (replace-wire al it) gates))
;(setq gates (swap-output '(z11 . wpd) gates))
(setq gates-1
(replace-wires (create-list-rename-wires gates) gates))
(--filter (eq (cadr it) 'XOR) gates-1)
(update-function gates)
(run-function 1024 1024)
#+end_src
#+RESULTS:
| (qqw X11) | XOR | z11 |
| (y32 x32) | XOR | X32 |
| (y36 x36) | XOR | X36 |
| (X42 mwt) | XOR | z42 |
| (x00 y00) | XOR | z00 |
| (y26 x26) | XOR | X26 |
| (y43 x43) | XOR | X43 |
| (wrc X17) | XOR | z17 |
| (A15 rkt) | XOR | z15 |
| (y17 x17) | XOR | X17 |
| (X31 sgf) | XOR | z31 |
| (X24 jmf) | XOR | z24 |
| (x01 y01) | XOR | X01 |
| (x05 y05) | XOR | X05 |
| (x14 y14) | XOR | X14 |
| (X35 khf) | XOR | z35 |
| (y41 x41) | XOR | X41 |
| (y21 x21) | XOR | X21 |
| (jkm X13) | XOR | z13 |
| (y20 x20) | XOR | X20 |
| (wvt X03) | XOR | z03 |
| (X41 gfd) | XOR | z41 |
| (wfc X19) | XOR | mdd |
| (X14 rhf) | XOR | z14 |
| (X26 jkr) | XOR | z26 |
| (x31 y31) | XOR | X31 |
| (pwp X30) | XOR | z30 |
| (x23 y23) | XOR | X23 |
| (X04 jth) | XOR | z04 |
| (y16 x16) | XOR | X16 |
| (y25 x25) | XOR | X25 |
| (y12 x12) | XOR | X12 |
| (X23 mkf) | XOR | z23 |
| (dts X33) | XOR | z33 |
| (rfq X36) | XOR | z36 |
| (X40 jbd) | XOR | z40 |
| (jmv X34) | XOR | z34 |
| (y08 x08) | XOR | X08 |
| (y42 x42) | XOR | X42 |
| (y02 x02) | XOR | X02 |
| (wpb X09) | XOR | z09 |
| (x06 y06) | XOR | X06 |
| (kmr X10) | XOR | z10 |
| (X16 kbq) | XOR | z16 |
| (y09 x09) | XOR | X09 |
| (gsk X43) | XOR | z43 |
| (y29 x29) | XOR | X29 |
| (X27 cmb) | XOR | z27 |
| (X20 hvn) | XOR | z20 |
| (x44 y44) | XOR | X44 |
| (X38 wts) | XOR | z38 |
| (qvq X18) | XOR | z18 |
| (y27 x27) | XOR | X27 |
| (X02 vdq) | XOR | z02 |
| (whf X05) | XOR | z05 |
| (x38 y38) | XOR | X38 |
| (x19 y19) | XOR | X19 |
| (y24 x24) | XOR | X24 |
| (y39 x39) | XOR | X39 |
| (qpm X21) | XOR | z21 |
| (smt X37) | XOR | wts |
| (x10 y10) | XOR | X10 |
| (y33 x33) | XOR | X33 |
| (x18 y18) | XOR | X18 |
| (A00 X01) | XOR | z01 |
| (x35 y35) | XOR | X35 |
| (tsk X29) | XOR | z29 |
| (y04 x04) | XOR | X04 |
| (pfc X25) | XOR | z25 |
| (y03 x03) | XOR | X03 |
| (X39 fkq) | XOR | z39 |
| (x15 y15) | XOR | X15 |
| (y30 x30) | XOR | X30 |
| (X12 dtq) | XOR | z12 |
| (X44 hks) | XOR | z44 |
| (msf X28) | XOR | z28 |
| (X08 tmg) | XOR | z08 |
| (x28 y28) | XOR | X28 |
| (x40 y40) | XOR | X40 |
| (y37 x37) | XOR | X37 |
| (x34 y34) | XOR | X34 |
| (X32 ftq) | XOR | z32 |
| (y11 x11) | XOR | X11 |
| (x07 y07) | XOR | X07 |
| (y22 x22) | XOR | X22 |
| (x13 y13) | XOR | X13 |
| (qmb X07) | XOR | z07 |
| (X06 cfn) | XOR | z06 |
| (X22 bvr) | XOR | z22 |
; dpf gck
#+begin_src emacs-lisp
(--remove (eq (+ (car it) (cdr it))
(run-function (car it) (cdr it)))
(-zip-pair (-iterate #'1+ 0 1024)
(-iterate #'1- 2048 1024)))
(run-function 4096 0)
;(run-function 32 32)
#+end_src
#+begin_src emacs-lisp
(gates-outputting-on 'z11)
(--filter (eq (cadr it) 'XOR) gates)
#+end_src
#+RESULTS:
| (y32 x32) | XOR | rck |
| (y36 x36) | XOR | hbh |
| (cng mwt) | XOR | z42 |
| (x00 y00) | XOR | z00 |
| (y26 x26) | XOR | wkb |
| (y43 x43) | XOR | fhk |
| (wrc hbw) | XOR | z17 |
| (skh rkt) | XOR | z15 |
| (y17 x17) | XOR | hbw |
| (qqw gkc) | XOR | wpd |
| (rms sgf) | XOR | z31 |
| (gww jmf) | XOR | z24 |
| (x01 y01) | XOR | kjs |
| (x05 y05) | XOR | fds |
| (x14 y14) | XOR | cgg |
| (djt khf) | XOR | z35 |
| (y41 x41) | XOR | jhg |
| (y21 x21) | XOR | csw |
| (jkm dmp) | XOR | z13 |
| (y20 x20) | XOR | bvw |
| (wvt sbt) | XOR | z03 |
| (jhg gfd) | XOR | z41 |
| (wfc cmp) | XOR | mdd |
| (cgg rhf) | XOR | z14 |
| (wkb jkr) | XOR | z26 |
| (x31 y31) | XOR | rms |
| (pwp nnn) | XOR | z30 |
| (x23 y23) | XOR | mcp |
| (jvf jth) | XOR | z04 |
| (y16 x16) | XOR | rvn |
| (y25 x25) | XOR | prp |
| (y12 x12) | XOR | htn |
| (mcp mkf) | XOR | z23 |
| (dts wmq) | XOR | z33 |
| (rfq hbh) | XOR | z36 |
| (nns jbd) | XOR | z40 |
| (jmv nss) | XOR | z34 |
| (y08 x08) | XOR | rjs |
| (y42 x42) | XOR | cng |
| (y02 x02) | XOR | rvm |
| (wpb kbb) | XOR | z09 |
| (x06 y06) | XOR | jtg |
| (kmr rmb) | XOR | z10 |
| (rvn kbq) | XOR | z16 |
| (y09 x09) | XOR | kbb |
| (gsk fhk) | XOR | z43 |
| (y29 x29) | XOR | hvc |
| (tvf cmb) | XOR | z27 |
| (bvw hvn) | XOR | z20 |
| (x44 y44) | XOR | jsg |
| (sqj wts) | XOR | z38 |
| (qvq hns) | XOR | z18 |
| (y27 x27) | XOR | tvf |
| (rvm vdq) | XOR | z02 |
| (whf fds) | XOR | z05 |
| (x38 y38) | XOR | sqj |
| (x19 y19) | XOR | cmp |
| (y24 x24) | XOR | gww |
| (y39 x39) | XOR | vqf |
| (qpm csw) | XOR | z21 |
| (smt wpp) | XOR | wts |
| (x10 y10) | XOR | rmb |
| (y33 x33) | XOR | wmq |
| (x18 y18) | XOR | hns |
| (hjp kjs) | XOR | z01 |
| (x35 y35) | XOR | djt |
| (tsk hvc) | XOR | z29 |
| (y04 x04) | XOR | jvf |
| (pfc prp) | XOR | z25 |
| (y03 x03) | XOR | sbt |
| (vqf fkq) | XOR | z39 |
| (x15 y15) | XOR | jqf |
| (y30 x30) | XOR | nnn |
| (htn dtq) | XOR | z12 |
| (jsg hks) | XOR | z44 |
| (msf kdd) | XOR | z28 |
| (rjs tmg) | XOR | z08 |
| (x28 y28) | XOR | kdd |
| (x40 y40) | XOR | nns |
| (y37 x37) | XOR | wpp |
| (x34 y34) | XOR | nss |
| (rck ftq) | XOR | z32 |
| (y11 x11) | XOR | gkc |
| (x07 y07) | XOR | qpc |
| (y22 x22) | XOR | wwp |
| (x13 y13) | XOR | dmp |
| (qmb qpc) | XOR | z07 |
| (jtg cfn) | XOR | z06 |
| (wwp bvr) | XOR | z22 |
(run-function 2048 0)
(setq depth 0)
Define the functions that implement the code on the wires
#+begin_src emacs-lisp :results none
;; strip all the depth nonsense
(defun eval-wires ()
(-map #'eval wires))
:: TODO rewrite by recursion
(defun run (fn)
"Runs fn until the wires stabilize. when they do, return t if all used
output wires are set and nil otherwise"
(let* ((ew (eval-wires))
(old-ew))
(while (not (equal old-ew ew))
(funcall fn)
(setq old-ew ew
ew (eval-wires))))
(-every #'eval (-drop depth used-zzz)))
(defun reset-var (li)
"Set every wire in the list LI to nil"
(--each li (set it nil))) ;;note that I use set, not setq
(defun set-var (li a)
"Set the bits-wires in the list LI to A; right ordering is assumed"
(let ((a (ash a depth)))
(--each-indexed li (set it (logand 1 (ash a (* -1 it-index)))))))
(defun var-value (li)
"Get the value encoded in the list of wires LI"
(apply #'+ (--map-indexed (* (eval it) (ash 1 it-index)) (-drop depth li))))
(defun run-function (x y)
(reset-var wires)
(set-var used-xxx x)
(set-var used-yyy y)
(when (run #'step-ng)
(var-value used-zzz)))
#+end_src
Let us try to reduce the problem; there are two classes of wires
- input wires
- output wires
#+begin_src emacs-lisp :results none
(setq output-wires (-map #'caddr gates)
input-wires (-difference wires output-wires))
#+end_src
Assuming that some input wires are 0, we can perform the following
operation:
- if at least one input of an AND gate is 0, then the output is 0
- if both inputs of a *OR gate are 0, then the output is 0
- if one input of a *OR gate is 0, then the output is equal to the
other input
In the first two cases we can "disable" the gate and assume that the
output is always zero; then we can short the other gates.
Shorting: I need to find the gate whose output is the only nonzero
input…
We can "propagate" this information
#+begin_src emacs-lisp
(defun disabled-gates (zero-wires gates)
(let* ((and-gates (--filter (equal (cadr it) 'AND) gates))
(other-gates (-difference gates and-gates))
(disabled-and-gates (--filter (-intersection (car it) zero-wires) and-gates))
(disabled-other-gates (--filter (eq 2 (length (-intersection (car it) zero-wires ))) other-gates)))
(let ((new-zero-wires
(-distinct (append zero-wires
(-map #'caddr (append disabled-and-gates disabled-other-gates))))))
(if (> (length new-zero-wires) (length zero-wires))
(disabled-gates new-zero-wires gates)
(cons (append disabled-and-gates disabled-other-gates)
zero-wires)))))
(defun shorted-gates (zero-wires gates)
(let* ((or-gates (--filter (not (equal (cadr it) 'AND)) gates))
(shorted-gates (--filter (eq 1 (length (-intersection (car it) zero-wires))) or-gates)))
(--map (cons (car (-difference (car it) (-intersection (car it) zero-wires))) (caddr it)) shorted-gates)))
(defun short-output (entry gates)
;; removes the only gate that has cdr as an output
(let* ((to-remove (cdr entry))
(to-replace (car entry))
(gate1 (--first (equal to-replace (caddr it)) gates))
(gate2 (--first (equal to-remove (caddr it)) gates))
(new-gate1 (list (car gate1) (cadr gate1) to-remove))
)
(append (list new-gate1)
(-remove-item gate1
(-remove-item gate2 gates)))))
(defun swap-output (entry gates)
;; swap the outputs of the gates
(let* ((to (cdr entry))
(from (car entry))
(gate1 (--first (equal to (caddr it)) gates))
(gate2 (--first (equal from (caddr it)) gates))
(new-gate1 (list (car gate1) (cadr gate1) from))
(new-gate2 (list (car gate2) (cadr gate2) to))
)
(append (list new-gate1 new-gate2)
(-remove-item gate1
(-remove-item gate2 gates)))))
(defun short-outputs (shorted-gates)
(--each shorted-gates (setq gates (short-output it gates))))
(defun prune-gates (zeroed)
(let* ((disabled (disabled-gates zeroed gates))
(disd-gates (car disabled))
(zero-wires (cdr disabled)))
(short-outputs
(shorted-gates zero-wires gates))
(setq gates (-difference gates disd-gates))))
#+end_src
#+RESULTS:
: prune-gates
#+begin_src emacs-lisp
(prune-gates (append (-drop 2 used-xxx)
(-drop 2 used-yyy)))
#+end_src
#+RESULTS:
| (fqg wkq) | OR | z02 |
| (x00 y00) | XOR | z00 |
| (x01 y01) | XOR | kjs |
| (x01 y01) | AND | fqg |
| (kjs hjp) | AND | wkq |
| (hjp kjs) | XOR | z01 |
| (y00 x00) | AND | hjp |
#+begin_src emacs-lisp
(setq depth 0)
; we check bit by bit
(while (lsb-works)
(message (format "%d" depth))
;; supposedly the DEPTH bit is ok; remove all gates that output to it
(prune-gates (list (nth depth used-xxx)
(nth depth used-yyy)))
(update-function gates)
(setq depth (1+ depth)))
;; when I get here it is possible that either the depth-th or the
;; depth+1-th output bit is wrong
(defun wrong-bit ()
(if (and
(eq 1 (run-function 0 1))
(eq 1 (run-function 1 0)))
(nth (1+ depth) used-zzz)
(nth depth used-zzz)))
(defun tentative-substitutions ()
(let ((gates-need-fixing (gates-outputting-on (wrong-bit)))
(gates gates))
;; Now we bruteforce; which ones are the gates that are involved in
;; the errorm
(prune-gates (append (-drop (1+ depth) used-xxx)
(-drop (1+ depth) used-yyy)))
(jsueje)
(let ((wires-a (-map #'caddr gates-need-fixing))
(wires-b (-map #'caddr gates)))
(-mapcat (lambda (wire-a) (--map (cons wire-a it) wires-b)) wires-a))))
(defun lsb-works ()
(and (run-function 0 0)
(eq 1 (run-function 0 1))
(eq 1 (run-function 1 0))
(eq 2 (run-function 1 1))))
;; oh, it may end in a loop in fact. So I need to take care of this
;; possibility too
(--filter (progn
(update-function (swap-output it gates))
(lsb-works))
(tentative-substitutions))
(let ((gates (swap-output '(z11 . wpd) gates)))
(tentative-substitutions))
(run-function 1 1)
;; try and fix
(defun create-swaps (li)
(when li
(append (--map (cons (car li) it) (cdr li))
(create-swaps (cdr li)))))
( length gates)
(setq swappers
(let ((gates gates))
(prune-gates (append (-drop 10 used-xxx)
(-drop 10 used-yyy)))
(create-swaps (-map #'caddr gates))))
(length swappers)
(setq working-swappers
(--filter (progn
(message (symbol-name (car it)))
(update-function (swap-output it gates))
(run-function 0 0))
swappers))
(length working-swappers)
(setq plausible-swappers
(--filter (progn
(message (symbol-name (car it)))
(update-function (swap-output it gates))
(eq 2048 (run-function 1024 1024)))
working-swappers))
(setq depth 0)
(run-function 1024 1024)
(length plausible-swappers)
#+end_src
** old stuff
What follows is old stuff.
OK, now we try bit by bit and see if it adds up correctly.
If we do, we can in principle prune out the gates that work.
The problem is that if I prune the gates, some outputs will never
change, so I need to change my logic in the prior loop
Find all gates that connect to a given output and that emanate to a
given input
#+begin_src emacs-lisp
(defun gates-outputting-on (wire)
(let ((good-wires (list wire))
(old-wires nil))
(while (not (equal old-wires good-wires))
(setq involved-gates (--filter (-contains? good-wires (caddr it)) gates)
old-wires good-wires
good-wires (-distinct (append good-wires
(-mapcat #'car involved-gates)))))
involved-gates))
(defun gates-inputting-from (wire)
(let ((good-wires (list wire))
(old-wires nil))
(while (not (equal old-wires good-wires))
(setq involved-gates (--filter (-intersection good-wires (car it)) gates)
old-wires good-wires
good-wires (-distinct (append good-wires
(-mapcat #'car involved-gates)
(-map #'caddr involved-gates)))))
involved-gates))
(defun remove-gates (li)
(--remove (-contains? li it) gates))
#+end_src
#+RESULTS:
: remove-gates
#+begin_src emacs-lisp
(defun disabled-gates (zero-wires gates)
(let ((and-gates (--filter (equal (cadr it) 'AND) gates))
(or-gates (--filter (equal (cadr it) 'OR) gates))
(xor-gates (--filter (equal (cadr it) 'XOR) gates)))
;; disable and gates first; a gate is disabled if either of its
;; input is a zero wire
(setq disabled-and-gates (--filter (-intersection (car it) zero-wires) and-gates)
disabled-or-gates (--filter (eq 2 (length (-intersection (car it) zero-wires ))) or-gates)
disabled-xor-gates (--filter (eq 2 (length (-intersection (car it) zero-wires ))) xor-gates)))
(let ((new-zero-wires
(-distinct (append zero-wires
(-map #'caddr (append disabled-and-gates disabled-or-gates disabled-xor-gates)))) ))
(if (> (length new-zero-wires) (length zero-wires))
(disabled-gates new-zero-wires gates)
(append disabled-and-gates disabled-or-gates disabled-xor-gates)
)))
(defun shorted-gates (zero-wires gates)
(let ((or-gates (--filter (not (equal (cadr it) 'AND)) gates)))
;; shorted
(setq shorted-or-gates (--filter (eq 1 (length (-intersection (car it) zero-wires ))) or-gates))
))
(disabled-gates '(x00 y00) gates)
(shorted-gates '(x00 y00 hjp wkq) gates)
(-map #'caddr gates)
(length gates)
(length wires)
(length used-xxx)
#+end_src
#+RESULTS:
| 1 | 2 | 4 | 8 | 16 | 32 | 64 | 128 | 256 | 512 | 1024 | 4096 | 4096 | 8192 | 16384 | 65536 | 65536 | 131072 | 262144 | 1048576 | 1048576 | 2097152 | 4194304 | 8388608 | 16777216 | 33554432 | 67108864 | 134217728 | 268435456 | 536870912 | 1073741824 | 2147483648 | 4294967296 | 8589934592 | 17179869184 | 34359738368 | 68719476736 | 274877906944 | 274877906944 | 549755813888 | 1099511627776 | 2199023255552 | 4398046511104 | 8796093022208 | 17592186044416 |
#+begin_src emacs-lisp
(setq zzz (--map (intern (format "z%02d" it)) (-iterate #'1+ 0 100)))
(-each zzz #'unintern)
(-each used-xxx #'unintern)
(-each used-yyy #'unintern)
#+end_src
Mmh, this is perplexing. Aha, maybe I can trace back the dependencies…
#+begin_src emacs-lisp
(defun deps (a)
(if (string-match-p "^[xy].*" (symbol-name a)) (list a)
(-map #'cdr (--filter (eq (car it) a) dependencies))))
(defun grow-deps (li)
(-distinct (-mapcat #'deps li)))
(defun iterate-until-stabilizes (fn li)
(let ((it (funcall fn li)))
(if (equal it li) li
(iterate-until-stabilizes fn it))))
(-sort #'symbol< (iterate-until-stabilizes #'grow-deps (deps 'z15)))
#+end_src
#+RESULTS:
| x00 | x01 | x02 | x03 | x04 | x05 | x06 | x07 | x08 | x09 | x10 | x11 | x12 | y00 | y01 | y02 | y03 | y04 | y05 | y06 | y07 | y08 | y09 | y10 | y11 | y12 |