diff --git a/11.rkt b/11.rkt new file mode 100644 index 0000000..b08c30c --- /dev/null +++ b/11.rkt @@ -0,0 +1,204 @@ +#lang racket + +(require racket/async-channel) +(require struct-update) + +;; First some helpers + +(define (op-mode opcode idx) + (match (modulo (floor (/ opcode (expt 10 (+ idx 2)))) 10) + [0 'pos] + [1 'imm] + [2 'rel] + [_ (error "invalid mode")])) + +(define (op-op opcode) + (modulo opcode 100)) + +(define (tape-expand tape len) + (cond [(> len (length tape)) (append tape (for/list ([i (in-range (- len (length tape)))]) 0))] + [else tape])) + +(define (tape-ref tape pos) + (define new-tape (tape-expand tape (add1 pos))) + (list-ref new-tape pos)) + +(define (tape-ref/mode tape pos mode) + (match mode + ['pos (tape-ref tape (tape-ref tape pos))] + ['imm (tape-ref tape pos)] + ['rel (tape-ref tape (+ (intcode-rel-base) (tape-ref tape pos)))] + [_ (error "invalid mode")])) + +(define (tape-set tape where what) + (define new-tape (tape-expand tape (add1 where))) + (list-set new-tape where what)) + +(define (tape-set/mode tape where what mode) + (match mode + ['pos (tape-set tape (tape-ref tape where) what)] + ['rel (tape-set tape (+ (intcode-rel-base) (tape-ref tape where)) what)] + [_ (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))]) + (match spec-item + ['in (tape-ref/mode tape (+ pos idx 1) (op-mode opcode idx))] + ['out + (lambda (what) + (tape-set/mode tape (+ pos idx 1) what (op-mode opcode idx)))]))]) + (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 (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 (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?)) + +;; Relative base +(define intcode-rel-base (make-parameter 0)) +(define (intcode-set-rel-base cb tape pos arg) + (define new-base (+ (intcode-rel-base) arg)) + (instance-log (list "rel base" (intcode-rel-base) "+" arg "=" new-base)) + (parameterize ([intcode-rel-base new-base]) + (cb tape pos))) +(intcode-register 9 '(in) intcode-set-rel-base) + +;; 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.11.txt"))) + +(define (get-all chan) + (let ([val (async-channel-try-get chan)]) + (if (equal? val #f) (void) + (begin (displayln val) (get-all chan))))) +(get-all (current-output-channel)) + +(struct pos [x y] #:transparent) +(define-struct-updaters pos) + +(define main-thread (current-thread)) + +(define (robot-io [hull (make-immutable-hash)] [loc (pos 0 0)] [dir 0]) + (define (get-color) + (hash-ref hull loc 0)) + (define (set-color color) + (hash-set hull loc color)) + (define (change-dir instr) + (modulo (+ dir (match instr [0 -1] [1 1])) 4)) + (define (move new-dir) + (match new-dir + [0 (pos-y-update loc add1)] + [1 (pos-x-update loc add1)] + [2 (pos-y-update loc sub1)] + [3 (pos-x-update loc sub1)])) + (async-channel-put (current-input-channel) (get-color)) + (define next-color (async-channel-get (current-output-channel))) + (cond [(equal? next-color 'eof) (thread-send main-thread hull)] + [else (begin + (define next-dir-change (async-channel-get (current-output-channel))) + (define next-dir (change-dir next-dir-change)) + (robot-io (set-color next-color) (move next-dir) next-dir))])) + +(define io-thread-part1 (thread robot-io)) +(intcode-eval input) +(async-channel-put (current-output-channel) 'eof) +(define part1-hull (thread-receive)) +(hash-count part1-hull) +; clear the last camera input +(void (async-channel-get (current-input-channel))) +(if (false? (async-channel-try-get (current-input-channel))) + (void) (error "input channel not empty")) +(if (false? (async-channel-try-get (current-output-channel))) + (void) (error "output channel not empty")) + +(define io-thread-part2 (thread (lambda () + (robot-io (hash-set (make-immutable-hash) (pos 0 0) 1))))) +(intcode-eval input) +(async-channel-put (current-output-channel) 'eof) +(define part2-hull (thread-receive)) + +(define min-x (apply min (map pos-x (hash-keys part2-hull)))) +(define min-y (apply min (map pos-y (hash-keys part2-hull)))) +(define max-x (apply max (map pos-x (hash-keys part2-hull)))) +(define max-y (apply max (map pos-y (hash-keys part2-hull)))) + +(require 2htdp/image) + +(define pixel-size 16) + +(define base (empty-scene + (* pixel-size (add1 (- max-x min-x))) + (* pixel-size (add1 (- max-y min-y))) 'black)) + +(define (set-color scene loc color) + (define rect (rectangle pixel-size pixel-size 'solid (match color [0 'black] [1 'white]))) + (define image-x (* pixel-size (- (pos-x loc) min-x))) + (define image-y (* pixel-size (- (- max-y min-y) (- (pos-y loc) min-y)))) + (place-image/align rect image-x image-y 'left 'top scene)) + +(frame + (for/foldr ([scene (set-color base (pos 0 0) 1)]) + ([loc (hash-keys part2-hull)]) + (set-color scene loc (hash-ref part2-hull loc)))) \ No newline at end of file