You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.
aoc-racket/2019/23.rkt

122 lines
5.5 KiB
Racket

5 years ago
#lang br
(require racket/file rackunit racket/async-channel)
(define (string->ints str) (map string->number (string-split str #px",\\s*")))
(define (string->regs str) (list->vector (string->ints str)))
(define ((binarize proc) x y) (if (proc x y) 1 0))
(define (make-runner program inch ouch)
(thread (λ ()
(define regs (string->regs (file->string program)))
(define (maybe-enlarge-regs ptr)
(unless (< ptr (vector-length regs))
(define newvec (make-vector (add1 ptr) 0))
(vector-copy! newvec 0 regs)
(set! regs newvec))
regs)
(define (reg-ref ptr) (vector-ref (maybe-enlarge-regs ptr) ptr))
(define (reg-set! ptr val) (vector-set! (maybe-enlarge-regs ptr) ptr val))
(define relative-base 0)
(define address #false)
(let/ec terminate
(let loop ([ptr 0])
(define inst (for/list ([c (in-string (~r (reg-ref ptr) #:min-width 5 #:pad-string "0"))])
(string->number (string c))))
(define-values (opcode resolve)
(match inst
[(list d4 d3 d2 d1 d0)
(values (+ (* 10 d1) d0)
(λ (ptr offset)
(define parameter-value (match offset [1 d2] [2 d3] [3 d4]))
(define ptr-resolver (match parameter-value
[0 reg-ref] ; position
[1 values] ; immediate
[2 (compose1 (λ (ptr) (+ relative-base ptr)) reg-ref)])); relative
(ptr-resolver (+ ptr offset))))]))
(define next-ptr
(match opcode
[(or 1 2 7 8) ; 4-arity: add & multiply & compare
(reg-set! (resolve ptr 3) ((match opcode
[1 +]
[2 *]
[7 (binarize <)]
[8 (binarize =)]) (reg-ref (resolve ptr 1)) (reg-ref (resolve ptr 2))))
(+ ptr 4)]
[(or 3 4 9) ; 2-arity: input & output
(match opcode
[3 (async-channel-put ouch 'wants-input)
(define val (async-channel-get inch))
(unless address (set! address val))
(reg-set! (resolve ptr 1) val)]
[4 (async-channel-put ouch (reg-ref (resolve ptr 1)))]
[9 (set! relative-base (+ relative-base (reg-ref (resolve ptr 1))))])
(+ ptr 2)]
[(or 5 6) ; 3-arity: jump
(if ((match opcode
[5 not]
[6 values]) (zero? (reg-ref (resolve ptr 1))))
(reg-ref (resolve ptr 2))
(+ ptr 3))]
[99 (terminate)]
[_ (error "unknown opcode" opcode)]))
(loop next-ptr))))))
(define packet-address first)
(define packet-x second)
(define packet-y third)
(define (solve break-cond)
(define nics (for/list ([i (in-range 50)])
(define inch (make-async-channel))
(define ouch (make-async-channel))
(define th (make-runner "23.rktd" inch ouch))
(async-channel-get ouch)
(async-channel-put inch i)
(list inch ouch i)))
5 years ago
(define idle-nics (make-hasheq))
5 years ago
(for/fold ([packets null]
[nat #false]
5 years ago
[idle-packets null]
5 years ago
#:result (packet-y nat))
([nicrec (in-cycle nics)]
5 years ago
#:break (break-cond nat idle-packets))
(define (network-idle?) (and (null? packets)
(= 50 (length (hash-values idle-nics)))
(for/and ([val (in-hash-values idle-nics)])
(> val 10))))
5 years ago
(cond
[(network-idle?)
(match-define (list inch _ _) (car nics))
(async-channel-put inch (packet-x nat))
(async-channel-put inch (packet-y nat))
5 years ago
(set! idle-nics (make-hasheq))
(values packets nat (cons nat idle-packets))]
5 years ago
[else
(match-define (list inch ouch nic-address) nicrec)
(match (async-channel-get ouch)
['wants-input
(define-values (ps other-ps) (partition (λ (p) (= nic-address (packet-address p))) packets))
(match (reverse ps)
[(? null?) (async-channel-put inch -1)]
[ps (for ([p (in-list ps)])
(match-define (list _ x y) p)
(async-channel-put inch x)
(async-channel-put inch y))])
5 years ago
(hash-update! idle-nics nic-address add1 0)
(values other-ps nat idle-packets)]
5 years ago
[dest
5 years ago
(hash-set! idle-nics nic-address 0)
5 years ago
(define next-packet (list dest (async-channel-get ouch) (async-channel-get ouch)))
(if (eq? dest 255)
5 years ago
(values packets next-packet idle-packets)
(values (cons next-packet packets) nat idle-packets))])])))
5 years ago
;; 1
(check-eq? (solve (λ (nat idle-vals) nat)) 21089)
5 years ago
;; 2
(solve (λ (nat idle-packets)
(match idle-packets
[(list* (list _ _ y) (list _ _ y) _) y]
[_ #false])))