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

@@ -1,5 +1,10 @@
 namespace AdventOfCode2023
 
+#if DEBUG
+#else
+#nowarn "9"
+#endif
+
 open System
 
 [<RequireQualifiedAccess>]
@@ -8,19 +13,25 @@ module Day14 =
         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 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
@@ -30,6 +41,102 @@ module Day14 =
                 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 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 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 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
@@ -38,11 +145,14 @@ module Day14 =
                 | 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
@@ -50,20 +160,32 @@ module Day14 =
 
         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' ->
+            | '\n' -> i <- i - 1
-                i <- i - 1
             | _ -> failwith "bad char"
+
             i <- i + 1
 
 #if DEBUG
@@ -87,11 +209,84 @@ module Day14 =
 
         score system
 
+    let cycleOnce (arr : Arr2D<_>) =
+        slideNorth arr
+        slideWest arr
+        slideSouth arr
+        slideEast arr
+
     let part2 (s : string) =
-        use mutable lines = StringSplitEnumerator.make '\n' s
+        let s = s.AsSpan ()
-        let mutable answer = 0
+        let lineLength = s.IndexOf '\n'
 
-        for line in lines do
+        let buffer = Array.zeroCreate (lineLength * s.Length / (lineLength + 1))
-            ()
+        let mutable i = 0
 
-        answer
+        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/Test/TestDay14.fs

@@ -19,7 +19,7 @@ module TestDay14 =
 
     [<Test>]
     let part2Sample () =
-        sample |> Day14.part2 |> shouldEqual 0
+        sample |> Day14.part2 |> shouldEqual 64ul
 
     [<Test>]
     let part1Actual () =
@@ -45,4 +45,4 @@ module TestDay14 =
                 Assert.Inconclusive ()
                 failwith "unreachable"
 
-        Day14.part2 s |> shouldEqual 0
+        Day14.part2 s |> shouldEqual 93736ul