284 lines
9.8 KiB
Forth
284 lines
9.8 KiB
Forth
namespace AdventOfCode2023
|
|
|
|
#if DEBUG
|
|
#else
|
|
#nowarn "9"
|
|
#endif
|
|
|
|
open System
|
|
|
|
[<RequireQualifiedAccess>]
|
|
module Day16 =
|
|
|
|
let inline storeDirectionAndPos (numCols : int) (col : int) (row : int) (direction : Direction) : uint16 =
|
|
4us * uint16 (col + numCols * row) + Direction.toUInt direction
|
|
|
|
let inline getDirection (input : uint16) =
|
|
match input % 4us with
|
|
| 0us -> Direction.Left
|
|
| 1us -> Direction.Right
|
|
| 2us -> Direction.Up
|
|
| 3us -> Direction.Down
|
|
| _ -> failwith "bad"
|
|
|
|
let inline getCol (numCols : int) (input : uint16) = (input / 4us) % uint16 numCols |> int
|
|
|
|
let inline getRow (numCols : int) (input : uint16) = (input / 4us) / uint16 numCols |> int
|
|
|
|
let inline maxEncoded (numCols : int) (numRows : int) : uint16 =
|
|
4us * uint16 ((numCols - 1) + numCols * (numRows - 1)) + 3us
|
|
|
|
let inline getAt (numCols : int) (s : string) (row : int) (col : int) = s.[row * (numCols + 1) + col]
|
|
|
|
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}"
|
|
| _ -> failwith "bad"
|
|
|
|
let part1 (s : string) =
|
|
let numLines = s.AsSpan().Count '\n'
|
|
let numCols = s.IndexOf '\n'
|
|
let buf = Array.zeroCreate (numLines * numCols)
|
|
#if DEBUG
|
|
let arr : Arr2D<bool> =
|
|
{
|
|
Elements = buf
|
|
Width = numCols
|
|
}
|
|
#else
|
|
use ptr = fixed buf
|
|
|
|
let arr : Arr2D<bool> =
|
|
{
|
|
Elements = ptr
|
|
Width = numCols
|
|
Length = buf.Length
|
|
}
|
|
#endif
|
|
let going = ResizeArray ()
|
|
|
|
going.Add (storeDirectionAndPos numCols 0 0 Direction.Right)
|
|
|
|
let seen = Array.zeroCreate (int (maxEncoded numCols numLines) + 1)
|
|
|
|
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
|
|
|
|
buf.AsSpan().Count true
|
|
|
|
let part2 (s : string) =
|
|
let numLines = s.AsSpan().Count '\n'
|
|
let numCols = s.IndexOf '\n'
|
|
let buf = Array.zeroCreate (numLines * numCols)
|
|
#if DEBUG
|
|
let arr : Arr2D<bool> =
|
|
{
|
|
Elements = buf
|
|
Width = numCols
|
|
}
|
|
#else
|
|
use ptr = fixed buf
|
|
|
|
let arr : Arr2D<bool> =
|
|
{
|
|
Elements = ptr
|
|
Width = numCols
|
|
Length = buf.Length
|
|
}
|
|
#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 buf
|
|
going.Add (storeDirectionAndPos numCols start 0 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 = buf.AsSpan().Count true
|
|
best <- max best lit
|
|
|
|
going.Clear ()
|
|
Array.Clear seen
|
|
Array.Clear buf
|
|
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 = buf.AsSpan().Count true
|
|
best <- max best lit
|
|
|
|
for start = 0 to numLines - 1 do
|
|
going.Clear ()
|
|
Array.Clear seen
|
|
Array.Clear buf
|
|
going.Add (storeDirectionAndPos numCols 0 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 = buf.AsSpan().Count true
|
|
best <- max best lit
|
|
|
|
going.Clear ()
|
|
Array.Clear seen
|
|
Array.Clear buf
|
|
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 = buf.AsSpan().Count true
|
|
best <- max best lit
|
|
|
|
best
|