Part 2

AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day16.fs

@@ -6,8 +6,6 @@ namespace AdventOfCode2023
 #endif
 
 open System
-open System.Collections.Generic
-open System.Globalization
 
 [<RequireQualifiedAccess>]
 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
+                seen.[int nextUp] <- true
-            let col = getCol numCols nextUp
+                advance arr going s 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}"
 
         arr.Elements.AsSpan().Count true
 
     let part2 (s : string) =
-        use lines = StringSplitEnumerator.make '\n' s
+        let numLines = s.AsSpan().Count '\n'
-        0
+        let numCols = s.IndexOf '\n'
+        let arr = Array.zeroCreate (numLines * numCols)
+#if DEBUG
+        let arr : Arr2D<bool> =
+            {
+                Elements = arr
+                Width = numCols
+            }
+#else
+        use ptr = fixed arr
+        let arr : Arr2D<bool> =
+            {
+                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

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