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.
86 Commits
1 Branch
0 Tags
1.2 MiB
 
Tag: Branch: Tree: 72b809316f
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '72b809316f'
${ noResults }
advent-2024/p24/p24.org

13 KiB
Raw 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)

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

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

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