Day seven

7.rkt

@@ -0,0 +1,148 @@
+#lang racket
+
+(require racket/async-channel)
+
+;; First some helpers
+
+(define (op-mode opcode idx)
+  (match (modulo (floor (/ opcode (expt 10 (+ idx 2)))) 10)
+    [0 'pos]
+    [1 'imm]
+    [_ (error "invalid mode")]))
+
+(define (op-op opcode)
+  (modulo opcode 100))
+
+(define (tape-ref/mode tape pos mode)
+  (match mode
+    ['pos (list-ref tape (list-ref tape pos))]
+    ['imm (list-ref tape pos)]
+    [_ (error "invalid mode")]))
+
+;; Generic abstracted opcode interpreter function
+;; Calls handler for opcode-specific handling, which should call callback to continue or return to
+;; exit.
+(define (intcode-handle-opcode callback spec handler tape pos)
+  (let* ([opcode (list-ref tape pos)]
+         [args (for/list ([spec-item spec] [idx (in-range (length spec))])
+                (tape-ref/mode tape (+ pos idx 1)
+                               (match spec-item
+                                 ['in (op-mode opcode idx)]
+                                 ['out 'imm])))])
+    (apply handler callback tape (+ pos (length spec) 1) args)))
+
+;; Create a system to register intcode ops
+(struct intcode-op [code spec handler])
+(define opcode-table (make-hash))
+
+;; Evil mutation incoming!!!!
+(define (intcode-register code spec handler)
+  (hash-set! opcode-table code (intcode-op code spec handler)))
+
+;; Main eval function
+(define (intcode-eval tape [pos 0])
+  (let* ([opcode (list-ref tape pos)]
+         [handler-entry (hash-ref opcode-table (op-op opcode))])
+    (intcode-handle-opcode intcode-eval
+                           (intcode-op-spec handler-entry)
+                           (intcode-op-handler handler-entry)
+                           tape pos)))
+
+;; Now it's time to define all the operations we can do
+
+;; Binary operations!!!
+(define spec-binop '(in in out))
+(define ((intcode-generic-binop op) cb tape pos lhs rhs dst)
+    (cb (list-set tape dst (op lhs rhs)) pos))
+
+(intcode-register 1 spec-binop (intcode-generic-binop +))
+(intcode-register 2 spec-binop (intcode-generic-binop *))
+(define (bool->number b) (if b 1 0))
+(intcode-register 7 spec-binop (intcode-generic-binop (compose bool->number <)))
+(intcode-register 8 spec-binop (intcode-generic-binop (compose bool->number =)))
+
+;; I/O time
+(define current-input-channel (make-parameter (make-async-channel)))
+(define current-output-channel (make-parameter (make-async-channel)))
+(define instance (make-parameter '()))
+(define (instance-log what)
+  (if (empty? (instance)) (void) (displayln (format "~a ~a" (instance) what))))
+(define (intcode-input cb tape pos dst)
+  (define inp (async-channel-get (current-input-channel)))
+  (instance-log (list "input" inp))
+  (cb (list-set tape dst inp) pos))
+(intcode-register 3 '(out) intcode-input)
+
+(define (intcode-output cb tape pos src)
+  (instance-log (list "output" src))
+  (async-channel-put (current-output-channel) src)
+  (cb tape pos))
+(intcode-register 4 '(in) intcode-output)
+
+;; Jumps
+(define ((intcode-generic-jump which) cb tape pos arg dst)
+  (cb tape (if (which arg) dst pos)))
+(intcode-register 5 '(in in) (intcode-generic-jump (compose not zero?)))
+(intcode-register 6 '(in in) (intcode-generic-jump zero?))
+
+;; Exit
+(define (intcode-exit cb tape pos)
+  (instance-log "exit")
+  (void))
+(intcode-register 99 '() intcode-exit)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (parse-input input)
+  (map string->number (string-split (string-trim input) ",")))
+
+(define input (parse-input (file->string "input.7.txt")))
+
+(define (intcode-eval-layer tape phase signal)
+  (parameterize ([current-input-channel (make-async-channel)]
+                 [current-output-channel (make-async-channel)])
+    (begin
+      (async-channel-put (current-input-channel) phase)
+      (async-channel-put (current-input-channel) signal)
+      (intcode-eval tape)
+      (async-channel-get (current-output-channel)))))
+
+(define initial-signal 0)
+
+(define (intcode-eval-layers tape phases)
+  (foldl (lambda (phase signal)
+           (intcode-eval-layer tape phase signal))
+         initial-signal
+         phases))
+
+;; Part 1
+(apply max
+ (map (lambda (phases)
+        (intcode-eval-layers input phases))
+      (permutations (range 0 5))))
+    
+(define (list-rotate lst)
+  (cond
+    [(empty? list) '()]
+    [else `(,@(rest lst) ,(first lst))]))
+
+(define (intcode-eval-layers/threaded tape phases first-signal)
+  (define channels (for/list ([_ phases]) (make-async-channel)))
+  (map (lambda (chan phase) (async-channel-put chan phase)) channels phases)
+  (define threads
+    (for/list ([chan-in channels]
+               [chan-out (list-rotate channels)]
+               [i (in-range (length channels))])
+      (parameterize ([current-input-channel chan-in]
+                     [current-output-channel chan-out]
+                     #|[instance i]|#)
+        (thread (lambda () (intcode-eval tape))))))
+  (async-channel-put (first channels) first-signal)
+  (map thread-wait threads)
+  (async-channel-get (first channels)))
+
+;; Part 2
+(apply max
+ (map (lambda (phases)
+        (intcode-eval-layers/threaded input phases initial-signal))
+      (permutations (range 5 10))))