Day 17: Solve part 1 and 2

project.clj

@@ -3,7 +3,8 @@
   :url "https://adventofcode.com"
   :license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
             :url "https://www.eclipse.org/legal/epl-2.0/"}
-  :dependencies [[org.clojure/clojure "1.11.1"]]
+  :dependencies [[org.clojure/clojure "1.11.1"]
+                 [org.clojure/data.priority-map "1.1.0"]]
   :repl-options {:init-ns advent-of-code-2023.core}
   :test-selectors {:only-examples (fn [{:keys [name]}]
                                     (clojure.string/includes? (str name) "example"))})

src/advent_of_code_2023/day17.clj

@@ -1,9 +1,101 @@
 (ns advent-of-code-2023.day17
   (:require
-   [advent-of-code-2023.utils.string :as u]))
+   [advent-of-code-2023.utils.graph :as g]))
 
-(defn parse-input [input])
+(defn parse-input [input]
+  (g/parse-positional-map input))
 
-(defn day17-1 [parsed-input])
+(defn- assoc-to-priority-map [q [_ _ _ _ heat-loss :as n]]
+  (assoc q n heat-loss))
 
-(defn day17-2 [parsed-input])
+(defn- continue?-fn [{:keys [^long height ^long width]}]
+  (let [goal [(dec height) (dec width)]]
+    (fn [[x y]] (and x y (not= [x y] goal)))))
+
+(defn- neighbours [^long x ^long y dir]
+  (condp = dir
+    :none [[(inc x) y]
+           [x (inc y)]]
+    :north [[x (dec y)]
+            [(dec x) y]
+            [(inc x) y]]
+    :east [[x (dec y)]
+           [(inc x) y]
+           [x (inc y)]]
+    :south [[(dec x) y]
+            [(inc x) y]
+            [x (inc y)]]
+    :west [[x (dec y)]
+           [(dec x) y]
+           [x (inc y)]]))
+
+(defn- direction [[^long x ^long y] [^long xx ^long yy]]
+  (cond
+    (= (inc x) xx) :east
+    (= (dec x) xx) :west
+    (= (inc y) yy) :south
+    (= (dec y) yy) :north))
+
+(defn- valid-crucible-move?-fn [[x y ^long straight-moves dir]
+                                ^long min-straight-moves
+                                ^long max-straight-moves]
+  (fn [p]
+    (if (and (not= dir :none) (< straight-moves min-straight-moves))
+      (= (direction [x y] p) dir)
+      (or (< straight-moves max-straight-moves)
+          (not= (direction [x y] p) dir)))))
+
+(defn- visited?-fn [[x y ^long straight-moves dir] visited]
+  (fn [p]
+    (let [d (direction [x y] p)]
+      ((complement (visited p #{})) [(if (= d dir) (inc straight-moves) 0) d]))))
+
+(defn- next-state-fn [[x y ^long straight-moves dir ^long heat-loss] positions]
+  (fn [[xx yy :as p]]
+    (let [d (direction [x y] p)]
+      [xx yy (if (= d dir) (inc straight-moves) 0)
+       d (+ heat-loss ^long (positions p))])))
+
+(defn- neighbours-fn [{:keys [positions]}
+                      ^long min-straight-moves
+                      ^long max-straight-moves]
+  (fn [[x y _ dir :as state] visited]
+    (let [nz
+          (transduce
+           (comp
+            (filter (valid-crucible-move?-fn state
+                                             min-straight-moves
+                                             max-straight-moves))
+            (filter positions)
+            (filter (visited?-fn state visited)))
+           conj [] (neighbours x y dir))]
+      (mapv (next-state-fn state positions) nz))))
+
+(defn- visited-state [[x y sm dir heat-loss]]
+  [[x y] [sm dir] heat-loss])
+
+(defn- path-fn [{:keys [^long height ^long width]} ^long min-straight-moves]
+  (let [goal [(dec width) (dec height)]]
+    (fn ([] nil)
+      ([heat-loss [x y sm _ hl]]
+       (cond
+         (and sm (< ^long sm min-straight-moves)) heat-loss
+         (and heat-loss x y (= goal [x y])) (min ^long heat-loss ^long hl)
+         (= goal [x y]) hl
+         :else heat-loss)))))
+
+(defn day17 [heat-loss-map min-straight-moves max-straight-moves]
+  (let [start-state [0 0 0 :none 0]]
+    (g/dijkstra start-state
+                (continue?-fn heat-loss-map)
+                (neighbours-fn heat-loss-map min-straight-moves max-straight-moves)
+                visited-state
+                (path-fn heat-loss-map min-straight-moves)
+                {[0 0] #{}}
+                assoc-to-priority-map)))
+
+(defn day17-1 [heat-loss-map]
+  (day17 heat-loss-map 0 2))
+
+(defn day17-2 [heat-loss-map]
+  (day17 heat-loss-map 3 9))

src/advent_of_code_2023/utils/graph.clj

@@ -1,6 +1,7 @@
 (ns advent-of-code-2023.utils.graph
   (:require
    [clojure.string :as string]
+   [clojure.data.priority-map :as pm]
    [advent-of-code-2023.utils.string :as us]))
 
 (defn transitive-closure [initial-closure]
@@ -11,6 +12,29 @@
       initial-closure
       (recur new-closure))))
 
+(defn- assoc-to-visited
+  ([visited] visited)
+  ([visited [p dir]]
+   (update visited p (fnil conj #{}) dir)))
+
+(defn dijkstra [start-state continue? neighbours visited-state path-fn visited assoc-to-priority-map]
+  (loop [q (pm/priority-map start-state 0)
+         visited visited
+         path-val (path-fn)]
+    (let [[c] (first q)
+          q (if (seq q) (pop q) nil)]
+      (cond
+        (continue? c) (let [nz (neighbours c visited)]
+                        (recur (reduce assoc-to-priority-map q nz)
+                               (transduce
+                                (map visited-state)
+                                assoc-to-visited visited nz)
+                               (path-fn path-val c)))
+        (seq q) (recur q
+                       visited
+                       (path-fn path-val c))
+        :else (path-fn path-val c)))))
+
 (defn pruning-bfs [start-state neighbours visited-state branch-score continue? path-fn]
   (loop [q (conj clojure.lang.PersistentQueue/EMPTY start-state)
          visited #{}

test/advent_of_code_2023/day17_test.clj

@@ -4,26 +4,45 @@
    [advent-of-code-2023.day17 :refer :all]
    [advent-of-code-2023.test-utils :as tu]))
 
-(defonce ^:private example-input (parse-input ""))
+(defonce ^:private example-input (parse-input "2413432311323
+3215453535623
+3255245654254
+3446585845452
+4546657867536
+1438598798454
+4457876987766
+3637877979653
+4654967986887
+4564679986453
+1224686865563
+2546548887735
+4322674655533"))
+
+(defonce ^:private example-input-2 (parse-input "111111111111
+999999999991
+999999999991
+999999999991
+999999999991"))
+
 
 (def ^:private input (parse-input (tu/slurp-input "resources/day17.txt")))
 
 (deftest day17-1-example-test
   (testing "day17-1 example"
-    (is (= nil
-           (day17-1 example-input)))))
+    (is (= 102 (day17-1 example-input)))))
 
 (deftest day17-1-test
   (testing "day17-1"
-    (is (= nil
-           (day17-1 input)))))
+    (is (= 847 (day17-1 input)))))
 
 (deftest day17-2-example-test
   (testing "day17-2 example"
-    (is (= nil
-           (day17-2 example-input)))))
+    (is (= 94 (day17-2 example-input)))))
+
+(deftest day17-2-example-2-test
+  (testing "day17-2 example 2"
+    (is (= 71 (day17-2 example-input-2)))))
 
 (deftest day17-2-test
   (testing "day17-2"
-    (is (= nil
-           (day17-2 input)))))
+    (is (= 997 (day17-2 input)))))