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

20 KiB
Raw Permalink Blame History

Solution to p24

This is particularly tricky I find

  (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))))

Create an actual lisp function from the gate list

  (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)

According to the following check, the code is symmetric in x and y

  (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)
t

Create a list of all x, y and z bits

  (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))

Now we rename the wires in some more meaningful way First create a bunch of aux labels for the wires

  (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)))

Then we begin by renaming the input layer XOR gates and the AND gates

  (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)
(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


  (--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)
    (gates-outputting-on 'z11)
(--filter (eq (cadr it) 'XOR) gates)
(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

  ;; 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)))

Let us try to reduce the problem; there are two classes of wires

  • input wires
  • output wires
  (setq output-wires (-map #'caddr gates)
        input-wires (-difference wires output-wires))

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

  (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))))
prune-gates

  (prune-gates (append (-drop 2 used-xxx)
  		     (-drop 2 used-yyy)))
(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 
    (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)

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

  (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))
remove-gates

  (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)
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 
(setq zzz (--map (intern (format "z%02d" it)) (-iterate #'1+ 0 100)))
  (-each zzz #'unintern)
  (-each used-xxx #'unintern)
  (-each used-yyy #'unintern)

Mmh, this is perplexing. Aha, maybe I can trace back the dependencies…

  (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)))
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