200 lines
8.9 KiB
Forth
200 lines
8.9 KiB
Forth
namespace AdventOfCode2023
|
|
|
|
open System
|
|
open System.Collections.Generic
|
|
|
|
[<Struct>]
|
|
type Range =
|
|
{
|
|
SourceStart : uint64
|
|
DestStart : uint64
|
|
Len : uint64
|
|
}
|
|
|
|
[<RequireQualifiedAccess>]
|
|
module Day5 =
|
|
|
|
let remap (range : Range) (i : uint64) =
|
|
if range.SourceStart <= i && i < range.SourceStart + range.Len then
|
|
i - range.SourceStart + range.DestStart
|
|
|> ValueSome
|
|
else
|
|
ValueNone
|
|
|
|
let parse (s : string) =
|
|
use mutable lines = StringSplitEnumerator.make '\n' s
|
|
lines.MoveNext () |> ignore
|
|
let seeds =
|
|
use mutable line1 = StringSplitEnumerator.make' ' ' lines.Current
|
|
StringSplitEnumerator.chomp "seeds:" &line1
|
|
let result = ResizeArray ()
|
|
while line1.MoveNext () do
|
|
result.Add (UInt64.Parse line1.Current)
|
|
result.ToArray ()
|
|
lines.MoveNext () |> ignore
|
|
|
|
let mappings = ResizeArray ()
|
|
|
|
let mutable currentMapping = null
|
|
|
|
for line in lines do
|
|
if line.IsEmpty then
|
|
if not (isNull currentMapping) then
|
|
mappings.Add currentMapping
|
|
currentMapping <- null
|
|
else
|
|
if isNull currentMapping then
|
|
currentMapping <- ResizeArray ()
|
|
else
|
|
use mutable line = StringSplitEnumerator.make' ' ' line
|
|
let destStart = StringSplitEnumerator.consumeU64 &line
|
|
let sourceStart = StringSplitEnumerator.consumeU64 &line
|
|
let rangeLen = StringSplitEnumerator.consumeU64 &line
|
|
{
|
|
SourceStart = sourceStart
|
|
DestStart = destStart
|
|
Len = rangeLen
|
|
}
|
|
|> currentMapping.Add
|
|
|
|
seeds, mappings
|
|
|
|
let part1 (s : string) =
|
|
let seeds, mappings = parse s
|
|
|
|
let mutable best = UInt64.MaxValue
|
|
for seed in seeds do
|
|
let mutable remapped = seed
|
|
for map in mappings do
|
|
let mutable hasRemappedThisLayer = false
|
|
for interval in map do
|
|
if not hasRemappedThisLayer then
|
|
match remap interval remapped with
|
|
| ValueNone ->
|
|
()
|
|
| ValueSome n ->
|
|
hasRemappedThisLayer <- true
|
|
remapped <- n
|
|
if remapped < best then
|
|
best <- remapped
|
|
|
|
best
|
|
|
|
// The input ranges are inclusive at both ends.
|
|
let private split'' (ranges : (uint64 * uint64) ResizeArray) sourceStart sourceLen : unit =
|
|
let startsStack = ResizeArray ()
|
|
let endsStack = ResizeArray ()
|
|
startsStack.Add sourceStart
|
|
endsStack.Add (sourceStart + sourceLen - 1uL)
|
|
while startsStack.Count > 0 do
|
|
let mutable i = 0
|
|
while i < ranges.Count do
|
|
let low, high = ranges.[i]
|
|
if startsStack.Count > 0 && low <= startsStack.[startsStack.Count - 1] && endsStack.[endsStack.Count - 1] <= high then
|
|
// splitting because:
|
|
// low ... start .. finish .. high
|
|
ranges.[i] <- (low, startsStack.[startsStack.Count - 1] - 1uL)
|
|
ranges.Add (startsStack.[startsStack.Count - 1], endsStack.[endsStack.Count - 1])
|
|
ranges.Add (endsStack.[endsStack.Count - 1] + 1uL, high)
|
|
startsStack.RemoveAt (startsStack.Count - 1)
|
|
endsStack.RemoveAt (endsStack.Count - 1)
|
|
elif startsStack.Count > 0 && low <= startsStack.[startsStack.Count - 1] && startsStack.[startsStack.Count - 1] <= high then
|
|
// splitting because:
|
|
// low .. start .. high .. finish
|
|
ranges.[i] <- (low, startsStack.[startsStack.Count - 1] - 1uL)
|
|
ranges.Add (startsStack.[startsStack.Count - 1], high)
|
|
startsStack.[startsStack.Count - 1] <- high + 1uL
|
|
elif startsStack.Count > 0 && low > startsStack.[startsStack.Count - 1] && low < endsStack.[endsStack.Count - 1] && endsStack.[endsStack.Count - 1] <= high then
|
|
// splitting because:
|
|
// start .. low .. finish .. high
|
|
ranges.[i] <- (low, endsStack.[endsStack.Count - 1])
|
|
ranges.Add (endsStack.[endsStack.Count - 1], high)
|
|
endsStack.[endsStack.Count - 1] <- low - 1uL
|
|
elif startsStack.Count > 0 && low > startsStack.[startsStack.Count - 1] && low < endsStack.[endsStack.Count - 1] && high < endsStack.[endsStack.Count - 1] then
|
|
// splitting because:
|
|
// start .. low .. high .. finish
|
|
startsStack.Add (high + 1uL)
|
|
endsStack.Add endsStack.[endsStack.Count - 1]
|
|
endsStack.[endsStack.Count - 2] <- low - 1uL
|
|
i <- i + 1
|
|
|
|
// The input ranges are inclusive at both ends.
|
|
// Returns any range we didn't map.
|
|
let private split (result : ResizeArray<uint64 * uint64>) (start, finish) (rangeFromLayer : Range) : (uint64 * uint64 * (uint64 * uint64) voption) voption =
|
|
let low, high = rangeFromLayer.SourceStart, rangeFromLayer.SourceStart + rangeFromLayer.Len - 1uL
|
|
if low <= start then
|
|
if finish <= high then
|
|
// low ... start .. finish .. high
|
|
// so the entire input range gets mapped down
|
|
result.Add (start - rangeFromLayer.SourceStart + rangeFromLayer.DestStart, finish - rangeFromLayer.SourceStart + rangeFromLayer.DestStart)
|
|
ValueNone
|
|
elif start <= high then
|
|
// low .. start .. high .. finish
|
|
// so start .. high gets mapped down
|
|
// and high + 1 .. finish stays where it is.
|
|
// high < finish is already guaranteed by previous if block.
|
|
result.Add (start - rangeFromLayer.SourceStart + rangeFromLayer.DestStart, high - rangeFromLayer.SourceStart + rangeFromLayer.DestStart)
|
|
ValueSome (high + 1uL, finish, ValueNone)
|
|
else
|
|
ValueSome (start, finish, ValueNone)
|
|
else
|
|
if high <= finish then
|
|
// start .. low .. high .. finish
|
|
// so start .. low - 1 stays where it is
|
|
// low .. high gets mapped down
|
|
// and high + 1 .. finish stays where it is
|
|
result.Add (low - rangeFromLayer.SourceStart + rangeFromLayer.DestStart, high - rangeFromLayer.SourceStart + rangeFromLayer.DestStart)
|
|
ValueSome (start, low - 1uL, ValueSome (high + 1uL, finish))
|
|
elif low < finish then
|
|
// start .. low .. finish .. high
|
|
// so start .. low - 1 stays where it is
|
|
// and low .. finish gets mapped down
|
|
result.Add (low - rangeFromLayer.SourceStart + rangeFromLayer.DestStart, finish - rangeFromLayer.SourceStart + rangeFromLayer.DestStart)
|
|
ValueSome (start, low - 1uL, ValueNone)
|
|
else
|
|
ValueSome (start, finish, ValueNone)
|
|
|
|
let part2 (s : string) : uint64 =
|
|
let seeds, mappings = parse s
|
|
|
|
let mutable intervals = ResizeArray ()
|
|
|
|
for i = 0 to (seeds.Length - 1) / 2 do
|
|
let t = seeds.[2 * i], seeds.[2 * i + 1] + seeds.[2 * i] - 1uL
|
|
intervals.Add t
|
|
|
|
let mutable nextIntervals = ResizeArray ()
|
|
|
|
for mapLayer in mappings do
|
|
let mutable i = 0
|
|
while i < intervals.Count do
|
|
// split interval according to every map
|
|
let mutable allMoved = false
|
|
let mutable currentRange = 0
|
|
while not allMoved && currentRange < mapLayer.Count do
|
|
let range = mapLayer.[currentRange]
|
|
// range is e.g. 50 98 2, i.e. "98-99 goes to 50-51"
|
|
match split nextIntervals intervals.[i] range with
|
|
| ValueNone ->
|
|
allMoved <- true
|
|
| ValueSome (start, finish, v) ->
|
|
intervals.[i] <- (start, finish)
|
|
match v with
|
|
| ValueNone -> ()
|
|
| ValueSome (start, finish) ->
|
|
intervals.Add (start, finish)
|
|
currentRange <- currentRange + 1
|
|
if not allMoved then
|
|
nextIntervals.Add intervals.[i]
|
|
i <- i + 1
|
|
let oldIntervals = intervals
|
|
oldIntervals.Clear ()
|
|
intervals <- nextIntervals
|
|
nextIntervals <- oldIntervals
|
|
|
|
let mutable best = UInt64.MaxValue
|
|
for i, _ in intervals do
|
|
best <- min best i
|
|
|
|
best
|