Day 24

1 files changed, 159 insertions, 0 deletions

diff --git a/day24.scm b/day24.scm
new file mode 100644
index 0000000..52eb167
--- /dev/null
+++ b/day24.scm
@@ -0,0 +1,159 @@
+(define-module (day24)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-69))
+
+(define +bit-regex+ (make-regexp "^([a-z0-9]+): ([01])$"))
+(define +gate-regex+
+  (make-regexp "^([a-z0-9]+) (AND|OR|XOR) ([a-z0-9]+) -> ([a-z0-9]+)$"))
+
+(define (match-values mtch)
+  (define (iter i acc)
+    (if (zero? i)
+        acc
+        (iter (- i 1) (cons (match:substring mtch i) acc))))
+  (apply values (iter (- (match:count mtch) 1) '())))
+
+(define (do-lines proc port)
+  (define line (read-line port))
+  (unless (or (eof-object? line) (string=? "" line))
+    (proc line)
+    (do-lines proc port)))
+
+(define-record-type <gate> (make-gate type in1 in2) gate?
+                    (type gate-type)
+                    (in1 gate-in1)
+                    (in2 gate-in2))
+
+(set-record-type-printer!
+ <gate> (lambda (obj port)
+          (format port "#<gate ~a ~a ~a>"
+                  (gate-in1 obj) (gate-type obj) (gate-in2 obj))))
+
+(define* (read-circuit #:optional (port (current-input-port)))
+  (define result (make-hash-table))
+  (do-lines
+   (lambda (line)
+     (define mtch (regexp-exec +bit-regex+ line))
+     (unless mtch (error "Expected 'cable: 0|1'." line))
+     (define-values (name bit) (match-values mtch))
+     (when (hash-table-exists? result name)
+       (error "Cable is given a value twice." name))
+     (hash-table-set! result name (string=? "1" bit)))
+   port)
+  (do-lines
+   (lambda (line)
+     (define mtch (regexp-exec +gate-regex+ line))
+     (unless mtch (error "Expected 'cable AND|OR|XOR cable -> cable"))
+     (define-values (in1 gate in2 out) (match-values mtch))
+     (when (hash-table-exists? result '())
+       (error "Cable is given a value twice." out))
+     (hash-table-set! result out (make-gate (string->symbol gate) in1 in2)))
+   port)
+  result)
+
+(define (circuit-eval circuit cable)
+  (define val (hash-table-ref circuit cable))
+  (if (boolean? val)
+      val
+      (let ((g1 (gate-in1 val)) (g2 (gate-in2 val)))
+        (case (gate-type val)
+          ((AND) (and (circuit-eval circuit g1) (circuit-eval circuit g2)))
+          ((OR) (or (circuit-eval circuit g1) (circuit-eval circuit g2)))
+          ((XOR) (not (eq? (circuit-eval circuit g1)
+                           (circuit-eval circuit g2))))))))
+
+(define (circuit-number circuit)
+  (let iter ((num 0) (b 0))
+    (define cable (format #f "z~2,'0d" b))
+    (if (hash-table-exists? circuit cable)
+        (iter (if (circuit-eval circuit cable) (+ num (expt 2 b)) num)
+              (+ b 1))
+        num)))
+
+(define* (part1 #:optional (port (current-input-port)))
+  (circuit-number (read-circuit port)))
+
+;;; Best viewed with `dot`
+(define* (write-circuit-graph circuit #:optional (port (current-output-port)))
+  (define (write-node name val)
+    (if (boolean? val)
+        (format port "\t~a[shape=point,xlabel=~a]\n" name name)
+        (format port "\t~a[shape=rectangle,label=\"~a\",xlabel=~a]\n"
+                name
+                (case (gate-type val) ((AND) "&") ((OR) ">=1") ((XOR) "=1"))
+                name)))
+  (define (write-arrows name val)
+    (when (gate? val)
+      (format port "\t~a -> ~a\n\t~a -> ~a\n"
+              (gate-in1 val) name (gate-in2 val) name)))
+  (display "digraph G {\nrankdir=LR\n" port)
+  (hash-table-walk circuit write-node)
+  (newline port)
+  (hash-table-walk circuit write-arrows)
+  (display "}\n" port))
+
+(define* (swap! circuit n1 n2)
+  (define v1 (hash-table-ref circuit n1))
+  (define v2 (hash-table-ref circuit n2))
+  (hash-table-set! circuit n1 v2)
+  (hash-table-set! circuit n2 v1))
+
+(define* (set-inputs! circuit in1 in2)
+  (let iter ((in1 in1) (in2 in2) (i 0))
+    (define w1 (format #f "x~2,'0d" i))
+    (define w2 (format #f "y~2,'0d" i))
+    (unless (eq? (hash-table-exists? circuit w1)
+                 (hash-table-exists? circuit w2))
+      (error "One of the wires exists and the other doesn't." w1 w2))
+    (when (hash-table-exists? circuit w1)
+      (hash-table-set! circuit w1 (odd? in1))
+      (hash-table-set! circuit w2 (odd? in2))
+      (iter (quotient in1 2) (quotient in2 2) (+ i 1)))))
+
+(define (test-input circuit)
+  (define rand1 (random (expt 2 45)))
+  (define rand2 (random (expt 2 45)))
+  (set-inputs! circuit rand1 rand2)
+  (define result (circuit-number circuit))
+  (define expected (+ rand1 rand2))
+  (define ok? (= result expected))
+  (unless ok?
+    (format (current-error-port)
+            "Input 1:  ~46b\nInput 2:  ~46b\nExpected: ~46b\nActual:   ~46b\n"
+            rand1 rand2 expected result)
+    (let* ((diff (- result expected))
+           (first-bit (- (integer-length (logand diff (- diff))) 1)))
+      (format (current-error-port) "First difference in bit ~a.\n" first-bit)))
+  ok?)
+
+(define (random-test circuit trials)
+  (or (zero? trials)
+      (and (test-input circuit) (random-test circuit (- trials 1)))))
+
+;;; Workflow is:
+;;; 1. Use write-circuit-graph to generate a graph, then `dot` to display it.
+;;; 2. Run part 2 to find the first bit that fails.
+;;; 3. Inspect that part of the graph and add the two swapped gates to +swaps+.
+;;; 4. Go back to step 2.
+;;; After we collected the 4 pairs, part 2 should work ok!
+(define +swaps+ '("z16" "hmk" "z20" "fhp" "rvf" "tpc" "fcd" "z33"))
+
+(define (part2 port)
+  ;; Only works with my input
+  ;; z16 <--> hmk
+  ;; z20 <--> fhp
+  ;; tpc <--> rvf
+  ;; z33 <--> fcd
+  (define circuit (read-circuit port))
+  (let swap ((poss +swaps+))
+    (unless (null? poss)
+      (swap! circuit (car poss) (cadr poss))
+      (swap (cddr poss))))
+  (random-test circuit 1000)
+  (string-join (sort +swaps+ string<?) ","))
+
+