Day 18 and speedups to earlier days (#29)

AdventOfCode2022.App/AdventOfCode2022.App.fsproj

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

AdventOfCode2022.App/Inputs.fs

@@ -2,5 +2,5 @@ namespace AdventOfCode2022.App
 
 [<RequireQualifiedAccess>]
 module Inputs =
-    let days = Array.init 17 (fun day -> Assembly.readResource $"Day%i{day + 1}.txt")
+    let days = Array.init 18 (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, 17)>]
+    [<Params(16, 17, 18)>]
     member val Day = 0 with get, set
 
     [<Params(false, true)>]

AdventOfCode2022.App/Run.fs

@@ -246,6 +246,20 @@ module Run =
             if shouldWrite then
                 printfn "%i" output
 
+    let day18 (partTwo : bool) (input : string) =
+        let day18 = StringSplitEnumerator.make '\n' input
+
+        if not partTwo then
+            let output = Day18.part1 day18
+
+            if shouldWrite then
+                printfn "%i" output
+        else
+            let output = Day18.part2 day18
+
+            if shouldWrite then
+                printfn "%i" output
+
     let allRuns =
         [|
             day1
@@ -265,4 +279,5 @@ module Run =
             day15
             day16
             day17
+            day18
         |]

AdventOfCode2022.Test/AdventOfCode2022.Test.fsproj

@@ -25,6 +25,7 @@
         <Compile Include="Day15.fs" />
         <Compile Include="Day16.fs" />
         <Compile Include="Day17.fs" />
+        <Compile Include="Day18.fs" />
         <EmbeddedResource Include="Inputs\Day1.txt" />
         <EmbeddedResource Include="Inputs\Day2.txt" />
         <EmbeddedResource Include="Inputs\Day3.txt" />
@@ -42,6 +43,7 @@
         <EmbeddedResource Include="Inputs\Day15.txt" />
         <EmbeddedResource Include="Inputs\Day16.txt" />
         <EmbeddedResource Include="Inputs\Day17.txt" />
+        <EmbeddedResource Include="Inputs\Day18.txt" />
     </ItemGroup>
 
     <ItemGroup>

AdventOfCode2022.Test/Day18.fs

@@ -0,0 +1,51 @@
+namespace AdventOfCode2022.Test
+
+open NUnit.Framework
+open FsUnitTyped
+open AdventOfCode2022
+
+[<TestFixture>]
+module TestDay18 =
+
+    let input1 =
+        """1,1,1
+2,1,1
+"""
+
+    let input2 =
+        """2,2,2
+1,2,2
+3,2,2
+2,1,2
+2,3,2
+2,2,1
+2,2,3
+2,2,4
+2,2,6
+1,2,5
+3,2,5
+2,1,5
+2,3,5
+"""
+
+    [<Test>]
+    let ``Part 1, given`` () =
+        Day18.part1 (StringSplitEnumerator.make '\n' input1) |> shouldEqual 10
+        Day18.part1 (StringSplitEnumerator.make '\n' input2) |> shouldEqual 64
+
+    [<Test>]
+    let ``Part 1`` () =
+        let input = Assembly.readResource "Day18.txt"
+
+        Day18.part1 (StringSplitEnumerator.make '\n' input) |> shouldEqual 3542
+
+
+    [<Test>]
+    let ``Part 2, given`` () =
+        Day18.part2 (StringSplitEnumerator.make '\n' input2) |> shouldEqual 58
+
+    [<Test>]
+    let ``Part 2`` () =
+        let input = Assembly.readResource "Day18.txt"
+
+        Day18.part2 (StringSplitEnumerator.make '\n' input) |> shouldEqual 2080

AdventOfCode2022/AdventOfCode2022.fsproj

@@ -10,6 +10,7 @@
       <Compile Include="EfficientString.fs" />
       <Compile Include="IntSet.fs" />
       <Compile Include="Arr2D.fs" />
+      <Compile Include="Arr3D.fs" />
       <Compile Include="Day1.fs" />
       <Compile Include="Day2.fs" />
       <Compile Include="Day3.fs" />
@@ -28,6 +29,7 @@
       <Compile Include="Day15.fs" />
       <Compile Include="Day16.fs" />
       <Compile Include="Day17.fs" />
+      <Compile Include="Day18.fs" />
     </ItemGroup>
 
     <ItemGroup>

AdventOfCode2022/Arr3D.fs

