patrick/advent-of-code-2023
1
0
Fork 0
Code Issues Pull Requests 2 Packages Releases Activity

Part 2

Browse Source
This commit is contained in:
Smaug123
2023-12-16 11:33:29 +00:00
parent 87c422e6d5
commit 012e7c193c
2 changed files with 206 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files

320
AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day16.fs
View File

@@ -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
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<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

2
AdventOfCode2023.FSharp/Test/TestDay16.fs
View File

@@ -43,4 +43,4 @@ module TestDay16 =
Assert.Inconclusive ()
failwith "unreachable"
Day16.part2 s |> shouldEqual 0
Day16.part2 s |> shouldEqual 8314