src/adventofcode2019/intcode.clj

   1 (ns adventofcode2019.intcode
   2   [:require [adventofcode2019.lib :refer :all]])
   3
   4 ;; 0: function args&mem -> [mem (ctr -> ctr)]
   5 ;; 1: number of args
   6 (defn- decode-op [opcode]
   7   (let [str-code (format "%05d" opcode)
   8         flags (reverse (take 3 str-code))
   9         op (vec (drop 3 str-code))
  10         apply-flag (fn [flag arg]
  11                      (case flag
  12                        ;; ORs avoid returning nil
  13                        \0 (fn ([S] (or (get-in S [:memory arg]) 0))
  14                               ([_ _] arg))
  15                        \1 (constantly arg)
  16                        \2 (fn ([S] (or (get-in S [:memory (+ arg (:relctr S))]) 0))
  17                               ([S _] (+ arg (:relctr S))))))
  18         with-flags (fn [f]
  19                      (fn [S & args]
  20                        (apply f S (map apply-flag flags args))))]
  21     (with-flags
  22       (case op
  23         [\0 \1] (fn [S a b c] ; ADD
  24                   (-> S
  25                       (assoc-in [:memory (c S true)] (+' (a S) (b S)))
  26                       (update :ctr + 4)))
  27         [\0 \2] (fn [S a b c] ; MULT
  28                   (-> S
  29                       (assoc-in [:memory (c S true)] (*' (a S) (b S)))
  30                       (update :ctr + 4)))
  31         [\0 \3] (fn [S a _ _] ; IN
  32                   (-> S
  33                       (assoc-in [:memory (a S true)] (first (:input S)))
  34                       (update :input rest)
  35                       (update :ctr + 2)))
  36         [\0 \4] (fn [S a _ _] ; OUT
  37                   (-> S
  38                       (update :output conj (a S))
  39                       (update :ctr + 2)))
  40         [\0 \5] (fn [S a b _] ; BNEQ
  41                    (update S :ctr (if (not= (a S) 0) (constantly (b S)) #(+ % 3))))
  42         [\0 \6] (fn [S a b _] ; BEQ
  43                    (update S :ctr (if (= (a S) 0) (constantly (b S)) #(+ % 3))))
  44         [\0 \7] (fn [S a b c] ; SLT
  45                   (-> S
  46                       (assoc-in [:memory (c S true)] (if (< (a S) (b S)) 1 0))
  47                       (update :ctr + 4)))
  48         [\0 \8] (fn [S a b c] ; SEQ
  49                   (-> S
  50                       (assoc-in [:memory (c S true)] (if (= (a S) (b S)) 1 0))
  51                       (update :ctr + 4)))
  52         [\0 \9] (fn [S a _ _] ; SREL
  53                    (-> S
  54                        (update :relctr + (a S))
  55                        (update :ctr + 2)))
  56         [\9 \9] (fn [S _ _ _] ; EXIT
  57                    (assoc S :exit 1))))))
  58
  59 (defn- perform-operation [{:keys [memory ctr] :as state}]
  60   (let [operation (decode-op (memory ctr))
  61         args (map memory [(+ 1 ctr) (+ 2 ctr) (+ 3 ctr)])]
  62     (apply operation state args)))
  63
  64 (defn build-state
  65   ([program]
  66    (let [memory (into {} (map-indexed #(vector %1 %2) program))]
  67      {:memory memory :ctr 0 :input [] :output [] :relctr 0}))
  68   ([program settings]
  69    (merge (build-state program) settings)))
  70
  71 (defn intcode [{:as state :keys [memory output]}]
  72   (cond ; quit if :exit, step and return state if :step, else loop
  73     (get state :exit) {:memory memory :output output :exit true}
  74     (get state :step) (perform-operation state)
  75     :else (recur (perform-operation state))))
  76
  77 (defn intcode-until [pred state]
  78   (as-> (assoc state :step true) it
  79         (iterate intcode it)
  80         (drop-while #(not (or (:exit %) (pred %))) it)
  81         (first it)
  82         (dissoc it :step)))