@@ -0,0 +1,100 @@
+namespace AdventOfCode2022
+
+#if DEBUG
+#else
+#nowarn "9"
+#endif
+
+open Microsoft.FSharp.NativeInterop
+
+[<Struct>]
+#if DEBUG
+type Arr3D<'a> =
+    {
+        Elements : 'a array
+        Width : int
+        WidthTimesHeight : int
+    }
+
+    member this.Depth = this.Elements.Length / this.WidthTimesHeight
+#else
+type Arr3D<'a when 'a : unmanaged> =
+    {
+        Elements : nativeptr<'a>
+        Length : int
+        Width : int
+        WidthTimesHeight : int
+    }
+
+    member this.Depth = this.Length / this.WidthTimesHeight
+#endif
+
+[<RequireQualifiedAccess>]
+module Arr3D =
+
+    /// It's faster to iterate forward over the first argument, `x`, and then the
+    /// second argument, `y`.
+    let inline get (arr : Arr3D<'a>) (x : int) (y : int) (z : int) : 'a =
+#if DEBUG
+        arr.Elements.[z * arr.WidthTimesHeight + y * arr.Width + x]
+#else
+        NativePtr.get arr.Elements (z * arr.WidthTimesHeight + y * arr.Width + x)
+#endif
+
+    let inline set (arr : Arr3D<'a>) (x : int) (y : int) (z : int) (newVal : 'a) : unit =
+#if DEBUG
+        arr.Elements.[z * arr.WidthTimesHeight + y * arr.Width + x] <- newVal
+#else
+        NativePtr.write (NativePtr.add arr.Elements (z * arr.WidthTimesHeight + y * arr.Width + x)) newVal
+#endif
+
+#if DEBUG
+    let create (width : int) (height : int) (depth : int) (value : 'a) : Arr3D<'a> =
+        let arr = Array.create (width * height * depth) value
+
+        {
+            Width = width
+            WidthTimesHeight = width * height
+            Elements = arr
+        }
+#else
+    /// The input array must be at least of size width * height * depth
+    let create (arr : nativeptr<'a>) (width : int) (height : int) (depth : int) (value : 'a) : Arr3D<'a> =
+        {
+            Width = width
+            Elements = arr
+            Length = width * height * depth
+            WidthTimesHeight = width * height
+        }
+#endif
+
+    [<RequiresExplicitTypeArguments>]
+#if DEBUG
+    let zeroCreate<'a when 'a : unmanaged> (width : int) (height : int) (depth : int) : Arr3D<'a> =
+        {
+            Elements = Array.zeroCreate (width * height * depth)
+            Width = width
+            WidthTimesHeight = width * height
+        }
+#else
+    let zeroCreate<'a when 'a : unmanaged>
+        (elts : nativeptr<'a>)
+        (width : int)
+        (height : int)
+        (depth : int)
+        : Arr3D<'a>
+        =
+        {
+            Elements = elts
+            Width = width
+            WidthTimesHeight = width * height
+            Length = width * height * depth
+        }
+#endif
+
+    let inline clear (a : Arr3D<'a>) : unit =
+#if DEBUG
+        System.Array.Clear a.Elements
+#else
+        NativePtr.initBlock a.Elements 0uy (uint32 sizeof<'a> * uint32 a.Length)
+#endif

AdventOfCode2022/Day16.fs

@@ -16,7 +16,7 @@ module Day16 =
     type Node = int
 
     /// Returns the nodes, and also the "AA" node.
-    let parse (lines : string seq) : Map<Node, int * Node Set> * Node =
+    let parse (lines : string seq) : Map<Node, int * IntSet> * Node =
         let allNodes =
             lines
             |> Seq.filter (not << String.IsNullOrEmpty)
@@ -31,7 +31,10 @@ module Day16 =
             allNodes
             |> Map.toSeq
             |> Seq.map (fun (key, (node, (weight, outbound))) ->
-                node, (weight, (Set.map (fun x -> fst (Map.find x allNodes)) outbound))
+                let outbound =
+                    outbound |> Seq.map (fun x -> Map.find x allNodes |> fst) |> IntSet.ofSeq
+
+                node, (weight, outbound)
             )
             |> Map.ofSeq
 
@@ -50,36 +53,48 @@ module Day16 =
 
             Some answer
 
-    let tryMin (s : seq<'a>) : 'a option =
+    let tryMin (s : seq<'a>) : 'a ValueOption =
         use enum = s.GetEnumerator ()
 
         if not (enum.MoveNext ()) then
-            None
+            ValueNone
         else
             let mutable answer = enum.Current
 
             while enum.MoveNext () do
                 answer <- min answer enum.Current
 
-            Some answer
+            ValueSome answer
 
     let getShortestPathLength (valves : Map<_, _>) : Node -> Node -> int =
-        let rec go (seenSoFar : Node Set) (v1 : Node) (v2 : Node) =
+        let rec go (seenSoFar : IntSet) (v1 : Node) (v2 : Node) : int =
             let v2Neighbours = snd valves.[v2]
 
             if v1 = v2 then
-                Some 0
-            elif Set.contains v1 v2Neighbours then
-                Some 1
-            elif Set.contains v2 seenSoFar then
-                None
+                0
+            elif IntSet.contains v2Neighbours v1 then
+                1
+            elif IntSet.contains seenSoFar v2 then
+                -1
             else
-                v2Neighbours
-                |> Seq.choose (go (Set.add v2 seenSoFar) v1)
-                |> tryMin
-                |> Option.map ((+) 1)
+                let mutable best = Int32.MaxValue
+                let mutable neighbours = v2Neighbours
+                let mutable neighbour = 0
 
-        fun v1 v2 -> go Set.empty v1 v2 |> Option.get
+                while neighbours > 0 do
+                    if neighbours % 2L = 1L then
+                        match go (IntSet.set seenSoFar v2) v1 neighbour with
+                        | -1 -> ()
+                        | next ->
+                            if next < best then
+                                best <- next
+
+                    neighbours <- neighbours >>> 1
+                    neighbour <- neighbour + 1
+
+                if best = Int32.MaxValue then -1 else best + 1
+
+        fun v1 v2 -> go IntSet.empty v1 v2
 
 
     let part1 (lines : string seq) : int =

AdventOfCode2022/Day17.fs

@@ -65,12 +65,13 @@ module Day17 =
                     let y = currentBase + row - shape.Length + 1
                     Arr2D.set startGrid x y 1
 
-    let moveJet (direction : Direction) (currentBase : int) (startGrid : Arr2D<int>) : unit =
+    let inline moveJet (direction : Direction) (currentBase : int) (startGrid : Arr2D<int>) : unit =
         match direction with
         | Direction.Left ->
             let mutable canMove = true
+            let mutable row = currentBase
 
-            for row in currentBase .. -1 .. currentBase - 3 do
+            while row >= currentBase - 3 && canMove do
                 if Arr2D.get startGrid 0 row = 1 then
                     canMove <- false
                 else
@@ -78,6 +79,8 @@ module Day17 =
                         if Arr2D.get startGrid col row = 1 && Arr2D.get startGrid (col - 1) row = 2 then
                             canMove <- false
 
+                row <- row - 1
+
             if canMove then
                 for row in currentBase .. -1 .. currentBase - 3 do
                     for col in 0..5 do
@@ -89,8 +92,9 @@ module Day17 =
                         Arr2D.set startGrid 6 row 0
         | Direction.Right ->
             let mutable canMove = true
+            let mutable row = currentBase
 
-            for row in currentBase .. -1 .. currentBase - 3 do
+            while row >= currentBase - 3 && canMove do
                 if Arr2D.get startGrid 6 row = 1 then
                     canMove <- false
                 else
@@ -98,6 +102,8 @@ module Day17 =
                         if Arr2D.get startGrid col row = 1 && Arr2D.get startGrid (col + 1) row = 2 then
                             canMove <- false
 
+                row <- row - 1
+
             if canMove then
                 for row in currentBase .. -1 .. currentBase - 3 do
                     for col in 6..-1..1 do
@@ -109,9 +115,9 @@ module Day17 =
                         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 =
+    /// Returns the new currentBase if we're still falling, or -1 if we're not
+    /// still falling. (Allocation of a ValueNone was actually nontrivially slow!)
+    let fallOnce (currentBase : int) (startGrid : Arr2D<int>) : int =
         let mutable isFalling = true
 
         // Fall one place. Can we fall?
@@ -130,7 +136,7 @@ module Day17 =
                         Arr2D.set startGrid col (row + 1) 1
                         Arr2D.set startGrid col row 0
 
-            Some (currentBase + 1)
+            currentBase + 1
         else
             for row in currentBase .. -1 .. currentBase - 3 do
                 for col in 0..6 do
@@ -138,7 +144,7 @@ module Day17 =
                         // Freeze in place
                         Arr2D.set startGrid col row 2
 
-            None
+            -1
 
     let findCurrentTop (currentTop : int) (startGrid : Arr2D<int>) : int =
         let mutable currentTop = currentTop
@@ -203,8 +209,8 @@ module Day17 =
                 jetCount <- (jetCount + 1) % directions.Length
 
                 match fallOnce currentBase startGrid with
-                | Some newCurrentBase -> currentBase <- newCurrentBase
-                | None -> isFalling <- false
+                | -1 -> isFalling <- false
+                | newCurrentBase -> currentBase <- newCurrentBase
 
                 // Set new currentTop
                 currentTop <- findCurrentTop currentTop startGrid
@@ -259,8 +265,8 @@ module Day17 =
                     jetCount <- (jetCount + 1) % directions.Length
 
                     match fallOnce currentBase startGrid with
-                    | Some newCurrentBase -> currentBase <- newCurrentBase
-                    | None -> isFalling <- false
+                    | -1 -> isFalling <- false
+                    | newCurrentBase -> currentBase <- newCurrentBase
 
                     // Set new currentTop
                     currentTop <- findCurrentTop currentTop startGrid

AdventOfCode2022/Day18.fs

@@ -0,0 +1,196 @@
+namespace AdventOfCode2022
+
+open System
+open System.Collections.Generic
+open FSharp.Collections.ParallelSeq
+
+#if DEBUG
+open Checked
+#else
+#nowarn "9"
+#endif
+
+
+[<RequireQualifiedAccess>]
+module Day18 =
+
+    /// Returns the points, and also minX, minY, minZ, maxX, maxY, maxZ.
+    let parse
+        (line : StringSplitEnumerator)
+        : struct (int * int * int) ResizeArray * int * int * int * int * int * int
+        =
+        use mutable enum = line.GetEnumerator ()
+        let output = ResizeArray ()
+        let mutable minX = Int32.MaxValue
+        let mutable minY = Int32.MaxValue
+        let mutable minZ = Int32.MaxValue
+        let mutable maxX = Int32.MinValue
+        let mutable maxY = Int32.MinValue
+        let mutable maxZ = Int32.MinValue
+
+        while enum.MoveNext () do
+            if not (enum.Current.IsWhiteSpace ()) then
+                let mutable split = StringSplitEnumerator.make' ',' enum.Current
+                let x = StringSplitEnumerator.consumeInt &split
+
+                if x < minX then
+                    minX <- x
+
+                if x > maxX then
+                    maxX <- x
+
+                let y = StringSplitEnumerator.consumeInt &split
+
+                if y < minY then
+                    minY <- y
+
+                if y > maxY then
+                    maxY <- y
+
+                let z = StringSplitEnumerator.consumeInt &split
+
+                if z < minZ then
+                    minZ <- z
+
+                if z > maxZ then
+                    maxZ <- z
+
+                assert (not (split.MoveNext ()))
+                output.Add (struct (x, y, z))
+
+        output, minX, minY, minZ, maxX, maxY, maxZ
+
+    let inline private doPart1
+        (cubes : ResizeArray<_>)
+        (arr : Arr3D<int>)
+        (minX : int)
+        (minY : int)
+        (minZ : int)
+        maxX
+        maxY
+        maxZ
+        =
+        let mutable exposedFaces = 0
+
+        let maxX = maxX - minX
+        let maxY = maxY - minY
+        let maxZ = maxZ - minZ
+
+        for i in 0 .. cubes.Count - 1 do
+            let struct (x, y, z) = cubes.[i]
+            let x = x - minX
+            let y = y - minY
+            let z = z - minZ
+
+            if not (x > 0 && Arr3D.get arr (x - 1) y z = 1) then
+                exposedFaces <- exposedFaces + 1
+
+            if not (x < maxX && Arr3D.get arr (x + 1) y z = 1) then
+                exposedFaces <- exposedFaces + 1
+
+            if not (y > 0 && Arr3D.get arr x (y - 1) z = 1) then
+                exposedFaces <- exposedFaces + 1
+
+            if not (y < maxY && Arr3D.get arr x (y + 1) z = 1) then
+                exposedFaces <- exposedFaces + 1
+
+            if not (z > 0 && Arr3D.get arr x y (z - 1) = 1) then
+                exposedFaces <- exposedFaces + 1
+
+            if not (z < maxZ && Arr3D.get arr x y (z + 1) = 1) then
+                exposedFaces <- exposedFaces + 1
+
+        exposedFaces
+
+    let part1 (line : StringSplitEnumerator) : int =
+        let cubes, minX, minY, minZ, maxX, maxY, maxZ = parse line
+
+        let xSpan = maxX - minX + 1
+        let ySpan = maxY - minY + 1
+        let zSpan = maxZ - minZ + 1
+
+#if DEBUG
+        let arr = Arr3D.zeroCreate<int> xSpan ySpan zSpan
+#else
+        let backing = Array.zeroCreate<int> (xSpan * ySpan * zSpan)
+        use ptr = fixed backing
+        let arr = Arr3D.zeroCreate<int> ptr xSpan ySpan zSpan
+#endif
+
+        for i in 0 .. cubes.Count - 1 do
+            let struct (x, y, z) = cubes.[i]
+            Arr3D.set arr (x - minX) (y - minY) (z - minZ) 1
+
+        doPart1 cubes arr minX minY minZ maxX maxY maxZ
+
+    // Semantics:
+    // 3 means "in progress",
+    // 2 means "this definitely flood fills to the outside",
+    // 1 means "definitely full",
+    // 0 means "initially empty",
+    let floodFill (arr : Arr3D<int>) maxX maxY maxZ (x : int) (y : int) (z : int) : unit =
+        /// Returns true if it hits the outside.
+        let rec go (x : int) (y : int) (z : int) : bool =
+            let mutable hitsOutside = false
+
+            match Arr3D.get arr x y z with
+            | 0 ->
+                Arr3D.set arr x y z 3
+
+                hitsOutside <- hitsOutside || (if x > 0 then go (x - 1) y z else true)
+
+                hitsOutside <- hitsOutside || (if y > 0 then go x (y - 1) z else true)
+
+                hitsOutside <- hitsOutside || (if z > 0 then go x y (z - 1) else true)
+
+                hitsOutside <- hitsOutside || (if x < maxX then go (x + 1) y z else true)
+
+                hitsOutside <- hitsOutside || (if y < maxY then go x (y + 1) z else true)
+
+                hitsOutside <- hitsOutside || (if z < maxZ then go x y (z + 1) else true)
+            | 2 -> hitsOutside <- true
+            | _ -> ()
+
+            hitsOutside
+
+        if go x y z then
+            // Convert all our "in progress" to "flood fills to outside".
+            for x in 0..maxX do
+                for y in 0..maxY do
+                    for z in 0..maxZ do
+                        if Arr3D.get arr x y z = 3 then
+                            Arr3D.set arr x y z 2
+        else
+            // Convert all our "in progress" to "does not flood fill to outside".
+            for x in 0..maxX do
+                for y in 0..maxY do
+                    for z in 0..maxZ do
+                        if Arr3D.get arr x y z = 3 then
+                            Arr3D.set arr x y z 1
+
+    let part2 (line : StringSplitEnumerator) : int =
+        let cubes, minX, minY, minZ, maxX, maxY, maxZ = parse line
+
+        let xSpan = maxX - minX + 1
+        let ySpan = maxY - minY + 1
+        let zSpan = maxZ - minZ + 1
+
+#if DEBUG
+        let arr = Arr3D.zeroCreate<int> xSpan ySpan zSpan
+#else
+        let backing = Array.zeroCreate<int> (xSpan * ySpan * zSpan)
+        use ptr = fixed backing
+        let arr = Arr3D.zeroCreate<int> ptr xSpan ySpan zSpan
+#endif
+
+        for i in 0 .. cubes.Count - 1 do
+            let struct (x, y, z) = cubes.[i]
+            Arr3D.set arr (x - minX) (y - minY) (z - minZ) 1
+
+        // Flood-fill the internals.
+        for x in 0 .. maxX - minX do
+            for y in 0 .. maxY - minY do
+                for z in 0 .. maxZ - minZ do
+                    floodFill arr (maxX - minX) (maxY - minY) (maxZ - minZ) x y z
+
+        doPart1 cubes arr minX minY minZ maxX maxY maxZ

AdventOfCode2022/IntSet.fs

@@ -8,6 +8,7 @@ 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 empty : IntSet = 0L
 
     let toSeq (nodes : IntSet) : int seq =
         seq {