~ihabunek/aoc2018

aoc2018/clojure/src/aoc2018/day17.clj -rw-r--r-- 5.1 KiB
d99cc364Ivan Habunek Day 15, speedup, part1 done 1 year, 11 months ago
                                                                                
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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
; --- Day 17: Reservoir Research ---
; https://adventofcode.com/2018/day/17

(ns aoc2018.day17
  (:require [clojure.java.io :as io]
            [clojure.set :as set]
            [clojure.string :as str]
            [clojure.pprint :refer [pprint]]))

(defn digits [string]
  (->> string
       (re-seq #"\d+")
       (map read-string)))

(defn parse-line [line]
  (let [[a b ^long c] (digits line)]
    (if (= \x (first line))
      (for [y (range b (inc c))] [a y])
      (for [x (range b (inc c))] [x a]))))

(defn parse-input [input]
  (->> input
       str/split-lines
       (map parse-line)
       (apply concat)
       (set)))

(defn find-bottom
  "Starting at given coordinates, locate the lowest y coordinate under which
  there is clay, or is at the bottom of bounds (max-y)."
  [[x y0] clay ^long max-y]
  (loop [^long y y0]
    (cond
      (contains? clay [x (inc y)]) [false y]  ; found bottom
      (>= y max-y)                 [true  y]  ; bottomless pit
      :else (recur (inc y)))))

(defn find-edge [^long y xs clay water]
  (loop [xs xs]
    (let [x (first xs)]
      (cond
        (contains? clay [x y])                 [:clay x] ; hit a wall
        (and
          (not (contains? clay [x (inc y)]))
          (not (contains? water [x (inc y)]))) [:drop x] ; nothing below
        :else (recur (rest xs))))))

(defn fill-row
  "Attempts to fill a row of water starting with [x, y]. Returns:
  - set of filled water tiles
  - one or more new springs caused by water running off edges

  If the row is bordered by clay on both sides, the returned water tiles will be
  still water, and the number of springs will be zero.

  If the row is bordered on one or both sides by a gap, the returned water will
  be flowing and there will be one or two new springs."
  [x y clay water]
  (let [[ltype ^long lx] (find-edge y (iterate dec x) clay water)
        [rtype ^long rx] (find-edge y (iterate inc x) clay water)
        new-water (for [x (range (inc lx) rx)] [x y])
        springs (if (= ltype rtype :clay)
                  []
                  (->> (list [ltype lx] [rtype rx])
                    (filter #(= :drop (first %)))
                    (map second)
                    (map #(vector % y))))]
    [springs new-water]))

(defn fill-bowl
  "Given a position at the bottom of a bowl, fills it with water.
  Returns:
  - coordinates of new springs caused by water flowing off the edges
  - the updated set of still water tiles
  - a set of flowing water tiles rested on top of the filled bowl"
  [x bottom-y clay water]
  (loop [water water
         ys (range bottom-y 0 -1)]
    (let [y (first ys)
          [springs new-water] (fill-row x y clay water)]
      (if (empty? springs)
        (recur (set/union water (set new-water)) (rest ys))
        [springs water (set new-water)]))))


(defn get-falling-water
  "Returns a set of coordinates populated by water falling from a spring to the given depth."
  [[x top-y] ^long bottom-y]
  (set
    (for [y (range top-y (inc bottom-y))]
      [x y])))

(defn tick [springs clay water flow max-y]
  (let [spring (first springs)
        [infinite? bottom-y] (find-bottom spring clay max-y)
        falling-water (get-falling-water spring bottom-y)]

    (if infinite?
      ; no bottom - we are done with this spring (just add falling water)
      (let [springs' (rest springs)
            flow' (set/union flow falling-water)]
        [springs' water flow'])

      ; found bottom - fill the well
      (let [[new-springs water' rested-water] (fill-bowl (first spring) bottom-y clay water)
            springs' (distinct (concat (rest springs) new-springs))
            flow' (set/union flow falling-water rested-water)]
        [springs' water' flow']))))

(defn dump [clay water flow spring]
  (let [xs (map first clay)
        ys (map second clay)
        x0 (apply min xs)
        x1 (apply max xs)
        y0 0
        y1 (apply max ys)]
   (str/join "\n"
     (for [y (range y0 (+ y1 2))]
       (str/join ""
         (for [x (range (- x0 2) (+ x1 2))]
           (cond
             (= spring [x y]) \+
             (contains? clay  [x y]) \#
             (contains? water  [x y]) \~
             (contains? flow  [x y]) \|
             :else \.)))))))

(defn score [clay water flow spring]
  ; remove still water from flow (flow computed before still water so it overlaps)
  ; remove initial spring location from flow (not counted in the task)
  (let [flow (set/difference flow water #{spring})
        flow-count (count flow)
        water-count (count water)]
    [water-count flow-count (+ water-count flow-count)]))

(defn play [spring clay]
  (let [max-y (->> clay (map second) (apply max))]
    (loop [springs [spring]
           water #{}
           flow #{}]
      (if (empty? springs)
        (score clay water flow spring)
        (let [[springs' water' flow'] (tick springs clay water flow max-y)]
          (recur springs' water' flow'))))))

(def input-file (-> "day17.in" io/resource io/file))
(def spring [500 4])

(defn main []
  (let [clay (-> input-file slurp parse-input)
        [w f t] (time (play spring clay))]
    (println "Water at rest" w)
    (println "Flowing water" f)
    (println "Total tiles" t)))