aboutsummaryrefslogtreecommitdiff
path: root/day24.scm
blob: 52eb1672d05b9f94661f70d5832a72effb71c237 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
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<?) ","))