🎄 Advent of Code 2022 - Day 14 - Regolith Reservoir

(ns p14
(:require [clojure.string :as str]
[nextjournal.clerk :as clerk]
[clojure.set :as set]
[clojure.edn :as edn])
(:import [java.awt.image BufferedImage]))

Data processing

The input comes in the form is a string of coordinates that paints the walls of the board.

(def data-string (slurp "input/advent-2022-14.txt"))
"
494,23 -> 494,16 -> 494,23 -> 496,23 -> 496,16 -> 496,23 -> 498,23 -> 498,20 -> 17553 more elided"
(def test-string "498,4 -> 498,6 -> 496,6
498,4 -> 498,6 -> 496,6 503,4 -> 502,4 -> 502,9 -> 494,9")
"
498,4 -> 498,6 -> 496,6↩︎503,4 -> 502,4 -> 502,9 -> 494,9"
(defn horizontal-line
"All of the coordinates between two horizontal points."
[[x1 y1] [x2 y2]]
(assert (= y1 y2) "Can only form a line on between points on the same height.")
(let [xlo (min x1 x2)
xhi (max x1 x2)]
(for [x (range xlo (inc xhi))] [x y1])))
#object[p14$horizontal_line 0x6a6ff523 "
p14$horizontal_line@6a6ff523"
]
(defn vertical-line
"All of the coordinates between two vertical points."
[[x1 y1] [x2 y2]]
(assert (= x1 x2) "Can only form a line on between points at the same x.")
(let [ylo (min y1 y2)
yhi (max y1 y2)]
(for [y (range ylo (inc yhi))] [x1 y])))
#object[p14$vertical_line 0x72ca016e "
p14$vertical_line@72ca016e"
]
(defn line [[x1 y1] [x2 y2]]
(if
(= x1 x2) (vertical-line [x1 y1] [x2 y2])
(horizontal-line [x1 y1] [x2 y2])))
#object[p14$line 0x31678a2a "
p14$line@31678a2a"
]
(defn trace [[start & spots]]
(loop [rock #{}
start start
spots spots]
(if-let [end (first spots)]
(recur
(into rock (line start end))
end
(rest spots))
rock)))
#object[p14$trace 0x5bd9bb05 "
p14$trace@5bd9bb05"
]
(defn bounds [rock]
[[(dec (reduce min (map first rock)))
(inc (reduce max (map first rock)))]
[0
(reduce max (map second rock))]])
#object[p14$bounds 0x4e0a8bb0 "
p14$bounds@4e0a8bb0"
]
(defn process [s]
(let [rock (apply set/union
(for [line (str/split-lines s)]
(trace (into []
(for [pair (str/split line #" -> ")]
(edn/read-string (str "[" pair "]")))))))]
{:source [500 0]
:sand #{}
:rock rock
:bounds (bounds rock)}))
#object[p14$process 0x6ce9226e "
p14$process@6ce9226e"
]
(def test-data (process test-string))
{:bounds [[493 504] [0 9]] :rock #{[494 9] [495 9] [496 6] [496 9] [497 6] [497 9] [498 4] [498 5] [498 6] [498 9] [499 9] [500 9] [501 9] [502 4] [502 5] [502 6] [502 7] [502 8] [502 9] [503 4]} :sand #{} :source [500 0]}
(def data (process data-string))
{:bounds [[458 518] [0 169]] :rock #{[459 169] [460 169] [461 169] [462 167] [462 169] [463 167] [463 169] [464 167] [465 165] [465 167] [465 169] [466 165] [466 167] [466 169] [467 165] [467 169] [468 82] [468 163] [468 165] [468 167] 594 more elided} :sand #{} :source [500 0]}

Visualization

We'll build a clerk RGB image visualizater for our state.

(defn render-image
"Render the puzzle as a raw image."
([Ω] (render-image Ω (:bounds Ω) 1))
([Ω zoom] (render-image Ω (:bounds Ω) zoom))
([Ω bounds zoom]
(let [{:keys [rock sand source]} Ω
[[xlo xhi] [ylo yhi]] bounds
width (* zoom (- (inc xhi) (dec xlo)))
height (* zoom (- (inc yhi) (dec ylo)))
img (BufferedImage. width height BufferedImage/TYPE_3BYTE_BGR)]
(doseq [xp (range width)
yp (range height)]
(let [x (+ (quot xp zoom) (dec xlo))
y (+ (quot yp zoom) (dec ylo))
loc [x y]]
(.setRGB img xp yp
(cond
(rock loc) (.getRGB (java.awt.Color. 42 42 42))
(= source loc) (.getRGB (java.awt.Color. 255 0 0))
(sand loc) (.getRGB (java.awt.Color. 194 178 128))
:else (.getRGB java.awt.Color/WHITE)))))
img)))
#object[p14$render_image 0x6152d303 "
p14$render_image@6152d303"
]
(render-image (update test-data :sand conj [500 8]) 10)

Core Logic

Now we have to code up the core logic of the puzzle. We start dropping sand, where the physics of sand is that it falls straight down if able, otherwise it tries to go down and left and finally it tries to go down and right.

(defn below-bottom?
"Are we above the bottom of the world's end?"
[Ω [_ y]]
(let [[_ [_ yhi]] (:bounds Ω)]
(> y yhi)))
#object[p14$below_bottom_QMARK_ 0x6d881fec "
p14$below_bottom_QMARK_@6d881fec"
]
(defn down [[x y]] [x (inc y)])
#object[p14$down 0x48d7aa61 "
p14$down@48d7aa61"
]
(defn down-left [[x y]] [(dec x) (inc y)])
#object[p14$down_left 0x3feaa2b3 "
p14$down_left@3feaa2b3"
]
(defn down-right [[x y]] [(inc x) (inc y)])
#object[p14$down_right 0x629f2844 "
p14$down_right@629f2844"
]
(defn solid? [Ω loc]
(or ((:rock Ω) loc) ((:sand Ω) loc)))
#object[p14$solid_QMARK_ 0x4f453c84 "
p14$solid_QMARK_@4f453c84"
]
(defn drop-sand [Ω]
(let [solid? (partial solid? Ω)
free? (complement solid?)
source (:source Ω)]
(loop [loc source]
(cond
(below-bottom? Ω loc) (assoc Ω :finished true)
(free? (down loc)) (recur (down loc))
(free? (down-left loc)) (recur (down-left loc))
(free? (down-right loc)) (recur (down-right loc))
:else
(if (= loc source)
(-> Ω
(assoc :finished true)
(update :sand conj loc))
(update Ω :sand conj loc))))))
#object[p14$drop_sand 0x3a3413af "
p14$drop_sand@3a3413af"
]
(defn fill-with-sand [Ω]
(first (drop-while (complement :finished) (iterate drop-sand Ω))))
#object[p14$fill_with_sand 0x5021c160 "
p14$fill_with_sand@5021c160"
]
(let [Ω test-data]
(let [finished (fill-with-sand Ω)]
(render-image finished 10)))
(let [Ω data]
(let [finished (fill-with-sand Ω)]
(def ans1 (count (:sand finished)))
(render-image finished 5)))
ans1 ;; = 745
745

Part 2

Now there is a big floor at the bottom that sand can land on and we have to keep filling up with sand until we block the source.

(defn add-floor [Ω]
(let [floor-y (+ 2 (second (second (:bounds Ω))))
[xs ys] (:source Ω)
rock (into (:rock Ω) (line [(- xs (inc floor-y)) floor-y] [(+ xs (inc floor-y)) floor-y]))
new-bounds (bounds rock)]
(-> Ω
(assoc :bounds new-bounds)
(assoc :rock rock))))
#object[p14$add_floor 0x4be71e28 "
p14$add_floor@4be71e28"
]
(let [Ω (add-floor test-data)]
(let [finished (fill-with-sand Ω)]
[(count (:sand finished))
(render-image finished 10)]))
[93
]
(let [Ω (add-floor data)]
(let [finished (fill-with-sand Ω)]
(def ans2 (count (:sand finished)))
(render-image finished 4)))
ans2 ;; = 27551
27551

Main

(defn -main [& _]
(println "Answer1: " ans1)
(println "Answer2: " ans2))
#object[p14$_main 0x2d20aacc "
p14$_main@2d20aacc"
]