Day 17 (#27)

AdventOfCode2022.App/AdventOfCode2022.App.fsproj

@@ -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>

AdventOfCode2022.App/Inputs.fs

@@ -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]

AdventOfCode2022.App/Program.fs

@@ -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)>]

AdventOfCode2022.App/Run.fs

@@ -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
         |]

AdventOfCode2022.Test/AdventOfCode2022.Test.fsproj

@@ -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>

AdventOfCode2022.Test/Day16.fs

@@ -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 ]
+        IntSet.ofSeq [ 1 ; 2 ; 3 ; 16 ]
-        |> Day16.toSeq
+        |> IntSet.toSeq
         |> List.ofSeq
         |> shouldEqual [ 1 ; 2 ; 3 ; 16 ]
 

AdventOfCode2022.Test/Day17.fs

@@ -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

AdventOfCode2022/AdventOfCode2022.fsproj

@@ -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>

AdventOfCode2022/Day16.fs

@@ -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 v1 in IntSet.toSeq allTaps do
-            for v2 in 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 v1 in IntSet.toSeq allTaps do
-            for v2 in 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
 

AdventOfCode2022/Day17.fs

@@ -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

AdventOfCode2022/IntSet.fs

@@ -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