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

This file contains invisible Unicode characters!

This file contains invisible Unicode characters that may be processed differently from what appears below. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to reveal hidden characters.

#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)))
(define idle-nics (make-hasheq))
(for/fold ([packets null]
[nat #false]
[idle-packets null]
#:result (packet-y nat))
([nicrec (in-cycle nics)]
#: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))))
(cond
[(network-idle?)
(match-define (list inch _ _) (car nics))
(async-channel-put inch (packet-x nat))
(async-channel-put inch (packet-y nat))
(set! idle-nics (make-hasheq))
(values packets nat (cons nat idle-packets))]
[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))])
(hash-update! idle-nics nic-address add1 0)
(values other-ps nat idle-packets)]
[dest
(hash-set! idle-nics nic-address 0)
(define next-packet (list dest (async-channel-get ouch) (async-channel-get ouch)))
(if (eq? dest 255)
(values packets next-packet idle-packets)
(values (cons next-packet packets) nat idle-packets))])])))
;; 1
(check-eq? (solve (λ (nat idle-vals) nat)) 21089)
;; 2
(solve (λ (nat idle-packets)
(match idle-packets
[(list* (list _ _ y) (list _ _ y) _) y]
[_ #false])))