From 012e7c193c96536206231b2f54d8a5a9b45c68e7 Mon Sep 17 00:00:00 2001 From: Smaug123 Date: Sat, 16 Dec 2023 11:33:29 +0000 Subject: [PATCH] Part 2 --- .../AdventOfCode2023.FSharp.Lib/Day16.fs | 320 +++++++++++------- AdventOfCode2023.FSharp/Test/TestDay16.fs | 2 +- 2 files changed, 206 insertions(+), 116 deletions(-) diff --git a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day16.fs b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day16.fs index ac20e1b..7fe2557 100644 --- a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day16.fs +++ b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day16.fs @@ -6,8 +6,6 @@ namespace AdventOfCode2023 #endif open System -open System.Collections.Generic -open System.Globalization [] module Day16 = @@ -58,6 +56,119 @@ module Day16 = printfn "" printfn "" + let advance (arr : Arr2D<_>) (going : ResizeArray<_>) (s : string) (nextUp : uint16) = + let numCols = arr.Width + let numLines = arr.Height + let col = getCol numCols nextUp + let row = getRow numCols nextUp + let dir = getDirection nextUp + Arr2D.set arr col row true + match dir with + | Direction.Right -> + match getAt numCols s row col with + | '-' + | '.' -> + if col < arr.Width - 1 then + going.[going.Count - 1] <- storeDirectionAndPos numCols (col + 1) row dir + else + going.RemoveAt (going.Count - 1) + | '/' -> + if row > 0 then + going.[going.Count - 1] <- storeDirectionAndPos numCols col (row - 1) Direction.Up + else + going.RemoveAt (going.Count - 1) + | '\\' -> + if row < numLines - 1 then + going.[going.Count - 1] <- storeDirectionAndPos numCols col (row + 1) Direction.Down + else + going.RemoveAt (going.Count - 1) + | '|' -> + going.RemoveAt (going.Count - 1) + if row < numLines - 1 then + going.Add (storeDirectionAndPos numCols col (row + 1) Direction.Down) + if row > 0 then + going.Add (storeDirectionAndPos numCols col (row - 1) Direction.Up) + | c -> + failwith $"Unrecognised char: %c{c}" + | Direction.Left -> + match getAt numCols s row col with + | '-' + | '.' -> + if col > 0 then + going.[going.Count - 1] <- storeDirectionAndPos numCols (col - 1) row dir + else + going.RemoveAt (going.Count - 1) + | '\\' -> + if row > 0 then + going.[going.Count - 1] <- storeDirectionAndPos numCols col (row - 1) Direction.Up + else + going.RemoveAt (going.Count - 1) + | '/' -> + if row < numLines - 1 then + going.[going.Count - 1] <- storeDirectionAndPos numCols col (row + 1) Direction.Down + else + going.RemoveAt (going.Count - 1) + | '|' -> + going.RemoveAt (going.Count - 1) + if row < numLines - 1 then + going.Add (storeDirectionAndPos numCols col (row + 1) Direction.Down) + if row > 0 then + going.Add (storeDirectionAndPos numCols col (row - 1) Direction.Up) + | c -> + failwith $"Unrecognised char: %c{c}" + | Direction.Up -> + match getAt numCols s row col with + | '|' + | '.' -> + if row > 0 then + going.[going.Count - 1] <- storeDirectionAndPos numCols col (row - 1) dir + else + going.RemoveAt (going.Count - 1) + | '/' -> + if col < numCols - 1 then + going.[going.Count - 1] <- storeDirectionAndPos numCols (col + 1) row Direction.Right + else + going.RemoveAt (going.Count - 1) + | '\\' -> + if col > 0 then + going.[going.Count - 1] <- storeDirectionAndPos numCols (col - 1) row Direction.Left + else + going.RemoveAt (going.Count - 1) + | '-' -> + going.RemoveAt (going.Count - 1) + if col < numCols - 1 then + going.Add (storeDirectionAndPos numCols (col + 1) row Direction.Right) + if col > 0 then + going.Add (storeDirectionAndPos numCols (col - 1) row Direction.Left) + | c -> + failwith $"Unrecognised char: %c{c}" + | Direction.Down -> + match getAt numCols s row col with + | '|' + | '.' -> + if row < arr.Height - 1 then + going.[going.Count - 1] <- storeDirectionAndPos numCols col (row + 1) dir + else + going.RemoveAt (going.Count - 1) + | '\\' -> + if col < numCols - 1 then + going.[going.Count - 1] <- storeDirectionAndPos numCols (col + 1) row Direction.Right + else + going.RemoveAt (going.Count - 1) + | '/' -> + if col > 0 then + going.[going.Count - 1] <- storeDirectionAndPos numCols (col - 1) row Direction.Left + else + going.RemoveAt (going.Count - 1) + | '-' -> + going.RemoveAt (going.Count - 1) + if col < numCols - 1 then + going.Add (storeDirectionAndPos numCols (col + 1) row Direction.Right) + if col > 0 then + going.Add (storeDirectionAndPos numCols (col - 1) row Direction.Left) + | c -> + failwith $"Unrecognised char: %c{c}" + let part1 (s : string) = let numLines = s.AsSpan().Count '\n' let numCols = s.IndexOf '\n' @@ -79,7 +190,7 @@ module Day16 = #endif let going = ResizeArray () going.Add (storeDirectionAndPos numCols LanguagePrimitives.GenericZero LanguagePrimitives.GenericZero Direction.Right) - let seen = Array.zeroCreate (int (maxEncoded numCols numLines)) + let seen = Array.zeroCreate (int (maxEncoded numCols numLines) + 1) while going.Count > 0 do let nextUp = going.[going.Count - 1] @@ -87,119 +198,98 @@ module Day16 = | true -> going.RemoveAt (going.Count - 1) | false -> - seen.[int nextUp] <- true - let col = getCol numCols nextUp - let row = getRow numCols nextUp - let dir = getDirection nextUp - Arr2D.set arr col row true - match dir with - | Direction.Right -> - match getAt numCols s row col with - | '-' - | '.' -> - if col < arr.Width - 1 then - going.[going.Count - 1] <- storeDirectionAndPos numCols (col + 1) row dir - else - going.RemoveAt (going.Count - 1) - | '/' -> - if row > 0 then - going.[going.Count - 1] <- storeDirectionAndPos numCols col (row - 1) Direction.Up - else - going.RemoveAt (going.Count - 1) - | '\\' -> - if row < numLines - 1 then - going.[going.Count - 1] <- storeDirectionAndPos numCols col (row + 1) Direction.Down - else - going.RemoveAt (going.Count - 1) - | '|' -> - going.RemoveAt (going.Count - 1) - if row < numLines - 1 then - going.Add (storeDirectionAndPos numCols col (row + 1) Direction.Down) - if row > 0 then - going.Add (storeDirectionAndPos numCols col (row - 1) Direction.Up) - | c -> - failwith $"Unrecognised char: %c{c}" - | Direction.Left -> - match getAt numCols s row col with - | '-' - | '.' -> - if col > 0 then - going.[going.Count - 1] <- storeDirectionAndPos numCols (col - 1) row dir - else - going.RemoveAt (going.Count - 1) - | '\\' -> - if row > 0 then - going.[going.Count - 1] <- storeDirectionAndPos numCols col (row - 1) Direction.Up - else - going.RemoveAt (going.Count - 1) - | '/' -> - if row < numLines - 1 then - going.[going.Count - 1] <- storeDirectionAndPos numCols col (row + 1) Direction.Down - else - going.RemoveAt (going.Count - 1) - | '|' -> - going.RemoveAt (going.Count - 1) - if row < numLines - 1 then - going.Add (storeDirectionAndPos numCols col (row + 1) Direction.Down) - if row > 0 then - going.Add (storeDirectionAndPos numCols col (row - 1) Direction.Up) - | c -> - failwith $"Unrecognised char: %c{c}" - | Direction.Up -> - match getAt numCols s row col with - | '|' - | '.' -> - if row > 0 then - going.[going.Count - 1] <- storeDirectionAndPos numCols col (row - 1) dir - else - going.RemoveAt (going.Count - 1) - | '/' -> - if col < numCols - 1 then - going.[going.Count - 1] <- storeDirectionAndPos numCols (col + 1) row Direction.Right - else - going.RemoveAt (going.Count - 1) - | '\\' -> - if col > 0 then - going.[going.Count - 1] <- storeDirectionAndPos numCols (col - 1) row Direction.Left - else - going.RemoveAt (going.Count - 1) - | '-' -> - going.RemoveAt (going.Count - 1) - if col < numCols - 1 then - going.Add (storeDirectionAndPos numCols (col + 1) row Direction.Right) - if col > 0 then - going.Add (storeDirectionAndPos numCols (col - 1) row Direction.Left) - | c -> - failwith $"Unrecognised char: %c{c}" - | Direction.Down -> - match getAt numCols s row col with - | '|' - | '.' -> - if row < arr.Height - 1 then - going.[going.Count - 1] <- storeDirectionAndPos numCols col (row + 1) dir - else - going.RemoveAt (going.Count - 1) - | '\\' -> - if col < numCols - 1 then - going.[going.Count - 1] <- storeDirectionAndPos numCols (col + 1) row Direction.Right - else - going.RemoveAt (going.Count - 1) - | '/' -> - if col > 0 then - going.[going.Count - 1] <- storeDirectionAndPos numCols (col - 1) row Direction.Left - else - going.RemoveAt (going.Count - 1) - | '-' -> - going.RemoveAt (going.Count - 1) - if col < numCols - 1 then - going.Add (storeDirectionAndPos numCols (col + 1) row Direction.Right) - if col > 0 then - going.Add (storeDirectionAndPos numCols (col - 1) row Direction.Left) - | c -> - failwith $"Unrecognised char: %c{c}" + seen.[int nextUp] <- true + advance arr going s nextUp arr.Elements.AsSpan().Count true let part2 (s : string) = - use lines = StringSplitEnumerator.make '\n' s - 0 + let numLines = s.AsSpan().Count '\n' + let numCols = s.IndexOf '\n' + let arr = Array.zeroCreate (numLines * numCols) +#if DEBUG + let arr : Arr2D = + { + Elements = arr + Width = numCols + } +#else + use ptr = fixed arr + let arr : Arr2D = + { + Elements = arr + Width = numCols + Length = arr.Count + } +#endif + let going = ResizeArray () + let seen = Array.zeroCreate (int (maxEncoded numCols numLines) + 1) + let mutable best = 0 + + for start = 0 to numCols - 1 do + going.Clear () + Array.Clear seen + Array.Clear arr.Elements + going.Add (storeDirectionAndPos numCols start LanguagePrimitives.GenericZero Direction.Down) + + while going.Count > 0 do + let nextUp = going.[going.Count - 1] + match seen.[int nextUp] with + | true -> + going.RemoveAt (going.Count - 1) + | false -> + seen.[int nextUp] <- true + advance arr going s nextUp + let lit = arr.Elements.AsSpan().Count true + best <- max best lit + + going.Clear () + Array.Clear seen + Array.Clear arr.Elements + going.Add (storeDirectionAndPos numCols start (numLines - 1) Direction.Up) + + while going.Count > 0 do + let nextUp = going.[going.Count - 1] + match seen.[int nextUp] with + | true -> + going.RemoveAt (going.Count - 1) + | false -> + seen.[int nextUp] <- true + advance arr going s nextUp + let lit = arr.Elements.AsSpan().Count true + best <- max best lit + + for start = 0 to numLines - 1 do + going.Clear () + Array.Clear seen + Array.Clear arr.Elements + going.Add (storeDirectionAndPos numCols LanguagePrimitives.GenericZero start Direction.Right) + + while going.Count > 0 do + let nextUp = going.[going.Count - 1] + match seen.[int nextUp] with + | true -> + going.RemoveAt (going.Count - 1) + | false -> + seen.[int nextUp] <- true + advance arr going s nextUp + let lit = arr.Elements.AsSpan().Count true + best <- max best lit + + going.Clear () + Array.Clear seen + Array.Clear arr.Elements + going.Add (storeDirectionAndPos numCols (numCols - 1) start Direction.Left) + + while going.Count > 0 do + let nextUp = going.[going.Count - 1] + match seen.[int nextUp] with + | true -> + going.RemoveAt (going.Count - 1) + | false -> + seen.[int nextUp] <- true + advance arr going s nextUp + let lit = arr.Elements.AsSpan().Count true + best <- max best lit + + best diff --git a/AdventOfCode2023.FSharp/Test/TestDay16.fs b/AdventOfCode2023.FSharp/Test/TestDay16.fs index b88406b..707fc4e 100644 --- a/AdventOfCode2023.FSharp/Test/TestDay16.fs +++ b/AdventOfCode2023.FSharp/Test/TestDay16.fs @@ -43,4 +43,4 @@ module TestDay16 = Assert.Inconclusive () failwith "unreachable" - Day16.part2 s |> shouldEqual 0 + Day16.part2 s |> shouldEqual 8314