From ac0cceb09ac730242aa695642b60f685eb39c774 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 11 Dec 2019 06:53:40 -0800 Subject: [PATCH] d11 --- 2019/11.rkt | 102 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2019/11.rktd | 1 + 2 files changed, 103 insertions(+) create mode 100644 2019/11.rkt create mode 100644 2019/11.rktd diff --git a/2019/11.rkt b/2019/11.rkt new file mode 100644 index 0000000..aabdfdc --- /dev/null +++ b/2019/11.rkt @@ -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) + + diff --git a/2019/11.rktd b/2019/11.rktd new file mode 100644 index 0000000..610b2d1 --- /dev/null +++ b/2019/11.rktd @@ -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 \ No newline at end of file