This commit is contained in:
Patrick Stevens
2022-12-17 16:44:30 +00:00
committed by GitHub
parent c4be907aa7
commit b40066eab4
12 changed files with 418 additions and 71 deletions

View File

@@ -26,6 +26,7 @@
<EmbeddedResource Include="..\AdventOfCode2022.Test\Inputs\Day14.txt" />
<EmbeddedResource Include="..\AdventOfCode2022.Test\Inputs\Day15.txt" />
<EmbeddedResource Include="..\AdventOfCode2022.Test\Inputs\Day16.txt" />
<EmbeddedResource Include="..\AdventOfCode2022.Test\Inputs\Day17.txt" />
</ItemGroup>
<ItemGroup>

View File

@@ -2,5 +2,5 @@ namespace AdventOfCode2022.App
[<RequireQualifiedAccess>]
module Inputs =
let days = Array.init 16 (fun day -> Assembly.readResource $"Day%i{day + 1}.txt")
let days = Array.init 17 (fun day -> Assembly.readResource $"Day%i{day + 1}.txt")
let inline day (i : int) = days.[i - 1]

View File

@@ -61,7 +61,7 @@ type Benchmark16To20 () =
[<GlobalSetup>]
member _.Setup () = Run.shouldWrite <- false
[<Params(16)>]
[<Params(16, 17)>]
member val Day = 0 with get, set
[<Params(false, true)>]

View File

@@ -232,6 +232,20 @@ module Run =
if shouldWrite then
printfn "%i" output
let day17 (partTwo : bool) (input : string) =
let day17 = input.TrimEnd ()
if not partTwo then
let output = Day17.part1 day17
if shouldWrite then
printfn "%i" output
else
let output = Day17.part2 day17
if shouldWrite then
printfn "%i" output
let allRuns =
[|
day1
@@ -250,4 +264,5 @@ module Run =
day14
day15
day16
day17
|]

View File

@@ -24,6 +24,7 @@
<Compile Include="Day14.fs" />
<Compile Include="Day15.fs" />
<Compile Include="Day16.fs" />
<Compile Include="Day17.fs" />
<EmbeddedResource Include="Inputs\Day1.txt" />
<EmbeddedResource Include="Inputs\Day2.txt" />
<EmbeddedResource Include="Inputs\Day3.txt" />
@@ -40,6 +41,7 @@
<EmbeddedResource Include="Inputs\Day14.txt" />
<EmbeddedResource Include="Inputs\Day15.txt" />
<EmbeddedResource Include="Inputs\Day16.txt" />
<EmbeddedResource Include="Inputs\Day17.txt" />
</ItemGroup>
<ItemGroup>

View File

@@ -22,8 +22,8 @@ Valve JJ has flow rate=21; tunnel leads to valve II
[<Test>]
let ``seq behaviour`` () =
Day16.ofSeq [ 1 ; 2 ; 3 ; 16 ]
|> Day16.toSeq
IntSet.ofSeq [ 1 ; 2 ; 3 ; 16 ]
|> IntSet.toSeq
|> List.ofSeq
|> shouldEqual [ 1 ; 2 ; 3 ; 16 ]

View File

@@ -0,0 +1,31 @@
namespace AdventOfCode2022.Test
open NUnit.Framework
open FsUnitTyped
open AdventOfCode2022
[<TestFixture>]
module TestDay17 =
let input = ">>><<><>><<<>><>>><<<>>><<<><<<>><>><<>>"
[<Test>]
let ``Part 1, given`` () =
Day17.part1 (input.TrimEnd ()) |> shouldEqual 3068
[<Test>]
let ``Part 1`` () =
let input = Assembly.readResource "Day17.txt"
Day17.part1 (input.TrimEnd ()) |> shouldEqual 3127
[<Test>]
let ``Part 2, given`` () =
Day17.part2 (input.TrimEnd ()) |> shouldEqual 1514285714288L
[<Test>]
let ``Part 2`` () =
let input = Assembly.readResource "Day17.txt"
Day17.part2 (input.TrimEnd ()) |> shouldEqual 1542941176480L

File diff suppressed because one or more lines are too long

View File

