Day 14 (#16)

Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #16

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Bench/Inputs.fs

@@ -14,6 +14,6 @@ module Inputs =
             if isNull dir then
                 failwith "reached root of filesystem without finding inputs dir"
 
-        Array.init 13 (fun day -> Path.Combine (dir.FullName, "inputs", $"day%i{day + 1}.txt") |> File.ReadAllText)
+        Array.init 14 (fun day -> Path.Combine (dir.FullName, "inputs", $"day%i{day + 1}.txt") |> File.ReadAllText)
 
     let inline day (i : int) = days.[i - 1]

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Bench/Program.fs

@@ -44,7 +44,7 @@ module Benchmarks =
         [<GlobalSetup>]
         member _.Setup () = Run.shouldWrite <- false
 
-        [<Params(11, 12, 13)>]
+        [<Params(11, 12, 13, 14)>]
         member val Day = 0 with get, set
 
         [<Params(false, true)>]

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Bench/Run.fs

@@ -185,6 +185,18 @@ module Run =
             if shouldWrite then
                 Console.WriteLine output
 
+    let day14 (partTwo : bool) (input : string) =
+        if not partTwo then
+            let output = Day14.part1 input
+
+            if shouldWrite then
+                Console.WriteLine output
+        else
+            let output = Day14.part2 input
+
+            if shouldWrite then
+                Console.WriteLine output
+
     let allRuns =
         [|
             day1
@@ -200,4 +212,5 @@ module Run =
             day11
             day12
             day13
+            day14
         |]

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/AdventOfCode2023.FSharp.Lib.fsproj

@@ -24,6 +24,7 @@
     <Compile Include="Day11.fs" />
     <Compile Include="Day12.fs" />
     <Compile Include="Day13.fs" />
+    <Compile Include="Day14.fs" />
   </ItemGroup>
 
 </Project>

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day14.fs

@@ -0,0 +1,292 @@
+namespace AdventOfCode2023
+
+#if DEBUG
+#else
+#nowarn "9"
+#endif
+
+open System
+
+[<RequireQualifiedAccess>]
+module Day14 =
+    let slideNorth (arr : Arr2D<byte>) : unit =
+        for col = 0 to arr.Width - 1 do
+            let mutable targetPos = -1
+            let mutable pos = 0
+
+            while targetPos = -1 do
+                if Arr2D.get arr col pos = 0uy then
+                    targetPos <- pos
+
+                pos <- pos + 1
+
+            while pos < arr.Height do
+                let current = Arr2D.get arr col pos
+
+                if current = 2uy then
+                    targetPos <- pos + 1
+                    let mutable hasMoved = false
+
+                    while pos < arr.Height && not hasMoved do
+                        if Arr2D.get arr col pos = 0uy then
+                            targetPos <- pos
+                            hasMoved <- true
+
+                        pos <- pos + 1
+                elif current = 1uy then
+                    Arr2D.set arr col targetPos 1uy
+                    Arr2D.set arr col pos 0uy
+                    targetPos <- targetPos + 1
+                    pos <- pos + 1
+                else // current = 0uy
+                    pos <- pos + 1
+
+    let slideSouth (arr : Arr2D<byte>) : unit =
+        for col = 0 to arr.Width - 1 do
+            let mutable targetPos = arr.Height
+            let mutable pos = arr.Height - 1
+
+            while targetPos = arr.Height do
+                if Arr2D.get arr col pos = 0uy then
+                    targetPos <- pos
+
+                pos <- pos - 1
+
+            while pos >= 0 do
+                let current = Arr2D.get arr col pos
+
+                if current = 2uy then
+                    targetPos <- pos - 1
+                    let mutable hasMoved = false
+
+                    while pos >= 0 && not hasMoved do
+                        if Arr2D.get arr col pos = 0uy then
+                            targetPos <- pos
+                            hasMoved <- true
+
+                        pos <- pos - 1
+                elif current = 1uy then
+                    Arr2D.set arr col targetPos 1uy
+                    Arr2D.set arr col pos 0uy
+                    targetPos <- targetPos - 1
+                    pos <- pos - 1
+                else // current = 0uy
+                    pos <- pos - 1
+
+    let slideEast (arr : Arr2D<byte>) : unit =
+        for row = 0 to arr.Height - 1 do
+            let mutable targetPos = arr.Width
+            let mutable pos = arr.Width - 1
+
+            while targetPos = arr.Width do
+                if Arr2D.get arr pos row = 0uy then
+                    targetPos <- pos
+
+                pos <- pos - 1
+
+            while pos >= 0 do
+                let current = Arr2D.get arr pos row
+
+                if current = 2uy then
+                    targetPos <- pos - 1
+                    let mutable hasMoved = false
+
+                    while pos >= 0 && not hasMoved do
+                        if Arr2D.get arr pos row = 0uy then
+                            targetPos <- pos
+                            hasMoved <- true
+
+                        pos <- pos - 1
+                elif current = 1uy then
+                    Arr2D.set arr targetPos row 1uy
+                    Arr2D.set arr pos row 0uy
+                    targetPos <- targetPos - 1
+                    pos <- pos - 1
+                else // current = 0uy
+                    pos <- pos - 1
+
+    let slideWest (arr : Arr2D<byte>) : unit =
+        for row = 0 to arr.Height - 1 do
+            let mutable targetPos = -1
+            let mutable pos = 0
+
+            while targetPos = -1 do
+                if Arr2D.get arr pos row = 0uy then
+                    targetPos <- pos
+
+                pos <- pos + 1
+
+            while pos < arr.Height do
+                let current = Arr2D.get arr pos row
+
+                if current = 2uy then
+                    targetPos <- pos + 1
+                    let mutable hasMoved = false
+
+                    while pos < arr.Width && not hasMoved do
+                        if Arr2D.get arr pos row = 0uy then
+                            targetPos <- pos
+                            hasMoved <- true
+
+                        pos <- pos + 1
+                elif current = 1uy then
+                    Arr2D.set arr targetPos row 1uy
+                    Arr2D.set arr pos row 0uy
+                    targetPos <- targetPos + 1
+                    pos <- pos + 1
+                else // current = 0uy
+                    pos <- pos + 1
+
+    let print (board : Arr2D<byte>) =
+        for row = 0 to board.Height - 1 do
+            for col = 0 to board.Width - 1 do
+                match Arr2D.get board col row with
+                | 0uy -> printf "."
+                | 1uy -> printf "O"
+                | 2uy -> printf "#"
+                | _ -> failwith "bad value"
+
+            printfn ""
+
+        printfn ""
+
+    let score (board : Arr2D<byte>) =
+        let mutable answer = 0ul
+
+        for row = 0 to board.Height - 1 do
+            for col = 0 to board.Width - 1 do
+                if Arr2D.get board col row = 1uy then
+                    answer <- answer + (board.Height - row |> uint32)
+
+        answer
+
+    let hash (board : Arr2D<byte>) =
+        let mutable hash = 0uL
+        let mutable pos = 0uL
+
+        for x = 0 to board.Width - 1 do
+            for y = 0 to board.Height - 1 do
+                hash <- hash + pos * uint64 (Arr2D.get board x y)
+                pos <- pos + 1uL
+
+        hash
+
+    let part1 (s : string) =
+        let s = s.AsSpan ()
+        let lineLength = s.IndexOf '\n'
+
+        let buffer = Array.zeroCreate (lineLength * s.Length / (lineLength + 1))
+        let mutable i = 0
+
+        for c in s do
+            match c with
+            | '#' -> buffer.[i] <- 2uy
+            | '.' -> buffer.[i] <- 0uy
+            | 'O' -> buffer.[i] <- 1uy
+            | '\n' -> i <- i - 1
+            | _ -> failwith "bad char"
+
+            i <- i + 1
+
+#if DEBUG
+        let system : Arr2D<byte> =
+            {
+                Elements = buffer
+                Width = lineLength
+            }
+#else
+        use ptr = fixed buffer
+
+        let system : Arr2D<byte> =
+            {
+                Elements = ptr
+                Length = buffer.Length
+                Width = lineLength
+            }
+#endif
+
+        slideNorth system
+
+        score system
+
+    let cycleOnce (arr : Arr2D<_>) =
+        slideNorth arr
+        slideWest arr
+        slideSouth arr
+        slideEast arr
+
+    let part2 (s : string) =
+        let s = s.AsSpan ()
+        let lineLength = s.IndexOf '\n'
+
+        let buffer = Array.zeroCreate (lineLength * s.Length / (lineLength + 1))
+        let mutable i = 0
+
+        for c in s do
+            match c with
+            | '#' -> buffer.[i] <- 2uy
+            | '.' -> buffer.[i] <- 0uy
+            | 'O' -> buffer.[i] <- 1uy
+            | '\n' -> i <- i - 1
+            | _ -> failwith "bad char"
+
+            i <- i + 1
+
+#if DEBUG
+        let system : Arr2D<byte> =
+            {
+                Elements = buffer
+                Width = lineLength
+            }
+#else
+        use ptr = fixed buffer
+
+        let system : Arr2D<byte> =
+            {
+                Elements = ptr
+                Length = buffer.Length
+                Width = lineLength
+            }
+#endif
+
+        let mutable tortoise = 1
+        let mutable hare = 2
+        let scores = ResizeArray<_> ()
+        scores.Add (score system, hash system)
+        cycleOnce system
+        scores.Add (score system, hash system)
+        cycleOnce system
+        scores.Add (score system, hash system)
+
+        while scores.[hare] <> scores.[tortoise] do
+            cycleOnce system
+            scores.Add (score system, hash system)
+            cycleOnce system
+            scores.Add (score system, hash system)
+
+            hare <- hare + 2
+            tortoise <- tortoise + 1
+
+        tortoise <- 0
+        // mu-table heh heh
+        let mutable firstRepetition = 0
+
+        while scores.[hare] <> scores.[tortoise] do
+            cycleOnce system
+            scores.Add (score system, hash system)
+            hare <- hare + 1
+            tortoise <- tortoise + 1
+            firstRepetition <- firstRepetition + 1
+
+        let mutable cycleLength = 1
+        hare <- tortoise + 1
+
+        while scores.[tortoise] <> scores.[hare] do
+            hare <- hare + 1
+            cycleOnce system
+            scores.Add (score system, hash system)
+            cycleLength <- cycleLength + 1
+
+        let cycles = (1_000_000_000uL - uint64 firstRepetition) % (uint64 cycleLength)
+
+        fst scores.[firstRepetition + int cycles]

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp/Program.fs

@@ -268,6 +268,22 @@ module Program =
             Console.WriteLine (part2.ToString ())
             Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
 
+        Console.WriteLine "=====Day 14====="
+
+        do
+            let input = Path.Combine (dir.FullName, "day14.txt") |> File.ReadAllText
+
+            sw.Restart ()
+            let part1 = Day14.part1 input
+            sw.Stop ()
+            Console.WriteLine (part1.ToString ())
+            Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
+            sw.Restart ()
+            let part2 = Day14.part2 input
+            sw.Stop ()
+            Console.WriteLine (part2.ToString ())
+            Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms")
+
         endToEnd.Stop ()
 
         Console.Error.WriteLine (

AdventOfCode2023.FSharp/Test/Test.fsproj

@@ -22,6 +22,7 @@
     <Compile Include="TestDay11.fs" />
     <Compile Include="TestDay12.fs" />
     <Compile Include="TestDay13.fs" />
+    <Compile Include="TestDay14.fs" />
     <EmbeddedResource Include="samples\day1.txt"/>
     <EmbeddedResource Include="samples\day1part1.txt"/>
     <EmbeddedResource Include="samples\day2.txt"/>
@@ -38,6 +39,7 @@
     <EmbeddedResource Include="samples\day11.txt" />
     <EmbeddedResource Include="samples\day12.txt" />
     <EmbeddedResource Include="samples\day13.txt" />
+    <EmbeddedResource Include="samples\day14.txt" />
   </ItemGroup>
 
   <ItemGroup>

AdventOfCode2023.FSharp/Test/TestDay14.fs

@@ -0,0 +1,48 @@
+namespace AdventOfCode2023.Test
+
+open System
+
+open AdventOfCode2023
+open NUnit.Framework
+open FsUnitTyped
+open System.IO
+
+[<TestFixture>]
+module TestDay14 =
+
+    [<Test>]
+    let sample = Assembly.getEmbeddedResource typeof<Dummy>.Assembly "day14.txt"
+
+    [<Test>]
+    let part1Sample () =
+        sample |> Day14.part1 |> shouldEqual 136ul
+
+    [<Test>]
+    let part2Sample () =
+        sample |> Day14.part2 |> shouldEqual 64ul
+
+    [<Test>]
+    let part1Actual () =
+        let s =
+            try
+                File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day14.txt"))
+            with
+            | :? DirectoryNotFoundException
+            | :? FileNotFoundException ->
+                Assert.Inconclusive ()
+                failwith "unreachable"
+
+        Day14.part1 s |> shouldEqual 111339ul
+
+    [<Test>]
+    let part2Actual () =
+        let s =
+            try
+                File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day14.txt"))
+            with
+            | :? DirectoryNotFoundException
+            | :? FileNotFoundException ->
+                Assert.Inconclusive ()
+                failwith "unreachable"
+
+        Day14.part2 s |> shouldEqual 93736ul

AdventOfCode2023.FSharp/Test/samples/day14.txt

@@ -0,0 +1,10 @@
+O....#....
+O.OO#....#
+.....##...
+OO.#O....O
+.O.....O#.
+O.#..O.#.#
+..O..#O..O
+.......O..
+#....###..
+#OO..#....