aoc-2018-13.clj

(ns aoc.day13
  (:use aoc.common)
  (:require [clojure.set    :as set]
            [clojure.string :as str]
            [clojure.test   :refer [testing is]]
            [clojure.pprint :as pp]))


(defn y-x-comparator
  "Compares location vectors in a way that enables sorting from top-left to bottom-right."
  [[a b] [c d]]
  (compare [b a] [d c]))


(defn parse-line
  "Returns a vector of data for one line of the input file. Each item in the vector is like:
     [:track [4 17] \\-]   or
     [:cart {:id nil, :type :cart, :loc [4 17], :dir :right, :int :left}]
   Thus information about track elements AND carts is returned, to be sorted through later."
  [y line]
  (let [cart-direction  (zipmap [\< \> \^ \v]
                                [:left :right :up :down])]
    (->> (for [[x char]  (indexed line)
                :when (not= \space char)]
            (let [datum      (case char
                               (\< \> \^ \v)    [:cart {:id     nil
                                                        :type   :cart
                                                        :loc    [x y]
                                                        :dir    (fetch cart-direction char)
                                                        :int    :left}]
                               ;; else
                                                [:track [x y] char])
                  cart?      (some #{:cart} datum)
                  updown?    (is-one-of? #{:up :down}     (-> datum second (get :dir)))
                  leftright? (is-one-of? #{:left :right}  (-> datum second (get :dir)))]
              (cond
                (and cart? updown?)       [datum  [:track [x y] \|]]
                (and cart? leftright?)    [datum  [:track [x y] \-]]
                :else                     [datum  nil])))

         ;; The code above is complex and produces a vector of two items for each x-value. So we:

         (apply concat)        ;; run them together
         (remove nil?)         ;; get rid of nil values
         vec)))                ;; package into a vector for return


;; Input:  { [1 4] \\
;;           [9 2] \-
;;           [4 2] \+
;;           ... }
;; Output: { [0 4]  {:type :corner, :left [[0 3] :up], :down [[1 4] :right]},
;;           [1 4]  {:type :straight, :left [[0 4] :left], :right [[2 4] :right]},
;;           [2 4]  {:type :intersection, :left [[1 4] :left], :right [[3 4] :right],
;;                                        :up [[2 3] :up], :down [[2 5] :down]})
;;           ... }
(defn process-tracks [tracks]
  (let [info (fn [type details]
               (apply merge
                      {:type type}
                      (for [[dir loc' dir'] (partition 3 details)]
                        {dir [loc' dir']})))]
    (into
      (sorted-map-by y-x-comparator)
      (for [[loc char] tracks
            :let [[x y] loc, x-1 (dec x), x+1 (inc x), y-1 (dec y), y+1 (inc y)]]
        (vector loc (case char
                      \-      (info :straight     [:left [x-1 y] :left, :right [x+1 y] :right])
                      \|      (info :straight     [:up   [x y-1] :up,   :down  [x y+1] :down])
                      \+      (info :intersection [:left [x-1 y] :left, :right [x+1 y] :right
                                                   :up   [x y-1] :up,   :down  [x y+1] :down])
                      \\      (if (is-one-of? [\| \+] (tracks [x y-1]))
                                (info :corner [:left  [x y-1] :up,   :down [x+1 y] :right])
                                (info :corner [:right [x y+1] :down, :up   [x-1 y] :left]))
                      \/      (if (is-one-of? [\| \+] (tracks [x y-1]))
                                (info :corner [:right [x y-1] :up,   :down [x-1 y] :left])
                                (info :corner [:left  [x y+1] :down, :up   [x+1 y] :right]))))))))


(defn parse-input
  "Takes the lines of text input and returns a program state with keys :tracks and :carts."
  [lines]
  (let [bits    (->> (for [[y line]  (indexed lines)]
                       (parse-line y line))
                     (apply concat)
                     (group-by first))
        tracks  (->> (:track bits)
                     (map rest)
                     (map vec)
                     (into {}))
        assign-cart-id  (fn [id cart] (assoc cart :id (-> (format "C%03d" id) keyword)))
        carts   (->> (:cart bits)
                     (map second)
                     (map assign-cart-id (range))
                     vec)]
    {:tracks (process-tracks tracks)
     :carts  carts}))


(defn- next-intersection-dir [x]
  (case x
    :left        :forward
    :forward     :right
    :right       :left))

(defn- resolve-intersection-direction [direction intersection-value]
  (case direction
    :left        (case intersection-value
                   :left      :down
                   :forward   :left
                   :right     :up)
    :right       (case intersection-value
                   :left      :up
                   :forward   :right
                   :right     :down)
    :up          (case intersection-value
                   :left      :left
                   :forward   :up
                   :right     :right)
    :down        (case intersection-value
                   :left      :right
                   :forward   :down
                   :right     :left)))


(defn advance-cart
  "Given a cart and the `tracks` data structure, divine the current loc and dir of the cart,
   and return loc' and dir'. Note that the direction may change if the cart has passed through
   a corner or an intersection."
  [cart tracks]
  (let [{:keys [loc dir]}  cart
        loc-data           (get tracks loc)
        intersection?      (= :intersection (:type loc-data))]
    (cond
      intersection?        (let [int   (:int cart)
                                 dir   (resolve-intersection-direction dir int)
                                 int'  (next-intersection-dir int)
                                 [loc' dir']  (get loc-data dir)]
                             (-> cart
                                 (assoc :loc loc')
                                 (assoc :dir dir')
                                 (assoc :int int')))

      :else                (let [[loc' dir']  (fetch loc-data dir)]
                             (-> cart
                                 (assoc :loc loc')
                                 (assoc :dir dir'))))))


(defn find-collisions
  "Find any collisions between `cart` and `carts` -- i.e. `cart` has just moved and may
   have collided with one of `carts`.

   If no collision, returns {}.

   If a collision occurred, returns (for example):)
     { :C019 [17 3], :C002 [17 3] }

   It's not possible for the return value to have anything other than zero or two entries."
  [cart carts]
  {:post [(fn [ret] (and (map? ret) (is-one-of? [0 2] (count ret))))]}
  (let [collision-loc  (:loc cart)
        collider-id    (->> carts
                            (filter #(= (:loc %) collision-loc))
                            first
                            :id)]
    (if collider-id
      { (:id cart)   collision-loc,
        collider-id  collision-loc}
      {})))

(e.g.
  (find-collisions {:id :X :loc [2 0]}
                   [{:id :Y :loc [2 0]} {:id :Z :loc [3 1]}])
  --> {:X [2 0], :Y [2 0]}

  (find-collisions {:id :A :loc [2 0]}
                   [{:id :B :loc [5 8]} {:id :C :loc [3 1]}])
  --> {})


(defn initial-tick [carts]
  {:tick                0
   :ncarts              (count carts)
   :carts               carts
   :collisions-id->loc  {}})


(defn remove-carts
  "Input:  collection of carts.
   Output: sequence of carts with specific IDs removed."
  [carts ids]
  (->> carts
       (remove (comp (set ids) :id))))


(defn- sort-carts-top-left-to-bottom-right [carts]
  (sort-by (comp vec reverse :loc) carts))

(defn- advance-tick-engine
  "Produces [carts' collisions] for the given input carts and tracks.
   carts' will be smaller than carts if collisions have occurred.
   Example of collisions value:
     {:C001 [2 0], :C000 [2 0], :C005 [2 4], :C004 [2 4], :C006 [6 4], :C003 [6 4]}]
   Yes, that is a lot of collisions."
  [carts tracks]
  (loop [done       ()
         carts      carts
         collisions {}]
    (cond-let
      :let [carts (sort-carts-top-left-to-bottom-right carts)]

      (empty? carts) ,,,,,,,,,,,,,,,, (vector done collisions)

      :let [[c & cs]   carts
            c'         (advance-cart c tracks)
            coll-data  (find-collisions c' (concat done cs))]

      (empty? coll-data) ,,,,,,,,,,,, (recur (conj done c')
                                             cs
                                             collisions)

      :let [coll-ids (keys coll-data)]

      :else ,,,,,,,,,,,,,,,,,,,,,,,,, (recur (remove-carts done coll-ids)
                                             (remove-carts cs coll-ids)
                                             (merge collisions coll-data)))))


(defn advance-tick
  "Performs a 'tick' in this problem. Takes and returns a 'tick' structure. Also takes a 'tracks' vector.

   Advance each cart one unit and detect any collisions. Carts are updated one at a time,
   in [y x] order (top-left to bottom-right). After each one is updated, all locations are
   examined for a collision.

   The returned 'tick' structure contains the :carts that are still around after any collisions have taken place,
   as well as :ncarts for convenience.

   Any collisions that occurred in this tick are recorded in :collisions-id->loc, for instance:
     :collisions-id->loc  { :C006 [13 7], :C002 [13 7] }"
  [tick tracks]
  (let [[carts' collisions]  (advance-tick-engine (:carts tick) tracks)]
    (-> tick
        (update :tick               inc)
        (assoc  :ncarts             (count carts'))
        (assoc  :carts              carts')
        (assoc  :collisions-id->loc collisions))))


(defn part1 []
  (let [{:keys [tracks carts]}  (parse-input (parse "data/day13.txt" str))]
    (->> (initial-tick carts)
         (iterate (fn [tick] (advance-tick tick tracks)))
         (drop-while (fn [tick] (empty? (:collisions-id->loc tick))))
         first
         :collisions-id->loc
         first
         second)))


(defn part2 []
  (let [{:keys [tracks carts]}  (parse-input (parse "data/day13.txt" str))]
    (->> (initial-tick carts)
         (iterate (fn [tick] (advance-tick tick tracks)))
         (drop-while (fn [tick] (< 1 (:ncarts tick))))
         first
         :carts
         first
         :loc)))