@@ -8,6 +8,7 @@
<ItemGroup>
<Compile Include="EfficientString.fs" />
<Compile Include="IntSet.fs" />
<Compile Include="Arr2D.fs" />
<Compile Include="Day1.fs" />
<Compile Include="Day2.fs" />
@@ -26,6 +27,7 @@
<Compile Include="Day14.fs" />
<Compile Include="Day15.fs" />
<Compile Include="Day16.fs" />
<Compile Include="Day17.fs" />
</ItemGroup>
<ItemGroup>

View File

@@ -82,57 +82,11 @@ module Day16 =
fun v1 v2 -> go Set.empty v1 v2 |> Option.get
type NodeSet = int64
let inline setNode (set : NodeSet) (nodeId : int) : NodeSet = set ||| (1L <<< nodeId)
let inline getNode (set : NodeSet) (nodeId : int) : bool = set &&& (1L <<< nodeId) <> 0
let ofSeq (nodes : Node seq) : NodeSet = (0L, nodes) ||> Seq.fold setNode
let toSeq (nodes : NodeSet) : Node seq =
seq {
let mutable nodes = nodes
let mutable count = 0
while nodes > 0 do
if nodes % 2L = 1L then
yield count
nodes <- nodes >>> 1
count <- count + 1
}
let count (nodes : NodeSet) : int =
let mutable nodes = nodes
let mutable ans = 0
while nodes > 0 do
if nodes % 2L = 1L then
ans <- ans + 1
nodes <- nodes >>> 1
ans
let first (nodes : NodeSet) : int =
let mutable nodes = nodes
let mutable count = 0
let mutable ans = 0
let mutable keepGoing = true
while keepGoing && nodes > 0 do
if nodes % 2L = 1L then
ans <- count
keepGoing <- false
nodes <- nodes >>> 1
count <- count + 1
ans
let part1 (lines : string seq) : int =
let valves, aaNode = parse lines
let allTaps = valves |> Map.filter (fun _ (x, _) -> x > 0) |> Map.keys |> ofSeq
let allTaps =
valves |> Map.filter (fun _ (x, _) -> x > 0) |> Map.keys |> IntSet.ofSeq
let getShortestPathLength = getShortestPathLength valves
@@ -143,15 +97,15 @@ module Day16 =
use ptr = fixed pathWeightsStorage
let pathWeights = Arr2D.zeroCreate<int> ptr valves.Count valves.Count
#endif
for v1 in toSeq allTaps do
for v2 in toSeq allTaps do
for v1 in IntSet.toSeq allTaps do
for v2 in IntSet.toSeq allTaps do
let length = getShortestPathLength v1 v2
Arr2D.set pathWeights v1 v2 length
let rec go
(timeRemainingOnCurrentPath : int)
(headingTo : Node)
(alreadyOn : NodeSet)
(alreadyOn : IntSet)
(currentWeight : int)
(remaining : int)
=
@@ -161,7 +115,7 @@ module Day16 =
go (timeRemainingOnCurrentPath - 1) headingTo alreadyOn currentWeight (remaining - 1)
else
let alreadyOn = setNode alreadyOn headingTo
let alreadyOn = IntSet.set alreadyOn headingTo
let mutable allTaps = allTaps &&& (~~~alreadyOn)
let mutable count = 0
@@ -216,7 +170,8 @@ module Day16 =
let valves, aaNode = parse lines
let valvesIndexed = valves |> Map.values |> Array.ofSeq
let allTaps = valves |> Map.filter (fun _ (x, _) -> x > 0) |> Map.keys |> ofSeq
let allTaps =
valves |> Map.filter (fun _ (x, _) -> x > 0) |> Map.keys |> IntSet.ofSeq
let getShortestPathLength = getShortestPathLength valves
@@ -228,8 +183,8 @@ module Day16 =
let pathWeights = Arr2D.zeroCreate<int> ptr valves.Count valves.Count
#endif
for v1 in toSeq allTaps do
for v2 in toSeq allTaps do
for v1 in IntSet.toSeq allTaps do
for v2 in IntSet.toSeq allTaps do
let length = getShortestPathLength v1 v2
Arr2D.set pathWeights v1 v2 length
@@ -238,7 +193,7 @@ module Day16 =
(journey2 : int)
(headingTo1 : Node)
(headingTo2 : Node)
(alreadyOn : NodeSet)
(alreadyOn : IntSet)
(currentWeight : int)
(remaining : int)
=
@@ -249,14 +204,14 @@ module Day16 =
elif journey1 = 0 && journey2 > 0 then
let addToWeight =
if getNode alreadyOn headingTo1 then
if IntSet.contains alreadyOn headingTo1 then
0
else
(remaining - 1) * (fst valvesIndexed.[headingTo1])
let newWeight = addToWeight + currentWeight
let alreadyOn = setNode alreadyOn headingTo1
let alreadyOn = IntSet.set alreadyOn headingTo1
let mutable allTaps = allTaps &&& ~~~alreadyOn
let mutable node = 0
@@ -292,14 +247,14 @@ module Day16 =
elif journey2 = 0 && journey1 > 0 then
let addToWeight =
if getNode alreadyOn headingTo2 then
if IntSet.contains alreadyOn headingTo2 then
0
else
fst valvesIndexed.[headingTo2] * (remaining - 1)
let newWeight = addToWeight + currentWeight
let alreadyOn = setNode alreadyOn headingTo2
let alreadyOn = IntSet.set alreadyOn headingTo2
let mutable allTaps = allTaps &&& ~~~alreadyOn
let mutable node = 0
@@ -336,13 +291,13 @@ module Day16 =
else
// Both reached destination at same time
let addToWeight1 =
if getNode alreadyOn headingTo1 then
if IntSet.contains alreadyOn headingTo1 then
0
else
(remaining - 1) * fst valvesIndexed.[headingTo1]
let addToWeight2 =
if getNode alreadyOn headingTo2 then
if IntSet.contains alreadyOn headingTo2 then
0
else
(remaining - 1) * fst valvesIndexed.[headingTo2]
@@ -353,11 +308,11 @@ module Day16 =
else
addToWeight1 + currentWeight
let alreadyOn = setNode (setNode alreadyOn headingTo1) headingTo2
let alreadyOn = IntSet.set (IntSet.set alreadyOn headingTo1) headingTo2
let nextChoices = allTaps &&& ~~~alreadyOn
if count nextChoices >= 2 then
if IntSet.count nextChoices >= 2 then
let mutable maxVal = Int32.MinValue
let mutable next1 = nextChoices
@@ -395,12 +350,12 @@ module Day16 =
0
else
// nextChoices.Count = 1
let next = first nextChoices
let next = IntSet.first nextChoices
go 100000 (Arr2D.get pathWeights next headingTo2) next next alreadyOn newWeight (remaining - 1)
let startChoices =
allTaps
|> toSeq
|> IntSet.toSeq
|> Seq.map (fun startNode -> startNode, getShortestPathLength aaNode startNode)
|> Map.ofSeq

