-
Notifications
You must be signed in to change notification settings - Fork 10
/
Day17.fs
80 lines (70 loc) · 3.08 KB
/
Day17.fs
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
module Year2018Day17
open AdventOfCode.FSharp.Common
let asScan (str : string) =
let isX = str.[0] = 'x'
let single, range = splitBy ", " (fun p -> int p.[0].[2..], p.[1]) str
let range1, range2 = splitBy ".." (fun p -> int p.[0], int p.[1]) range.[2..]
if isX then
(single, range1), (single, range2)
else
(range1, single), (range2, single)
let getYBounds =
let updateBounds (minY, maxY) (y1, y2) = min minY y1, max maxY y2
Seq.map (fun ((_, y1), (_, y2)) -> (y1, y2))
>> Seq.reduce updateBounds
type Tile = Clay | Sand | StillWater | MovingWater
let search x y dir grid sources =
let rec search' x =
let current = Map.tryFind (x, y) grid
let below = Map.tryFind (x, y + 1) grid
match (current, below) with
| (Some Clay, _) -> x - dir, false, sources
| (_, None) | (_, Some Sand) -> x, true, (x, y) :: sources
| (Some MovingWater, Some MovingWater) -> x, true, sources
| _ -> search' (x + dir)
search' x
let processWaterSource maxY grid (x, y) =
match Map.tryFind (x, y) grid with
| Some MovingWater ->
let rec processYPos grid sources y =
match Map.tryFind (x, y) grid with
| _ when (y > maxY) -> grid, sources
| Some MovingWater -> grid, sources
| Some Clay | Some StillWater ->
let prevY = y - 1
let left, leftOverflow, sources = search x prevY (-1) grid sources
let right, rightOverflow, sources = search x prevY 1 grid sources
let isOverflow = leftOverflow || rightOverflow
let tileType = if isOverflow then MovingWater else StillWater
let grid =
seq { for x = left to right do yield ((x, prevY), tileType)}
|> Seq.fold (fun grid (k, v) -> Map.add k v grid) grid
processYPos grid sources prevY
| Some Sand | None ->
processYPos (grid |> Map.add (x, y) MovingWater) sources (y + 1)
processYPos grid [] (y + 1)
| _ -> grid, []
let simulate grid bounds initialSource =
let rec simulate' grid sources =
match sources with
| [] -> grid
| src :: srcs ->
let grid', newSources = processWaterSource bounds grid src
let newSources' = List.fold (fun xs x -> x :: xs) srcs newSources
simulate' grid' newSources'
simulate' (grid |> Map.add initialSource MovingWater) [initialSource]
let getCounts scans =
let minY, maxY = getYBounds scans
let grid = seq {
for (x1, y1), (x2, y2) in scans do
for x = x1 to x2 do
for y = y1 to y2 do
yield (x, y), Clay } |> Map.ofSeq
simulate grid maxY (500, 0)
|> Map.toSeq
|> Seq.filter (fun ((_, y), _) -> minY <= y && y <= maxY)
|> Seq.countBy snd
|> Map.ofSeq
let solvePart1 = getCounts >> (fun counts -> Map.find StillWater counts + Map.find MovingWater counts)
let solvePart2 = getCounts >> Map.find StillWater
let solver = {parse = parseEachLine asScan; part1 = solvePart1; part2 = solvePart2}