day11.rkt

#lang racket

(require threading)

(define (get-input)
  (map string->number (string-split (car (file->lines "day11.txt")) ",")))

(define (get-test-input)
  (map string->number (string-split (car (file->lines "day9.txt")) ",")))


(define (code->hash code)
  (define (step code ip hsh)
    (if (empty? code)
        hsh
        (step (cdr code) (+ 1 ip) (hash-set hsh ip (car code)))))
  (step code 0 #hash()))

(struct parameter (value mode) #:transparent)
(struct opcode (op a b c) #:transparent)
(struct state (output code ip base) #:transparent)
(struct point (x y) #:transparent)

(define test-canvas
  (make-hash
   (list
    (cons (point 0 0) 1)
    (cons (point 1 0) 1)
    (cons (point 2 1) 1)
    (cons (point 2 2) 1))))

(define (run-code code input [ip 0] [base 0])
  (define (decode-op code ip)
    (let* ([base (hash-ref code ip 0)]
           [pm1 (modulo (quotient base 100) 10)]
           [pm2 (modulo (quotient base 1000) 10)]
           [pm3 (modulo (quotient base 10000) 10)]
           [op  (modulo base 100)])
      (opcode op (parameter 1 pm1) (parameter 2 pm2) (parameter 3 pm3))))

  (define (parameter-get parameter code ip base)
    (cond [(= 1 (parameter-mode parameter)) (hash-ref code (+ ip (parameter-value parameter)) 0)]
          [(= 0 (parameter-mode parameter)) (hash-ref code (hash-ref code (+ ip (parameter-value parameter)) 0) 0)]
          [(= 2 (parameter-mode parameter)) (hash-ref code (+ base (hash-ref code (+ ip (parameter-value parameter))) 0) 0)]))

  (define (parameter-get-address parameter code ip base)
    (cond [(= 1 (parameter-mode parameter)) (+ ip (parameter-value parameter) 0)]
          [(= 0 (parameter-mode parameter)) (hash-ref code (+ ip (parameter-value parameter)) 0)]
          [(= 2 (parameter-mode parameter)) (+ base (hash-ref code (+ ip (parameter-value parameter))) 0)]))
  
  (define (add code ain bin cin ip base)
    (let ([a (parameter-get ain code ip base)]
          [b (parameter-get bin code ip base)]
          [c (parameter-get-address cin code ip base)])
      (hash-set code c (+ a b))))

  (define (mul code ain bin cin ip base)
    (let ([a (parameter-get ain code ip base)]
          [b (parameter-get bin code ip base)]
          [c (parameter-get-address cin code ip base)])
      (hash-set code c (* a b))))

  (define (inp code ain ip input base)
    (let ([a (parameter-get-address ain code ip base)])
      (hash-set code a input)))

  (define (out code ain ip output base)
    (let ([a (parameter-get ain code ip base)])
      (cons a output)))

  (define (jit code ain bin ip base)
    (let ([a (parameter-get ain code ip base)]
          [b (parameter-get bin code ip base)])
      (if (zero? a)
          (+ 3 ip)
          b)))

  (define (jif code ain bin ip base)
    (let ([a (parameter-get ain code ip base)]
          [b (parameter-get bin code ip base)])
      (if (zero? a)
          b
          (+ 3 ip))))

  (define (ilt code ain bin cin ip base)
    (let ([a (parameter-get ain code ip base)]
          [b (parameter-get bin code ip base)]
          [c (parameter-get-address cin code ip base)])
      (if (< a b)
          (hash-set code c 1)
          (hash-set code c 0))))

  (define (ieq code ain bin cin ip base)
    (let ([a (parameter-get ain code ip base)]
          [b (parameter-get bin code ip base)]
          [c (parameter-get-address cin code ip base)])
      (if (= a b)
          (hash-set code c 1)
          (hash-set code c 0))))

  (define (stb code ain ip base)
    (let ([a (parameter-get ain code ip base)])
      (+ base a)))
  
  (define (run-op code ip input output base)

    (let ([op (decode-op code ip)])
      (if (= 2 (length output))
          (state (reverse output) code ip base)
          (cond [(= 99 (opcode-op op)) (reverse output)]
                [(= 1 (opcode-op op)) (run-op (add code (opcode-a op) (opcode-b op) (opcode-c op) ip base) (+ 4 ip) input output base)]
                [(= 2 (opcode-op op)) (run-op (mul code (opcode-a op) (opcode-b op) (opcode-c op) ip base) (+ 4 ip) input output base)]
                [(= 3 (opcode-op op)) (run-op (inp code (opcode-a op) ip (car input) base) (+ 2 ip) (cdr input) output base)]
                [(= 4 (opcode-op op)) (run-op code (+ 2 ip) input (out code (opcode-a op) ip output base) base)]
                [(= 5 (opcode-op op)) (run-op code (jit code (opcode-a op) (opcode-b op) ip base) input output base)]
                [(= 6 (opcode-op op)) (run-op code (jif code (opcode-a op) (opcode-b op) ip base) input output base)]
                [(= 7 (opcode-op op)) (run-op (ilt code (opcode-a op) (opcode-b op) (opcode-c op) ip base) (+ 4 ip) input output base)]
                [(= 8 (opcode-op op)) (run-op (ieq code (opcode-a op) (opcode-b op) (opcode-c op) ip base) (+ 4 ip) input output base)]
                [(= 9 (opcode-op op)) (run-op code (+ 2 ip) input output (stb code (opcode-a op) ip base))]))))

  
    (run-op code ip input '() base))

(define (display-canvas canvas)
  (define (min-x canvas)
    (~>> (hash-keys canvas)
         (map point-x)
         (apply min)))
  (define (max-x canvas)
    (~>> (hash-keys canvas)
         (map point-x)
         (apply max)))
  (define (min-y canvas)
    (~>> (hash-keys canvas)
         (map point-y)
         (apply min)))
  (define (max-y canvas)
    (~>> (hash-keys canvas)
         (map point-y)
         (apply max)))
  (define (to-char num)
    (if (= 1 num)
        #\#
        #\.))
  (define (get-line canvas frm to line)
    (~>> (for/list ([x (range frm (+ 1 to))]) (point x line))
         (map (λ (pnt) (hash-ref canvas pnt 0)))
         (map to-char)
         (apply string)))
  (define (get-lines canvas tlx tly brx bry lines)
    (if (< bry tly)
        lines
        (get-lines canvas tlx (+ 1 tly) brx bry (cons (get-line canvas tlx brx tly) lines))))
  (define (canvas->string canvas tlx tly brx bry)
    (string-join (get-lines canvas tlx tly brx bry '()) "\n"))

  (if (< 2 (hash-count canvas))
  (let
      ([tlx (min-x canvas)]
       [tly (min-y canvas)]
       [brx (max-x canvas)]
       [bry (max-y canvas)])
    (display (canvas->string canvas tlx tly brx bry))) 0))

(define (run-robot code [initcolour 0])
  (define (turn num curdir)
    (cond [(and (= 0 num) (equal? 'u curdir)) 'l]
          [(and (= 0 num) (equal? 'l curdir)) 'd]
          [(and (= 0 num) (equal? 'd curdir)) 'r]
          [(and (= 0 num) (equal? 'r curdir)) 'u]
          [(and (= 1 num) (equal? 'u curdir)) 'r]
          [(and (= 1 num) (equal? 'r curdir)) 'd]
          [(and (= 1 num) (equal? 'd curdir)) 'l]
          [(and (= 1 num) (equal? 'l curdir)) 'u]))
  (define (move position direction)
    (cond [(equal? 'u direction) (point (point-x position) (+ (point-y position) 1))]
          [(equal? 'd direction) (point (point-x position) (- (point-y position) 1))]
          [(equal? 'l direction) (point (- (point-x position) 1) (point-y position))]
          [(equal? 'r direction) (point (+ (point-x position) 1) (point-y position))]))
  (define (step pstate canvas direction position)  
    (if (empty? pstate)
        canvas
        (let ([newdir (turn (cadr (state-output pstate)) direction)])
          ;(display (state-output pstate))
          ;(display " ")
          ;(display (hash-ref canvas position 0))
          ;(display " ")
          ;(display direction)
          ;(display " ")
          ;(displayln position)
          (step
           (run-code (state-code pstate) (list (hash-ref canvas (move position newdir) 0)) (state-ip pstate) (state-base pstate))
           (hash-set canvas position (car (state-output pstate)))
           newdir
           (move position newdir)))))

  (step (run-code (code->hash code) (list initcolour)) #hash() 'u (point 0 0)))

(define (part1)
  (let ([canvas (run-robot (get-input))])
    (displayln " ")
    (display-canvas canvas)
    (displayln " ")
    (hash-count canvas)))

(part1)

(define (part2)
  (let ([canvas (run-robot (get-input) 1)])
    (displayln " ")
    (display-canvas canvas)))

(part2)