Modified IntCode interpreter to return a state on input/output/halt.

This commit is contained in:
Jonathan Chan 2019-12-09 13:09:16 -08:00
parent 28a510f3ec
commit 53da35fdac
6 changed files with 95 additions and 104 deletions

16
lib.rkt
View File

@ -1,7 +1,11 @@
#lang racket
(require racket/format
2htdp/batch-io)
(require
(only-in data/queue
make-queue
enqueue!)
(only-in 2htdp/batch-io
read-lines))
(provide problem-input
show-solution
@ -14,6 +18,7 @@
list-ref*
chunks-of
transpose
list->queue
vector-ref*
vector-set!*)
@ -97,6 +102,13 @@
[layers (map cdr layers)])
(cons pixels (transpose layers)))))
;; list->queue : (listof any) -> (queueof any)
;; Creates a queue and adds elements of list in order
(define (list->queue lst)
(let ([Q (make-queue)])
(for-each (curry enqueue! Q) lst)
Q))
;; Vector helpers ;;

View File

@ -1,8 +1,8 @@
#lang racket
(require "../lib.rkt"
"IntCode.rkt"
racket/vector)
(require racket/vector
"../lib.rkt"
"IntCode.rkt")
(define input
(string->program (car (problem-input 2))))
@ -14,8 +14,7 @@
input))
(define (exec-pos0 program)
(let-values ([(program _)
(exec program)])
(let ([program (halt-with-program (exec program))])
(vector-ref program 0)))
(define part1

View File

@ -7,11 +7,9 @@
(string->program (car (problem-input 5))))
(define part1
(let-values ([(_ out) (exec input #:in '(1))])
(last out)))
(last (resume-with-io (exec input) '(1))))
(define part2
(let-values ([(_ out) (exec input #:in '(5))])
(last out)))
(last (resume-with-io (exec input) '(5))))
(show-solution part1 part2)

View File

@ -1,4 +1,4 @@
#lang racket
#lang plai
(require data/queue
"../lib.rkt"
@ -8,80 +8,30 @@
(string->program (car (problem-input 7))))
(define (amplify phase)
(let*-values ([(_ outA) (exec input #:in (list (first phase) 0))]
[(_ outB) (exec input #:in (list (second phase) (car outA)))]
[(_ outC) (exec input #:in (list (third phase) (car outB)))]
[(_ outD) (exec input #:in (list (fourth phase) (car outC)))]
[(_ outE) (exec input #:in (list (fifth phase) (car outD)))])
(let* ([outA (resume-with-io (exec input) (list (first phase) 0))]
[outB (resume-with-io (exec input) (list (second phase) (car outA)))]
[outC (resume-with-io (exec input) (list (third phase) (car outB)))]
[outD (resume-with-io (exec input) (list (fourth phase) (car outC)))]
[outE (resume-with-io (exec input) (list (fifth phase) (car outD)))])
(car outE)))
(define part1
(let ([phases (permutations '(0 1 2 3 4))])
(apply max (append (map amplify phases)))))
(struct state (program pointer input) #:transparent)
(define (exec-state program #:ptr [pointer 0] #:in [input '()])
(let* ([instruction (list-ref program pointer)]
[opcode (remainder instruction 100)]
[mode1 (remainder (quotient instruction 100) 10)]
[mode2 (remainder (quotient instruction 1000) 10)]
[mode3 (remainder (quotient instruction 10000) 10)]
;; l* : call to get write location from program
[l1 (λ () (if (zero? mode1) (list-ref program (+ pointer 1)) (+ pointer 1)))]
[l2 (λ () (if (zero? mode2) (list-ref program (+ pointer 2)) (+ pointer 2)))]
[l3 (λ () (if (zero? mode3) (list-ref program (+ pointer 3)) (+ pointer 3)))]
;; v* : call to read values from program
[v1 (λ () (list-ref program (l1)))]
[v2 (λ () (list-ref program (l2)))]
[v3 (λ () (list-ref program (l3)))]
[next-pointer
(match opcode
[(or 1 2 7 8) (+ pointer 4)]
[(or 3 4) (+ pointer 2)]
[(or 5 6) (+ pointer 3)]
[99 (+ pointer 1)])])
(match opcode
[(or 1 2)
(let* ([arith (match opcode [1 +] [2 *])]
[value (arith (v1) (v2))]
[program (list-set program (l3) value)])
(exec-state program #:ptr next-pointer #:in input))]
[3
(let* ([value (car input)]
[input (cdr input)]
[program (list-set program (l1) value)])
(exec-state program #:ptr next-pointer #:in input))]
[4
(values 'yield (v1)
(state program next-pointer input))]
[(or 5 6)
(let* ([jump-if (match opcode [5 nzero?] [6 zero?])]
[next-pointer (if (jump-if (v1)) (v2) next-pointer)])
(exec-state program #:ptr next-pointer #:in input))]
[(or 7 8)
(let* ([lt-eq (match opcode [7 <] [8 =])]
[value (if (lt-eq (v1) (v2)) 1 0)]
[program (list-set program (l3) value)])
(exec-state program #:ptr next-pointer #:in input))]
[99
(values 'halt (car input)
(state program next-pointer (cdr input)))])))
(let ([phases (permutations '(0 1 2 3 4))])
(apply max (append (map amplify phases)))))
(define (amplify-loop phase)
(let* ([input (vector->list input)]
[amps (map (compose (curry state input 0) list) phase)]
[Q (make-queue)])
(map (curry enqueue! Q) amps)
(let* ([amps (map (curry resume-with-input (exec input)) phase)]
[Q (list->queue amps)])
(let loop ([signal 0])
(let* ([amp (dequeue! Q)])
(let-values ([(code signal amp)
(exec-state (state-program amp)
#:ptr (state-pointer amp)
#:in (rac (state-input amp) signal))])
(match code
['yield (enqueue! Q amp) (loop signal)]
['halt signal]))))))
(define amp (dequeue! Q))
(type-case state amp
[halt (_) signal]
[in (resume)
(define-values (signal st)
(resume-with-output (resume signal)))
(enqueue! Q st)
(loop signal)]
[else (error "amplify-loop: Unexpected program state.")]))))
(define part2
(let ([phases (permutations '(5 6 7 8 9))])

View File

@ -6,10 +6,10 @@
(define input
(string->program (car (problem-input 9))))
(define-values (_ part1)
(exec input #:in '(1)))
(define part1
(car (resume-with-io (exec input) '(1))))
(define-values (__ part2)
(exec input #:in '(2)))
(define part2
(car (resume-with-io (exec input) '(2))))
(show-solution (car part1) (car part2))
(show-solution part1 part2)

View File

@ -1,11 +1,8 @@
#lang racket
#lang plai
(require racket/vector
"../lib.rkt")
(provide string->program
exec)
(define (vector-ref** vec pos)
(vector-ref* vec pos 0))
@ -15,7 +12,38 @@
(define (string->program str)
(list->vector (map string->number (string-split str ","))))
;; exec* : program -> number -> number -> (listof number) -> (listof number) -> program
(define (program? p)
(vectorof number?))
(define-type state
(out [value number?] [resume procedure?])
(in [resume procedure?])
(halt [program program?]))
(define (resume-with-output st)
(type-case state st
[out (value resume) (values value (resume))]
[else (error "resume-with-output: Unexpected program state.")]))
(define (resume-with-input st input)
(type-case state st
[in (resume) (resume input)]
[else (error "resume-with-input: Unexpected program state.")]))
(define (resume-with-io st inputs)
(type-case state st
[in (resume)
(resume-with-io (resume (car inputs)) (cdr inputs))]
[out (value resume)
(cons value (resume-with-io (resume) inputs))]
[halt (program) '()]))
(define (halt-with-program st)
(type-case state st
[halt (program) program]
[else (error "halt-with-program: Unexpected program state.")]))
;; exec* : program -> number -> number -> state
;; An encoded instruction is anywhere from 1 to 4 digits long.
;; The last one or two digits represent the opcode, which can be:
;; - 1/2: add/multiply parameters 1 and 2 and store in parameter 3
@ -33,7 +61,7 @@
;; If the mode is 1, the value at pointer is immediate.
;; If the mode is 2, the value at pointer is an address to be offset by base.
;; Note that leading zeroes in the encoded instruction are omitted.
(define (exec* program #:ptr [pointer 0] #:base [base 0] #:in [input '()] #:out [output '()])
(define (exec* program #:ptr [pointer 0] #:base [base 0])
(define instruction (vector-ref** program pointer))
(define opcode (remainder instruction 100))
(define next-pointer
@ -63,29 +91,33 @@
(let* ([arith (match opcode [1 +] [2 *])]
[value (arith (v1) (v2))]
[program (vector-set!* program (l3) value)])
(exec* program #:ptr next-pointer #:base base #:in input #:out output))]
(exec* program #:ptr next-pointer #:base base))]
[3
(let* ([value (car input)]
[input (cdr input)]
[program (vector-set!* program (l1) value)])
(exec* program #:ptr next-pointer #:base base #:in input #:out output))]
(let* ([resume
(λ (input)
(vector-set!* program (l1) input)
(exec* program #:ptr next-pointer #:base base))])
(in resume))]
[4
(let* ([output (append output `(,(v1)))])
(exec* program #:ptr next-pointer #:base base #:in input #:out output))]
(let* ([output (v1)]
[resume
(λ () (exec* program #:ptr next-pointer #:base base))])
(out output resume))]
[(or 5 6)
(let* ([jump-if (match opcode [5 nzero?] [6 zero?])]
[next-pointer (if (jump-if (v1)) (v2) next-pointer)])
(exec* program #:ptr next-pointer #:base base #:in input #:out output))]
(exec* program #:ptr next-pointer #:base base))]
[(or 7 8)
(let* ([lt-eq (match opcode [7 <] [8 =])]
[value (if (lt-eq (v1) (v2)) 1 0)]
[program (vector-set!* program (l3) value)])
(exec* program #:ptr next-pointer #:base base #:in input #:out output))]
(exec* program #:ptr next-pointer #:base base))]
[9
(let ([base (+ base (v1))])
(exec* program #:ptr next-pointer #:base base #:in input #:out output))]
[99 (values program output)])))
(exec* program #:ptr next-pointer #:base base))]
[99
(halt program)])))
;; Just so we always run the program on a fresh copy
(define (exec program #:ptr [pointer 0] #:base [base 0] #:in [input '()] #:out [output '()])
(exec* (vector-copy program) #:ptr pointer #:base base #:in input #:out output))
(define (exec program #:ptr [pointer 0] #:base [base 0])
(exec* (vector-copy program) #:ptr pointer #:base base))