AdventOfCode2019/clojure/day18.clj at master · narimiran/AdventOfCode2019 · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
(ns day18
  (:require [aoc-utils.core :as aoc]
            [clojure.data.priority-map :refer [priority-map]]))


(defrecord Grid [walls robots doors locks])


(defn- parse-data [data]
  (-> (aoc/create-grid data {\# :walls
                             #{\@} :robots
                             Character/isUpperCase :doors
                             Character/isLowerCase :locks})
      (select-keys [:walls :robots :doors :locks])
      (map->Grid)))


(defn- path [pt1 pt2 {:keys [walls doors locks]}]
  (let [not-walls (complement walls)]
    (loop [queue (conj aoc/empty-queue [pt1 0 #{} []])
           seen #{}]
      (let [[curr dist drs lcks] (peek queue)]
        (cond
          (nil? curr) nil
          (= curr pt2) [dist drs lcks]
          :else (let [seen' (conj seen curr)
                      dist' (inc dist)
                      nbs (aoc/neighbours-4 curr (every-pred not-walls (complement seen)))
                      queue' (reduce (fn [q nb]
                                       (conj q [nb
                                                dist'
                                                (if-let [d (doors nb)]
                                                  (conj drs (Character/toLowerCase d))
                                                  drs)
                                                (if-let [l (and (not= nb pt2) (locks nb))]
                                                  (conj lcks l)
                                                  lcks)]))
                                     (pop queue)
                                     nbs)]
                  (recur queue' seen')))))))


(defn find-paths [{:keys [locks robots] :as data} [pt1 c1]]
  (let [paths (atom {})]
    (doseq [[pt2 c2] locks
            :while (not= pt1 pt2)
            :let [p (path pt1 pt2 data)]
            :when p]
      (swap! paths update c1 (fnil conj {}) [c2 p])
      (when (not (robots pt1))
        (swap! paths update c2 (fnil conj {}) [c1 p])))
    @paths))

(defn all-paths [{:keys [robots locks] :as data}]
  (->> (into locks robots)
       (pmap #(find-paths data %))
       (reduce (fn [acc r]
                 (reduce-kv (fn [acc k v]
                              (update acc k (fnil conj {}) v))
                            acc
                            r)))))


(defn- collect [start paths total-locks]
  (loop [queue (priority-map [start #{}] 0)]
    (let [[[curr seen] dist] (peek queue)]
      (if (= total-locks (count seen))
        dist
        (let [queue' (pop queue)
              nbs (for [[nb [d reqs along]] (paths curr)
                        :when (and (every? seen reqs) (not (seen nb)))
                        :let [dist' (+ dist d)
                              k [nb (conj (into seen along) nb)]]
                        :when (< dist' (queue' k 9999))]
                    [k dist'])]
          (recur (into queue' nbs)))))))


(defn- modify-grid [{:keys [walls robots doors locks]}]
  (let [robot-coord (ffirst robots)
        new-walls (conj (aoc/neighbours-4 robot-coord) robot-coord)
        new-robots {(aoc/pt+ robot-coord [-1 -1]) \1
                    (aoc/pt+ robot-coord [ 1 -1]) \2
                    (aoc/pt+ robot-coord [-1  1]) \3
                    (aoc/pt+ robot-coord [ 1  1]) \4}]
    (->Grid (into walls new-walls) new-robots doors locks)))


(defn- collect-2 [start paths doors]
  (loop [queue (conj aoc/empty-queue [0 start doors])
         acc {}]
    (let [[dist curr seen] (peek queue)
          queue' (pop queue)
          nbs (for [[nb [d reqs along]] (paths curr)
                    :when (and (every? seen reqs)
                               (not (seen nb)))]
                [(+ dist d) nb (conj (into seen along) nb)])]
       (cond
         (empty? queue) acc
         (empty? nbs) (recur queue' (update acc [curr seen] (fnil min 99999) dist))
         :else (recur (into queue' nbs) acc)))))


(defn part-2 [paths total-locks]
  (loop [queue (priority-map [[\1 \2 \3 \4] #{}] 0)
         visited {}]
    (let [[[robots seen] dist] (peek queue)]
      (if (= total-locks (count seen))
        dist
        (let [new-stuff (for [[i robot] (map-indexed vector robots)
                              [[robot' seen'] dist'] (collect-2 robot paths seen)
                              :let [robots' (assoc robots i robot')
                                    dist'' (+ dist dist')]
                              :when (and (not= robot robot')
                                         (< dist'' (visited [robots' seen'] 99999)))]
                          [[robots' seen'] dist''])]
          (recur (into (pop queue) new-stuff)
                 (into visited new-stuff)))))))


(defn solve [filename]
  (let [data (parse-data (aoc/parse-lines (aoc/read-input filename)))
        paths (all-paths data)
        pt2-data (modify-grid data)
        pt2-paths (all-paths pt2-data)
        total-locks (count (:locks data))]
    [(collect \@ paths total-locks)
     (part-2 pt2-paths total-locks)]))


(solve 18)