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
155
|
module Day17
open System.IO
open FSharpPlus
open Common
type Dir =
| Left
| Right
static member movesFromInput(input: string) =
input
|> String.trimWhiteSpaces
|> Seq.map Dir.fromChar
|> List.ofSeq
static member private fromChar =
function
| '<' -> Left
| '>' -> Right
| c -> failwithf "Invalid character: %c" c
static member shiftOp =
function
| Left -> (<<<)
| Right -> (>>>)
module Row =
let full = 0b1111111uy
let empty = 0b0000000uy
let private countBlocks row =
let rec helper =
function
| 0uy -> 0
| n -> int (n &&& 1uy) + helper (n >>> 1)
helper (row &&& full)
let shift dir shape settled =
let shape' = (Dir.shiftOp dir) shape 1
let overflow = countBlocks shape' <> countBlocks shape
let collision = shape' &&& settled <> empty
match overflow || collision with
| true -> None
| false -> Some(shape')
module Chamber =
let private shapes =
[ [ 0b0011110uy ] // horizontal line
[ 0b0001000uy
0b0011100uy
0b0001000uy ] // cross
[ 0b0000100uy
0b0000100uy
0b0011100uy ] // L-shape
[ 0b0010000uy
0b0010000uy
0b0010000uy
0b0010000uy ] // vertical line
[ 0b0011000uy; 0b0011000uy ] ] // square
let private makeSpaceFor shape settled =
(List.replicate (List.length shape + 3) Row.empty)
@ settled
let private shift dir (shape, settled) =
let shiftedRows = List.map2Shortest (Row.shift dir) shape settled
let shape =
shiftedRows
|> Util.liftList
|> Option.defaultValue shape
shape, settled
let private fall (shape, settled) =
let (shape', settled') =
match settled with
| [ _ ] -> [], shape
| h :: t when h = Row.empty -> shape, t
| _ -> Row.empty :: shape, settled
let collision =
List.map2Shortest (&&&) shape' settled'
|> List.exists ((<>) Row.empty)
if collision then
[],
(List.map2Shortest (|||) shape settled)
@ List.skip (List.length shape) settled
else
shape', settled'
let private stateFingerprint moves shapes tower =
hash (moves, List.head shapes, List.truncate 128 tower)
let towerHeight n moves =
let rec helper (moves, shapes, tower, cache, n) =
let cacheKey = stateFingerprint moves shapes tower
let towerHeight = int64 <| List.length tower
if Map.containsKey cacheKey cache then
let (oldCount, oldHeight) = cache[cacheKey]
let countDiff = oldCount - n
let heightDiff = towerHeight - oldHeight
let skippedCycles = n / countDiff
let skippedHeight = skippedCycles * heightDiff
let leftoverCount = n - skippedCycles * countDiff + 1L
skippedHeight
+ helper (moves, shapes, tower, Map.empty, leftoverCount)
else
let cache = cache |> Map.add cacheKey (n, towerHeight)
let (shape, shapes) = Util.cycle shapes
let tower = tower |> makeSpaceFor shape
let rec step moves shape tower =
let (move, moves) = Util.cycle moves
let (shape, tower) = shift move (shape, tower)
let (shape, tower) = fall (shape, tower)
if List.isEmpty shape then
(moves, tower)
else
step moves shape tower
let (moves, tower) = step moves shape tower
let n = n - 1L
if n = 0L then
towerHeight
else
helper (moves, shapes, tower, cache, n)
helper (moves, shapes, [], Map.empty, n)
let solution n =
Dir.movesFromInput >> Chamber.towerHeight n
let test = File.ReadAllText("test.txt")
assert (solution 2022 test = 3068)
assert (solution 1_000_000_000_000L test = 1514285714288L)
let input = File.ReadAllText("input.txt")
printfn "%d" <| solution 2022 input
printfn "%d" <| solution 1_000_000_000_000L input
|
