master
Matthew Butterick 4 years ago
parent 34310ca3fc
commit b98bf1265a

@ -0,0 +1,94 @@
#lang br
(require racket/file rackunit racket/set)
(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 (terminate)]
[_ (error "unknown opcode" opcode)]))
(loop next-ptr))))))
(define beam-rec (make-hasheq))
(define (in-beam? x y)
(hash-ref! beam-rec (+ (* 10000 x) y)
(λ ()
(define th (make-runner (file->string "19.rktd")))
(thread-send th x)
(thread-send th y)
(not (zero? (thread-receive))))))
;; 1
(check-eq?
(for*/sum ([x (in-range 50)]
[y (in-range 50)]
#:when (in-beam? x y))
1)
129)
(define (in-big-square? x y)
(and
(in-beam? x y)
(in-beam? (+ x 99) y)
(in-beam? x (+ y 99))))
;; 2
;; discovered by trial & error:
;; 2100 too low
;; 2200 ok
(check-eq?
(for*/first ([xy-sum (in-naturals 2100)]
[x (in-range xy-sum)]
[y (in-value (- xy-sum x))]
#:when (in-big-square? x y))
(+ (* 10000 x) y))
14040699)

@ -0,0 +1 @@
109,424,203,1,21101,0,11,0,1105,1,282,21101,18,0,0,1105,1,259,2101,0,1,221,203,1,21102,1,31,0,1105,1,282,21101,0,38,0,1106,0,259,21002,23,1,2,22101,0,1,3,21101,0,1,1,21102,1,57,0,1106,0,303,2102,1,1,222,21001,221,0,3,20102,1,221,2,21101,0,259,1,21101,80,0,0,1106,0,225,21101,0,23,2,21102,91,1,0,1106,0,303,1201,1,0,223,20101,0,222,4,21101,0,259,3,21102,1,225,2,21102,1,225,1,21102,1,118,0,1105,1,225,20102,1,222,3,21101,0,87,2,21101,133,0,0,1106,0,303,21202,1,-1,1,22001,223,1,1,21101,0,148,0,1105,1,259,2101,0,1,223,20102,1,221,4,21002,222,1,3,21101,0,9,2,1001,132,-2,224,1002,224,2,224,1001,224,3,224,1002,132,-1,132,1,224,132,224,21001,224,1,1,21102,1,195,0,106,0,109,20207,1,223,2,21001,23,0,1,21102,1,-1,3,21101,0,214,0,1106,0,303,22101,1,1,1,204,1,99,0,0,0,0,109,5,2102,1,-4,249,21201,-3,0,1,22101,0,-2,2,21202,-1,1,3,21102,250,1,0,1106,0,225,21202,1,1,-4,109,-5,2106,0,0,109,3,22107,0,-2,-1,21202,-1,2,-1,21201,-1,-1,-1,22202,-1,-2,-2,109,-3,2105,1,0,109,3,21207,-2,0,-1,1206,-1,294,104,0,99,21202,-2,1,-2,109,-3,2105,1,0,109,5,22207,-3,-4,-1,1206,-1,346,22201,-4,-3,-4,21202,-3,-1,-1,22201,-4,-1,2,21202,2,-1,-1,22201,-4,-1,1,22102,1,-2,3,21102,1,343,0,1106,0,303,1106,0,415,22207,-2,-3,-1,1206,-1,387,22201,-3,-2,-3,21202,-2,-1,-1,22201,-3,-1,3,21202,3,-1,-1,22201,-3,-1,2,21201,-4,0,1,21102,384,1,0,1105,1,303,1106,0,415,21202,-4,-1,-4,22201,-4,-3,-4,22202,-3,-2,-2,22202,-2,-4,-4,22202,-3,-2,-3,21202,-4,-1,-2,22201,-3,-2,1,21202,1,1,-4,109,-5,2106,0,0