mbutterick
/
aoc-racket
Archived
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

d11

Browse Source
master
Matthew Butterick 4 years ago
parent 4484aa863a
commit ac0cceb09a
2 changed files with 103 additions and 0 deletions
Show Stats Download Patch File Download Diff File

102
2019/11.rkt
Unescape Escape View File

@ -0,0 +1,102 @@
#lang br
(require racket/file rackunit)
(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 [calling-thd (current-thread)])
(thread (λ ()
(define regs (string->regs 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)
(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 (reg-set! (resolve ptr 1) (thread-receive))]
[4 (thread-send calling-thd (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 (thread-send calling-thd 'done) (terminate)]
[_ (error "unknown opcode" opcode)]))
(loop next-ptr))))))
(define black 0)
(define white 1)
(define left +i)
(define right -i)
(define (paint-panels #:start initial-color)
(define robot-program (make-runner (file->string "11.rktd")))
(define panels (make-hasheqv))
(let loop ([pos 0][dir +i])
(when (thread-running? robot-program)
(thread-send robot-program (hash-ref panels pos initial-color)))
(match (thread-receive)
['done panels]
[new-color
(hash-set! panels pos new-color)
(define turn (match (thread-receive) [0 left] [1 right]))
(define new-dir (* turn dir))
(define new-pos (+ pos new-dir))
(loop new-pos new-dir)])))
;; 1
(check-eq? (length (hash-keys (paint-panels #:start black))) 2478)
;; 2
(define white-panels (for/list ([(loc color) (in-hash (paint-panels #:start white))]
#:when (eqv? color white))
loc))
(define rows (sort (group-by imag-part white-panels) > #:key (compose1 imag-part car)))
(define (make-printable row)
(define real-parts (map real-part row))
(string-join (for/list ([i (in-range (add1 (apply max real-parts)))])
(if (memq i real-parts) "X" " ")) ""))
;; 2
(define painted-rows (map make-printable rows))
(check-equal? painted-rows
'(" X X XX XXXX XXX X X XX XX XXXX" " X X X X X X X X X X X X X X" " XXXX X X X X X X X X X X" " X X X X XXX X X X XX XXXX X" " X X X X X X X X X X X X X X" " X X XX XXXX X X XX XXX X X XXXX"))
(for-each displayln painted-rows)

1
2019/11.rktd
Unescape Escape View File

@ -0,0 +1 @@
3,8,1005,8,324,1106,0,11,0,0,0,104,1,104,0,3,8,1002,8,-1,10,1001,10,1,10,4,10,1008,8,0,10,4,10,1001,8,0,29,3,8,1002,8,-1,10,101,1,10,10,4,10,108,0,8,10,4,10,101,0,8,50,1,1106,9,10,1,102,15,10,2,1003,3,10,1,3,19,10,3,8,102,-1,8,10,101,1,10,10,4,10,1008,8,0,10,4,10,1001,8,0,89,1,1105,9,10,2,1103,1,10,3,8,102,-1,8,10,101,1,10,10,4,10,1008,8,1,10,4,10,1001,8,0,119,1006,0,26,1,109,7,10,3,8,1002,8,-1,10,1001,10,1,10,4,10,108,1,8,10,4,10,1002,8,1,147,1006,0,75,1,1005,17,10,3,8,102,-1,8,10,101,1,10,10,4,10,108,0,8,10,4,10,102,1,8,176,3,8,102,-1,8,10,1001,10,1,10,4,10,1008,8,1,10,4,10,102,1,8,199,3,8,102,-1,8,10,1001,10,1,10,4,10,108,1,8,10,4,10,102,1,8,220,2,103,10,10,1,1,0,10,1,102,17,10,3,8,1002,8,-1,10,101,1,10,10,4,10,108,1,8,10,4,10,101,0,8,254,2,1001,10,10,1006,0,12,1,3,6,10,3,8,102,-1,8,10,101,1,10,10,4,10,1008,8,0,10,4,10,102,1,8,288,2,1106,9,10,2,1009,6,10,2,1101,18,10,2,103,8,10,101,1,9,9,1007,9,1045,10,1005,10,15,99,109,646,104,0,104,1,21101,838211318676,0,1,21102,341,1,0,1106,0,445,21101,0,838211051932,1,21101,0,352,0,1106,0,445,3,10,104,0,104,1,3,10,104,0,104,0,3,10,104,0,104,1,3,10,104,0,104,1,3,10,104,0,104,0,3,10,104,0,104,1,21101,0,21704576195,1,21101,0,399,0,1106,0,445,21101,0,179356830951,1,21101,410,0,0,1105,1,445,3,10,104,0,104,0,3,10,104,0,104,0,21102,837897052948,1,1,21102,1,433,0,1106,0,445,21102,709052085092,1,1,21102,1,444,0,1105,1,445,99,109,2,21201,-1,0,1,21101,0,40,2,21102,476,1,3,21102,466,1,0,1105,1,509,109,-2,2105,1,0,0,1,0,0,1,109,2,3,10,204,-1,1001,471,472,487,4,0,1001,471,1,471,108,4,471,10,1006,10,503,1102,1,0,471,109,-2,2106,0,0,0,109,4,2102,1,-1,508,1207,-3,0,10,1006,10,526,21101,0,0,-3,21201,-3,0,1,21201,-2,0,2,21101,0,1,3,21101,545,0,0,1105,1,550,109,-4,2105,1,0,109,5,1207,-3,1,10,1006,10,573,2207,-4,-2,10,1006,10,573,21201,-4,0,-4,1105,1,641,22102,1,-4,1,21201,-3,-1,2,21202,-2,2,3,21101,592,0,0,1105,1,550,21201,1,0,-4,21102,1,1,-1,2207,-4,-2,10,1006,10,611,21101,0,0,-1,22202,-2,-1,-2,2107,0,-3,10,1006,10,633,21202,-1,1,1,21101,633,0,0,106,0,508,21202,-2,-1,-2,22201,-4,-2,-4,109,-5,2105,1,0