288
AdventOfCode2022/Day17.fs Normal file
View File

@@ -0,0 +1,288 @@
namespace AdventOfCode2022
open System
open System.Collections.Generic
open FSharp.Collections.ParallelSeq
#if DEBUG
open Checked
#else
#nowarn "9"
#endif
[<RequireQualifiedAccess>]
module Day17 =
/// Returns the nodes, and also the "AA" node.
let parse (line : string) : Direction array =
Array.init
line.Length
(fun i ->
match line.[i] with
| '<' -> Direction.Left
| '>' -> Direction.Right
| c -> failwithf "unexpected char %c" c
)
let printGrid (arr : Arr2D<int>) (currentTop : int) =
for row in currentTop - 4 .. arr.Height - 1 do
for col in 0..6 do
match Arr2D.get arr col row with
| 0 -> printf "."
| 1 -> printf "@"
| 2 -> printf "#"
| _ -> failwith "oh no"
printfn ""
printfn "--------------------"
let towerHeight (maxPossibleHeight : int) (grid : Arr2D<_>) =
let mutable towerHeight = 0
let mutable stillLooking = true
while stillLooking do
let row = maxPossibleHeight - towerHeight - 1
let mutable anyOn = false
for col in 0..6 do
if Arr2D.get grid col row <> 0 then
anyOn <- true
if not anyOn then
stillLooking <- false
else
towerHeight <- towerHeight + 1
towerHeight
let introduceRock (shape : bool[][]) startGrid currentBase =
for row in shape.Length - 1 .. -1 .. 0 do
for col in 0 .. shape.[0].Length - 1 do
if shape.[row].[col] then
let x = 2 + col
let y = currentBase + row - shape.Length + 1
Arr2D.set startGrid x y 1
let moveJet (direction : Direction) (currentBase : int) (startGrid : Arr2D<int>) : unit =
match direction with
| Direction.Left ->
let mutable canMove = true
for row in currentBase .. -1 .. currentBase - 3 do
if Arr2D.get startGrid 0 row = 1 then
canMove <- false
else
for col in 1..6 do
if Arr2D.get startGrid col row = 1 && Arr2D.get startGrid (col - 1) row = 2 then
canMove <- false
if canMove then
for row in currentBase .. -1 .. currentBase - 3 do
for col in 0..5 do
if Arr2D.get startGrid (col + 1) row = 1 then
Arr2D.set startGrid col row 1
Arr2D.set startGrid (col + 1) row 0
if Arr2D.get startGrid 6 row = 1 then
Arr2D.set startGrid 6 row 0
| Direction.Right ->
let mutable canMove = true
for row in currentBase .. -1 .. currentBase - 3 do
if Arr2D.get startGrid 6 row = 1 then
canMove <- false
else
for col in 0..5 do
if Arr2D.get startGrid col row = 1 && Arr2D.get startGrid (col + 1) row = 2 then
canMove <- false
if canMove then
for row in currentBase .. -1 .. currentBase - 3 do
for col in 6..-1..1 do
if Arr2D.get startGrid (col - 1) row = 1 then
Arr2D.set startGrid col row 1
Arr2D.set startGrid (col - 1) row 0
if Arr2D.get startGrid 1 row = 1 then
Arr2D.set startGrid 0 row 0
| _ -> failwith "Unexpected direction"
/// Returns the new currentBase if we're still falling, or None if we're not
/// still falling.
let fallOnce (currentBase : int) (startGrid : Arr2D<int>) : int option =
let mutable isFalling = true
// Fall one place. Can we fall?
if currentBase = startGrid.Height - 1 then
isFalling <- false
else
for row in currentBase .. -1 .. currentBase - 3 do
for col in 0..6 do
if Arr2D.get startGrid col row = 1 && Arr2D.get startGrid col (row + 1) = 2 then
isFalling <- false
if isFalling then
for row in currentBase .. -1 .. currentBase - 3 do
for col in 0..6 do
if Arr2D.get startGrid col row = 1 then
Arr2D.set startGrid col (row + 1) 1
Arr2D.set startGrid col row 0
Some (currentBase + 1)
else
for row in currentBase .. -1 .. currentBase - 3 do
for col in 0..6 do
if Arr2D.get startGrid col row = 1 then
// Freeze in place
Arr2D.set startGrid col row 2
None
let findCurrentTop (currentTop : int) (startGrid : Arr2D<int>) : int =
let mutable currentTop = currentTop
for row in currentTop - 1 .. -1 .. currentTop - 4 do
for col in 0..6 do
if Arr2D.get startGrid col row = 2 then
currentTop <- row
currentTop
let shapes =
[|
[| [| true ; true ; true ; true |] |]
[|
[| false ; true ; false |]
[| true ; true ; true |]
[| false ; true ; false |]
|]
[|
[| false ; false ; true |]
[| false ; false ; true |]
[| true ; true ; true |]
|]
Array.init 4 (fun _ -> [| true |])
Array.init 2 (fun _ -> [| true ; true |])
|]
let part1 (line : string) : int =
let directions = parse line
let maxPossibleHeight =
shapes
|> Array.map Array.length // if each shape stacked perfectly on top
|> Array.sum
|> fun i -> i * (2022 / 5 + 1)
#if DEBUG
let startGrid = Arr2D.zeroCreate<int> 7 maxPossibleHeight
#else
let startGridBacking = Array.zeroCreate (7 * maxPossibleHeight)
use ptr = fixed startGridBacking
let startGrid = Arr2D.zeroCreate<int> ptr 7 maxPossibleHeight
#endif
let mutable currentTop = maxPossibleHeight
let mutable jetCount = 0
for count in 0 .. 2022 - 1 do
let shape = shapes.[count % shapes.Length]
let mutable currentBase = currentTop - 4
introduceRock shape startGrid currentBase
// Set it falling
let mutable isFalling = true
while isFalling do
// Move by jet.
moveJet directions.[jetCount % directions.Length] currentBase startGrid
jetCount <- (jetCount + 1) % directions.Length
match fallOnce currentBase startGrid with
| Some newCurrentBase -> currentBase <- newCurrentBase
| None -> isFalling <- false
// Set new currentTop
currentTop <- findCurrentTop currentTop startGrid
towerHeight maxPossibleHeight startGrid
let part2 (line : string) : int64 =
let directions = parse line
let maxPossibleHeight =
shapes
|> Array.map Array.length // if each shape stacked perfectly on top
|> Array.sum
|> fun i -> i * (100000000 / 5 + 1)
#if DEBUG
let startGrid = Arr2D.zeroCreate<int> 7 maxPossibleHeight
#else
let startGridBacking = Array.zeroCreate (7 * maxPossibleHeight)
use ptr = fixed startGridBacking
let startGrid = Arr2D.zeroCreate<int> ptr 7 maxPossibleHeight
#endif
let mutable currentTop = maxPossibleHeight
let mutable shapeCount = 0
let mutable jetCount = directions.Length
let seenJetCounts = HashSet ()
let mutable fromLastCycle = ValueNone
let mutable skippedFromCycle = -1L
let limit = 1000000000000L
let mutable remainingStones = limit
while remainingStones > 0 do
for count in 0 .. shapes.Length - 1 do
shapeCount <- shapeCount + 1
remainingStones <- remainingStones - 1L
let shape = shapes.[count]
let mutable currentBase = currentTop - 4
introduceRock shape startGrid currentBase
// Set it falling
let mutable isFalling = true
while isFalling do
// Move by jet.
moveJet directions.[jetCount % directions.Length] currentBase startGrid
jetCount <- (jetCount + 1) % directions.Length
match fallOnce currentBase startGrid with
| Some newCurrentBase -> currentBase <- newCurrentBase
| None -> isFalling <- false
// Set new currentTop
currentTop <- findCurrentTop currentTop startGrid
// Try and find a duplicate.
if not (seenJetCounts.Add jetCount) then
match fromLastCycle with
| ValueNone ->
let towerHeight = towerHeight maxPossibleHeight startGrid
seenJetCounts.Clear ()
seenJetCounts.Add jetCount |> ignore
fromLastCycle <- ValueSome (shapeCount, towerHeight)
| ValueSome (prevShapeCount, prevTowerHeight) ->
let towerHeight = towerHeight maxPossibleHeight startGrid
let heightGainedPerCycle = towerHeight - prevTowerHeight
let piecesPerCycle = shapeCount - prevShapeCount
let remainingCycles = (limit - int64 shapeCount) / int64 piecesPerCycle
skippedFromCycle <- remainingCycles * int64 heightGainedPerCycle
remainingStones <- (limit - int64 shapeCount) % int64 piecesPerCycle
seenJetCounts.Clear ()
let towerHeight = towerHeight maxPossibleHeight startGrid
int64 towerHeight + skippedFromCycle

View File

@@ -0,0 +1,52 @@
namespace AdventOfCode2022
type IntSet = int64
[<RequireQualifiedAccess>]
module IntSet =
let inline set (set : IntSet) (nodeId : int) : IntSet = set ||| (1L <<< nodeId)
let inline contains (set : IntSet) (nodeId : int) : bool = set &&& (1L <<< nodeId) <> 0
let ofSeq (nodes : int seq) : IntSet = (0L, nodes) ||> Seq.fold set
let toSeq (nodes : IntSet) : int seq =
seq {
let mutable nodes = nodes
let mutable count = 0
while nodes > 0 do
if nodes % 2L = 1L then
yield count
nodes <- nodes >>> 1
count <- count + 1
}
let count (nodes : IntSet) : int =
let mutable nodes = nodes
let mutable ans = 0
while nodes > 0 do
if nodes % 2L = 1L then
ans <- ans + 1
nodes <- nodes >>> 1
ans
let first (nodes : IntSet) : int =
let mutable nodes = nodes
let mutable count = 0
let mutable ans = 0
let mutable keepGoing = true
while keepGoing && nodes > 0 do
if nodes % 2L = 1L then
ans <- count
keepGoing <- false
nodes <- nodes >>> 1
count <- count + 1
ans