Skip to content

Commit 1bcf0e8

Browse files
rgmrgm
committed
Advent of Code Day 23
1 parent 7228567 commit 1bcf0e8

File tree

5 files changed

+345
-0
lines changed

5 files changed

+345
-0
lines changed

‎2023/202312-advent-of-code/23/day_23_1.clj‎

Lines changed: 100 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,100 @@
1+
(ns day-23-1
2+
"General approach: make a digraph joining points, use DFS to enumerate all
3+
paths, pick the longest. Needs to be a digraph to accommodate the slides."
4+
(:require
5+
[clojure.string :as str]
6+
[clojure.test :as t :refer [deftest is]]
7+
[ubergraph.core :as uber]))
8+
9+
;; a . has undirected edges to any adjacent node
10+
;; a > has a directed edge only to the node it points to
11+
12+
(defn char-at [rows [x y]]
13+
(try (-> rows (nth y) (nth x)) (catch IndexOutOfBoundsException _ nil)))
14+
15+
(defn on-path? [ch] (and ch (not= \# ch)))
16+
17+
(defn neighbours [mp [x y]]
18+
(let [pts (for [[dx dy] [[0 -1] [1 0] [0 1] [-1 0]]]
19+
[(+ x dx) (+ y dy)])]
20+
(->> pts
21+
(map (fn [pt] {:pt pt :ch (char-at mp pt)}))
22+
(filter (comp on-path? :ch)))))
23+
24+
(defn find-neighbours
25+
"Turn the trail map tm into a set of directed edges."
26+
[tm]
27+
(for [y (range (inc (count (first tm))))
28+
x (range (inc (count tm)))
29+
:let [pt [x y]
30+
ch (char-at tm pt)]
31+
:when (on-path? ch)]
32+
{:pt pt
33+
:ch ch
34+
:neighbours (neighbours tm pt)}))
35+
36+
(defn above? [[x1 y1] [x2 y2]] (and (= x1 x2) (< y2 y1)))
37+
(defn below? [[x1 y1] [x2 y2]] (and (= x1 x2) (< y1 y2)))
38+
(defn left? [[x1 y1] [x2 y2]] (and (= y1 y2) (< x2 x1)))
39+
(defn right? [[x1 y1] [x2 y2]] (and (= y1 y2) (< x1 x2)))
40+
41+
(deftest test-preds
42+
(is (above? [1 1] [1 0]))
43+
(is (below? [1 1] [1 2]))
44+
(is (left? [1 1] [0 1]))
45+
(is (right? [1 1] [2 1])))
46+
47+
(defn make-edges [{:keys [pt ch neighbours]}]
48+
(let [direction? (case ch
49+
\> right?
50+
\v below?
51+
\^ above?
52+
\< left?
53+
(constantly true))
54+
pred (comp (partial direction? pt) :pt)]
55+
(->> neighbours
56+
(filter pred)
57+
(map (fn [{next-pt :pt}] [pt next-pt])))))
58+
59+
(defn read-input [path]
60+
(->> (slurp path)
61+
(str/split-lines)
62+
find-neighbours
63+
(mapcat make-edges)
64+
(apply uber/digraph)))
65+
66+
(defn find-all-paths
67+
[next-nodes-fn node target-node]
68+
(letfn [(dfs [path paths]
69+
(if (= (peek path) target-node)
70+
(conj paths path)
71+
(reduce
72+
(fn [acc next-node]
73+
(if (not (some #{next-node} path))
74+
(dfs (conj path next-node) acc)
75+
acc))
76+
paths
77+
(next-nodes-fn (peek path)))))]
78+
(dfs [node] [])))
79+
80+
(defn longest-hike-length [g start end]
81+
(->> (find-all-paths (partial uber/successors g) start end)
82+
(map count)
83+
(apply max)
84+
;; path len is number of nodes minus 1
85+
(dec)))
86+
87+
(deftest test-longest-hike
88+
(is (= 94 (longest-hike-length (read-input "test.txt") [1 0] [21 22]))))
89+
90+
(comment
91+
(def g (read-input "test.txt"))
92+
(uber/pprint g)
93+
(uber/viz-graph g {:save {:filename "test.dot" :format :dot}})
94+
(time (longest-hike-length g [1 0] [21 22]))
95+
96+
(def g2 (read-input "input.txt"))
97+
(uber/viz-graph g2 {:save {:filename "input.dot" :format :dot}})
98+
(time
99+
; (out) "Elapsed time: 15985.59875 msecs"
100+
(longest-hike-length g2 [1 0] [139 140]))) ; 2162

‎2023/202312-advent-of-code/23/day_23_2.clj‎

Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
1+
(ns day-23-2
2+
"Still brute-force, but:
3+
- a graph suffices (not a digraph) since we don't have slides
4+
- the trick I stole from the reddit thread was to contract the graph into
5+
just weighted edges between intersections (ie. nodes with > 2 out edges),
6+
since these are the only decision points.
7+
8+
Even so it's about 13 min to produce a result."
9+
(:require
10+
[clojure.pprint :as pp]
11+
[clojure.string :as str]
12+
[clojure.test :as t :refer [deftest is]]
13+
[ubergraph.alg :as alg]
14+
[ubergraph.core :as uber]))
15+
16+
(defn char-at [rows [x y]]
17+
(try (-> rows (nth y) (nth x))
18+
(catch IndexOutOfBoundsException _ nil)))
19+
20+
(defn on-path? [ch] (and ch (not= \# ch)))
21+
22+
(defn neighbours [mp [x y]]
23+
(let [pts (for [[dx dy] [[0 -1] [1 0] [0 1] [-1 0]]]
24+
[(+ x dx) (+ y dy)])]
25+
(->> pts
26+
(map (fn [pt] {:pt pt :ch (char-at mp pt)}))
27+
(filter (comp on-path? :ch)))))
28+
29+
(defn find-neighbours
30+
"Turn the trail map tm into a set of directed edges."
31+
[tm]
32+
(for [y (range (inc (count (first tm))))
33+
x (range (inc (count tm)))
34+
:let [pt [x y] ch (char-at tm pt)]
35+
:when (on-path? ch)]
36+
{:pt pt :ch ch :neighbours (neighbours tm pt)}))
37+
38+
(defn make-edges [{:keys [pt neighbours]}]
39+
(let [weight 1]
40+
(map (fn [{next-pt :pt}] [pt next-pt weight]) neighbours)))
41+
42+
(defn read-input [path]
43+
(->> (slurp path)
44+
(str/split-lines)
45+
find-neighbours
46+
(mapcat make-edges)
47+
(apply uber/graph)))
48+
49+
(defn find-all-paths
50+
"Finds all paths from node to target-node in a graph."
51+
[next-nodes-fn node target-node]
52+
(letfn [(dfs [path paths]
53+
(if (= (peek path) target-node)
54+
(conj paths path)
55+
(reduce
56+
(fn [acc next-node]
57+
(if (not (some #{next-node} path))
58+
(dfs (conj path next-node) acc)
59+
acc))
60+
paths
61+
(next-nodes-fn (peek path)))))]
62+
(dfs [node] [])))
63+
64+
(defn compress-graph
65+
"Compress graph to just intersections, with weighted edges between them."
66+
[g]
67+
(let [sum-weights (fn [g edges]
68+
(->> edges
69+
(map #(uber/attr g % :weight))
70+
(reduce +)))
71+
rf (fn [g node]
72+
(let [edges (uber/out-edges g node)]
73+
(if (not= 2 (count edges))
74+
g
75+
(let [dests (mapv :dest edges)
76+
weight (sum-weights g edges)]
77+
(-> g
78+
(uber/remove-nodes node)
79+
(uber/add-edges (conj dests weight)))))))]
80+
(reduce rf g (alg/pre-traverse g))))
81+
82+
(defn hike-length [g path]
83+
(let [node-pairs (partition 2 1 path)
84+
edges (map #(apply uber/find-edge g %) node-pairs)
85+
steps (map #(uber/attr g % :weight) edges)]
86+
(pp/pprint (map (fn [p w] {:path p :steps w}) node-pairs steps))
87+
(reduce + steps)))
88+
89+
(defn all-hikes [g start end]
90+
(find-all-paths (partial uber/successors g) start end))
91+
92+
(defn longest-hike [g start end]
93+
(some->> (all-hikes g start end)
94+
(sort-by (partial hike-length g))
95+
last))
96+
97+
(deftest test-longest-hike
98+
(let [g (compress-graph (read-input "test.txt"))
99+
hike (longest-hike g [1 0] [21 22])
100+
steps (hike-length g hike)]
101+
(is (= 154 steps))))
102+
103+
(comment
104+
(def g (read-input "test.txt"))
105+
(time (longest-hike g [1 0] [21 22]))
106+
(uber/pprint (compress-graph g))
107+
(uber/viz-graph g {:auto-label true})
108+
(def g2 (compress-graph (read-input "input.txt")))
109+
(uber/viz-graph g2 {:auto-label true
110+
:save {:filename "input.dot" :format :dot}})
111+
(uber/pprint g2)
112+
(def hikes (time (all-hikes g2 [1 0] [139 140])))
113+
(time
114+
; (out) "Elapsed time: 799421.29002 msecs"
115+
(hike-length g2 (longest-hike g2 [1 0] [139 140])))) ; 6334

‎2023/202312-advent-of-code/23/deps.edn‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
{:paths ["."]
2+
:deps {com.taoensso/tufte {:mvn/version "2.6.3"}
3+
criterium/criterium {:mvn/version "0.4.6"}
4+
instaparse/instaparse {:mvn/version "1.4.12"}
5+
net.cgrand/xforms {:mvn/version "0.19.5"}
6+
org.clojure/core.match {:mvn/version "1.0.1"}
7+
org.clojure/math.combinatorics {:mvn/version "0.2.0"}
8+
ubergraph/ubergraph {:mvn/version "0.8.2"}}}

‎2023/202312-advent-of-code/23/test.dot‎

Lines changed: 99 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,99 @@
1+
digraph {
2+
graph [layout=dot];
3+
"[75 131]";
4+
"[19 65]";
5+
"[107 109]";
6+
"[1 0]";
7+
"[55 131]";
8+
"[113 13]";
9+
"[15 19]";
10+
"[75 19]";
11+
"[31 135]";
12+
"[125 111]";
13+
"[103 137]";
14+
"[135 61]";
15+
"[53 105]";
16+
"[35 89]";
17+
"[65 81]";
18+
"[19 85]";
19+
"[101 61]";
20+
"[29 111]";
21+
"[127 89]";
22+
"[61 11]";
23+
"[77 109]";
24+
"[133 31]";
25+
"[129 137]";
26+
"[139 140]";
27+
"[83 65]";
28+
"[9 99]";
29+
"[41 53]";
30+
"[57 55]";
31+
"[65 43]";
32+
"[109 31]";
33+
"[87 83]";
34+
"[29 39]";
35+
"[37 7]";
36+
"[113 81]";
37+
"[9 37]";
38+
"[79 39]";
39+
"[75 131]" -> "[103 137]" [dir=none,weight=134];
40+
"[75 131]" -> "[77 109]" [dir=none,weight=172];
41+
"[19 65]" -> "[19 85]" [dir=none,weight=216];
42+
"[19 65]" -> "[9 37]" [dir=none,weight=258];
43+
"[107 109]" -> "[77 109]" [dir=none,weight=182];
44+
"[1 0]" -> "[15 19]" [dir=none,weight=177];
45+
"[55 131]" -> "[75 131]" [dir=none,weight=140];
46+
"[55 131]" -> "[53 105]" [dir=none,weight=156];
47+
"[113 13]" -> "[133 31]" [dir=none,weight=326];
48+
"[15 19]" -> "[9 37]" [dir=none,weight=164];
49+
"[75 19]" -> "[113 13]" [dir=none,weight=308];
50+
"[75 19]" -> "[61 11]" [dir=none,weight=174];
51+
"[31 135]" -> "[55 131]" [dir=none,weight=148];
52+
"[31 135]" -> "[29 111]" [dir=none,weight=170];
53+
"[125 111]" -> "[127 89]" [dir=none,weight=176];
54+
"[125 111]" -> "[107 109]" [dir=none,weight=104];
55+
"[103 137]" -> "[129 137]" [dir=none,weight=166];
56+
"[103 137]" -> "[107 109]" [dir=none,weight=148];
57+
"[135 61]" -> "[101 61]" [dir=none,weight=178];
58+
"[135 61]" -> "[133 31]" [dir=none,weight=188];
59+
"[53 105]" -> "[29 111]" [dir=none,weight=154];
60+
"[53 105]" -> "[65 81]" [dir=none,weight=168];
61+
"[35 89]" -> "[65 81]" [dir=none,weight=150];
62+
"[35 89]" -> "[41 53]" [dir=none,weight=238];
63+
"[65 81]" -> "[87 83]" [dir=none,weight=72];
64+
"[65 81]" -> "[57 55]" [dir=none,weight=166];
65+
"[19 85]" -> "[35 89]" [dir=none,weight=56];
66+
"[101 61]" -> "[83 65]" [dir=none,weight=126];
67+
"[29 111]" -> "[9 99]" [dir=none,weight=132];
68+
"[29 111]" -> "[35 89]" [dir=none,weight=92];
69+
"[127 89]" -> "[135 61]" [dir=none,weight=228];
70+
"[127 89]" -> "[113 81]" [dir=none,weight=66];
71+
"[61 11]" -> "[37 7]" [dir=none,weight=164];
72+
"[77 109]" -> "[53 105]" [dir=none,weight=116];
73+
"[77 109]" -> "[87 83]" [dir=none,weight=204];
74+
"[133 31]" -> "[109 31]" [dir=none,weight=164];
75+
"[129 137]" -> "[125 111]" [dir=none,weight=234];
76+
"[139 140]" -> "[129 137]" [dir=none,weight=29];
77+
"[83 65]" -> "[57 55]" [dir=none,weight=104];
78+
"[83 65]" -> "[79 39]" [dir=none,weight=190];
79+
"[9 99]" -> "[31 135]" [dir=none,weight=382];
80+
"[9 99]" -> "[19 85]" [dir=none,weight=140];
81+
"[41 53]" -> "[19 65]" [dir=none,weight=102];
82+
"[41 53]" -> "[29 39]" [dir=none,weight=74];
83+
"[57 55]" -> "[41 53]" [dir=none,weight=102];
84+
"[57 55]" -> "[65 43]" [dir=none,weight=64];
85+
"[65 43]" -> "[79 39]" [dir=none,weight=34];
86+
"[65 43]" -> "[61 11]" [dir=none,weight=220];
87+
"[109 31]" -> "[101 61]" [dir=none,weight=230];
88+
"[109 31]" -> "[113 13]" [dir=none,weight=90];
89+
"[109 31]" -> "[79 39]" [dir=none,weight=210];
90+
"[87 83]" -> "[113 81]" [dir=none,weight=136];
91+
"[87 83]" -> "[83 65]" [dir=none,weight=66];
92+
"[29 39]" -> "[65 43]" [dir=none,weight=172];
93+
"[29 39]" -> "[37 7]" [dir=none,weight=264];
94+
"[37 7]" -> "[15 19]" [dir=none,weight=158];
95+
"[113 81]" -> "[107 109]" [dir=none,weight=178];
96+
"[113 81]" -> "[101 61]" [dir=none,weight=120];
97+
"[9 37]" -> "[29 39]" [dir=none,weight=94];
98+
"[79 39]" -> "[75 19]" [dir=none,weight=68];
99+
}

‎2023/202312-advent-of-code/23/test.txt‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
#.#####################
2+
#.......#########...###
3+
#######.#########.#.###
4+
###.....#.>.>.###.#.###
5+
###v#####.#v#.###.#.###
6+
###.>...#.#.#.....#...#
7+
###v###.#.#.#########.#
8+
###...#.#.#.......#...#
9+
#####.#.#.#######.#.###
10+
#.....#.#.#.......#...#
11+
#.#####.#.#.#########v#
12+
#.#...#...#...###...>.#
13+
#.#.#v#######v###.###v#
14+
#...#.>.#...>.>.#.###.#
15+
#####v#.#.###v#.#.###.#
16+
#.....#...#...#.#.#...#
17+
#.#########.###.#.#.###
18+
#...###...#...#...#.###
19+
###.###.#.###v#####v###
20+
#...#...#.#.>.>.#.>.###
21+
#.###.###.#.###.#.#v###
22+
#.....###...###...#...#
23+
#####################.#

0 commit comments

Comments
 (0)