aoc-2018-16.clj

(ns aoc.day16
  (:use aoc.common)
  (:require [clojure.set :as set]
            [clojure.string :as str]
            [clojure.test :refer [testing is]]
            [clojure.pprint :as pp]
            [clojure.spec.alpha :as s]
            [clojure.spec.test.alpha :as stest]
            [better-cond.core :as b]))

(def OPSYMS [:addr :addi :mulr :muli :banr :bani :borr :bori :setr :seti :gtir :gtri :gtrr :eqir :eqri :eqrr])

(def ^:dynamic *DEBUG* false)

(s/def ::instruction (s/coll-of int? :kind vector? :count 4))
(s/def ::registers   (s/coll-of int? :kind vector? :count 4))


(defn calculate [opsym A B registers]
  (let [reg  (fn [i] {:pre [(<= 0 i 3)]} (fetch registers i))
        val  (fn [x] x)
        f    (fn [op fA fB]
               (op (fA A) (fB B)))
        gt   (fn [x y]
               (if (> x y) 1 0))
        eq   (fn [x y]
               (if (= x y) 1 0))]
    (case opsym
      :addr    (f + reg reg)
      :addi    (f + reg val)

      :mulr    (f * reg reg)
      :muli    (f * reg val)

      :banr    (f bit-and reg reg)
      :bani    (f bit-and reg val)

      :borr    (f bit-or reg reg)
      :bori    (f bit-or reg val)

      :setr    (reg A)
      :seti    (val A)

      :gtir    (f gt val reg)
      :gtri    (f gt reg val)
      :gtrr    (f gt reg reg)

      :eqir    (f eq val reg)
      :eqri    (f eq reg val)
      :eqrr    (f eq reg reg))))

(e.g.
  (calculate :addr 1 3 [9 8 7 6])  --> 14
  (calculate :gtri 0 8 [9 8 7 6])  --> 1
  (calculate :gtri 3 8 [9 8 7 6])  --> 0)


(defn apply-symbolic-instruction
  "Opcode is :mulr or :addi or ...
   Args is three integers - two input arguments and one output register.
   Registers is four integers - R0 through R3.
   Output: new registers"
  [opsym args registers]
  (let [[A B C] args
        result  (calculate opsym A B registers)]
    (assoc registers C result)))

(e.g.
  (apply-symbolic-instruction :addr [2 1 0] [9 3 8 4])     --> [(+ 8 3) 3 8 4]
  (apply-symbolic-instruction :seti [2 1 0] [9 3 8 4])     --> [2 3 8 4]
  (apply-symbolic-instruction :setr [2 1 0] [9 3 8 4])     --> [8 3 8 4]
  (apply-symbolic-instruction :banr [0 1 3] [12 9 1 2])    --> [12 9 1 (bit-and 12 9)])


(defn successful-opcodes
  "Given registers, instruction, and registers', which one(s) of the 16 opcodes could have
   produced that change in the registers? Returns a list of successful opcodes.
   Note: 'instruction' contains four integers, the first being an opcode, but the opcode is
   ignored. The point of this function is to try _all_ opcodes."
  [registers instruction registers']
  (let [args  (subvec instruction 1)]
    (into []
          (for [opsym OPSYMS
                :when (= (apply-symbolic-instruction opsym args registers)
                         registers')]
            opsym))))

(e.g.
  (successful-opcodes [3 2 1 1] ['_ 2 1 2] [3 2 2 1]) --set=> [:mulr :addi :seti])


(defn data-16a []
  (let [f  (fn [[l1 l2 l3 _]]
             {:reg  (->  l1 (subs 8) read-string)
              :inst (->> l2 (re-seq #"\d+") (mapv parse-long))
              :reg' (->  l3 (subs 8) read-string)})]
    (->> (parse "data/day16a.txt" str)
         (partition 4)
         (mapv f))))


(defn part1 []
  (->> (for [{:keys [reg inst reg']}  (data-16a)]
         (successful-opcodes reg inst reg'))
       (map count)
       (filter (partial <= 3))
       count))


(defn determine-opcodes
  "Input: {0 #{:eqir :gtrr :eqri :gtri},
           1 #{:bani :gtir :banr :eqrr :seti :mulr :eqri :gtri},
           2 #{:gtrr :gtri},
           3 #{:gtrr},
           4 #{:gtir :eqir :banr :eqrr :gtrr :eqri :gtri}, ..... }
   One by one, known opcode mappings are removed and the potential maps are simplified.
   Return: {0 :eqir, 1 :bani, 2 :gtri, 3 :gtrr, ... }"
  [data]
  (let [reduce-todo (fn [todo opnum]
                        (let [opsym (first (fetch todo opnum))
                              todo' (dissoc todo opnum)
                              todo' (map-vals #(disj % opsym) todo')]
                          todo'))]
    (loop [done (sorted-map), todo data]
      (b/cond
        (empty? todo) ,,,,,,,,,,,,,,,, (map-vals first done)

        let [[opcode sym]  (->> todo
                                (filter (comp (partial = 1) count second))
                                first)]

        (nil? opcode) ,,,,,,,,,,,,,,,, (raise-error "No unique opcode mapping found")

        :else ,,,,,,,,,,,,,,,,,,,,,,,, (recur (assoc       done opcode sym)
                                              (reduce-todo todo opcode))))))


(defn apply-numeric-instruction
  "Same as apply-symbolic-instruction except the opcode is a number. Needs an opcode-table
   like {0 :eqri, 1 :borr, ...} to resolve it."
  [opcode-table instruction registers]
  (let [opcode       (first instruction)
        opsym        (fetch opcode-table opcode)
        args         (subvec instruction 1)]
    (apply-symbolic-instruction opsym args registers)))

(s/fdef apply-numeric-instruction
        :args (s/cat :opcode-table map?
                     :instruction ::instruction
                     :registers ::registers)
        :ret  ::registers)

(e.g.
  (apply-numeric-instruction {7 :addr, 11 :borr} [7 2 1 0] [9 3 8 4])     --> [(+ 8 3) 3 8 4])


(defn part2 []
  (let [init          (into (sorted-map)
                            (zipmap (range 16) (repeat #{})))
        xs            (->> (for [{:keys [reg inst reg']}  (data-16a)]
                             (let [numeric-opcode     (first inst)
                                   potential-opcodes  (successful-opcodes reg inst reg')]
                               {numeric-opcode (set potential-opcodes)})))
        data          (apply merge-with set/union init xs)
        opcode-table  (determine-opcodes data)
        program       (parse "data/day16b.txt" (fn [line]
                                                 (mapv parse-long (re-seq #"\d+" line))))
        execute-instruction  (fn [regs inst]
                               (apply-numeric-instruction opcode-table inst regs))]
    (stest/instrument)
    (s/check-asserts true)
    (s/assert (s/coll-of ::instruction) program)
    (reduce execute-instruction
            [0 0 0 0]
            program)))