eldridge.cam
Advent of Code solutions
1import "trilogy:io" use readline
2import "trilogy:debug" use dbg
3import "trilogy:iterator" as it
4import "trilogy:array" use collect, take, skip, length, all
5import "trilogy:heap" use heap
6import "trilogy:record" use contains_key
7import "trilogy:compare" use min
8
9slot GOAL = [
10 ['open, 'open, 'empty, 'open, 'empty, 'open, 'empty, 'open, 'empty, 'open, 'open],
11 ['A', 'A', 'A', 'A'],
12 ['B', 'B', 'B', 'B'],
13 ['C', 'C', 'C', 'C'],
14 ['D', 'D', 'D', 'D'],
15]
16
17func replace pos val array = [
18 ..take pos array,
19 val,
20 ..skip (pos + 1) array,
21]
22
23func cost 'A' = 1
24func cost 'B' = 10
25func cost 'C' = 100
26func cost 'D' = 1000
27
28proc eject!(value, position, depth, [spaces, ..stacks]) {
29 for pos in collect <| it::range position 10 {
30 match spaces.pos {
31 case 'open then yield 'next([replace pos value spaces, ..stacks]:cost value * (pos - position + depth))
32 case 'empty then continue unit
33 else break unit
34 }
35 }
36 for pos in collect <| it::range position 0 {
37 match spaces.pos {
38 case 'open then yield 'next([replace pos value spaces, ..stacks]:cost value * (position - pos + depth))
39 case 'empty then continue unit
40 else break unit
41 }
42 }
43}
44
45proc fall_in!(value, position, depth, [spaces, ..stacks]) {
46 for pos in collect <| it::range position 10 {
47 match spaces.pos {
48 case ^value then yield 'next([replace pos 'open spaces, ..stacks]:cost value * (pos - position + depth))
49 case 'empty then continue unit
50 case 'open then continue unit
51 }
52 break unit
53 }
54 for pos in collect <| it::range position 0 {
55 match spaces.pos {
56 case ^value then yield 'next([replace pos 'open spaces, ..stacks]:cost value * (position - pos + depth))
57 case 'empty then continue unit
58 case 'open then continue unit
59 }
60 break unit
61 }
62}
63
64func next_states [spaces, aa, bb, cc, dd] = do() {
65 match aa {
66 case ['A', 'A', 'A', 'A'] {}
67 case aas if all ((==) 'A') aas then fall_in!('A', 2, 4 - length aas, [spaces, [..aas, 'A'], bb, cc, dd])
68 case [..aas, v] then eject!(v, 2, 4 - length aas, [spaces, aas, bb, cc, dd])
69 }
70 match bb {
71 case ['C', 'C', 'C', 'C'] {}
72 case bbs if all ((==) 'B') bbs then fall_in!('B', 4, 4 - length bbs, [spaces, aa, [..bbs, 'B'], cc, dd])
73 case [..bbs, v] then eject!(v, 4, 4 - length bbs, [spaces, aa, bbs, cc, dd])
74 }
75 match cc {
76 case ['C', 'C', 'C', 'C'] {}
77 case ccs if all ((==) 'C') ccs then fall_in!('C', 6, 4 - length ccs, [spaces, aa, bb, [..ccs, 'C'], dd])
78 case [..ccs, v] then eject!(v, 6, 4 - length ccs, [spaces, aa, bb, ccs, dd])
79 }
80 match dd {
81 case ['D', 'D', 'D', 'D'] {}
82 case dds if all ((==) 'D') dds then fall_in!('D', 8, 4 - length dds, [spaces, aa, bb, cc, [..dds, 'D']])
83 case [..dds, v] then eject!(v, 8, 4 - length dds, [spaces, aa, bb, cc, dds])
84 }
85}
86
87proc main!() {
88 readline!()
89 readline!()
90 let upper = readline!()
91 let lower = readline!()
92 let initial = [
93 ['open, 'open, 'empty, 'open, 'empty, 'open, 'empty, 'open, 'empty, 'open, 'open],
94 [lower.3, 'D', 'D', upper.3],
95 [lower.5, 'B', 'C', upper.5],
96 [lower.7, 'A', 'B', upper.7],
97 [lower.9, 'C', 'A', upper.9],
98 ]
99 let min_heap = heap (fn _:a _:b. a <= b)
100 let queue = [initial:0]
101 let cache = {|"${initial}" => 0|}
102 while queue != [] {
103 let state:score = min_heap::pop!(queue)
104 if cache."${state}" < score {
105 continue unit
106 }
107 if state == GOAL {
108 dbg!(score)
109 exit 0
110 }
111 next_states state
112 |> it::map (fn state:cost. state:cost + score)
113 |> it::for_each do(entry and next_state:next_score) {
114 let key = "${next_state}"
115 if !(contains_key key cache) || cache.key > next_score {
116 cache.key = next_score
117 min_heap::push!(queue, entry)
118 }
119 }
120 }
121}