From 4088720fe818da32ef95a6bedf8e2357786f7215 Mon Sep 17 00:00:00 2001 From: Smaug123 Date: Thu, 14 Dec 2023 09:02:56 +0000 Subject: [PATCH] Part 2 --- .../AdventOfCode2023.FSharp.Lib/Day14.fs | 209 +++++++++++++++++- AdventOfCode2023.FSharp/Test/TestDay14.fs | 4 +- 2 files changed, 204 insertions(+), 9 deletions(-) diff --git a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day14.fs b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day14.fs index 82b37df..cab43f8 100644 --- a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day14.fs +++ b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day14.fs @@ -1,5 +1,10 @@ namespace AdventOfCode2023 +#if DEBUG +#else +#nowarn "9" +#endif + open System [] @@ -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) : 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) : 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) : 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) = 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) = 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) = + 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 + | '\n' -> 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 mutable answer = 0 + let s = s.AsSpan () + 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 = + { + Elements = buffer + Width = lineLength + } +#else + use ptr = fixed buffer + + let system : Arr2D = + { + 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] diff --git a/AdventOfCode2023.FSharp/Test/TestDay14.fs b/AdventOfCode2023.FSharp/Test/TestDay14.fs index e10629a..8e0a9b6 100644 --- a/AdventOfCode2023.FSharp/Test/TestDay14.fs +++ b/AdventOfCode2023.FSharp/Test/TestDay14.fs @@ -19,7 +19,7 @@ module TestDay14 = [] let part2Sample () = - sample |> Day14.part2 |> shouldEqual 0 + sample |> Day14.part2 |> shouldEqual 64ul [] let part1Actual () = @@ -45,4 +45,4 @@ module TestDay14 = Assert.Inconclusive () failwith "unreachable" - Day14.part2 s |> shouldEqual 0 + Day14.part2 s |> shouldEqual 93736ul