advent-of-code-2023/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day5.fs

namespace AdventOfCode2023

open System
open System.Collections.Generic

[<Struct>]
type Range =
    {
        SourceStart : uint32
        DestStart : uint32
        Len : uint32
    }

[<RequireQualifiedAccess>]
module Day5 =

    let remap (range : Range) (i : uint32) =
        if range.SourceStart <= i && i - range.SourceStart < range.Len then
            i + (range.DestStart - range.SourceStart) |> 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 (UInt32.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.consumeU32 &line
                let sourceStart = StringSplitEnumerator.consumeU32 &line
                let rangeLen = StringSplitEnumerator.consumeU32 &line

                {
                    SourceStart = sourceStart
                    DestStart = destStart
                    Len = rangeLen
                }
                |> currentMapping.Add

        seeds, mappings

    let part1 (s : string) =
        let seeds, mappings = parse s

        let mutable best = UInt32.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.
    // Returns any range we didn't map.
    let private split
        (result : ResizeArray<uint32 * uint32>)
        (start, finish)
        (rangeFromLayer : Range)
        : (uint32 * uint32 * (uint32 * uint32) 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.DestStart - rangeFromLayer.SourceStart,
                    finish + rangeFromLayer.DestStart - rangeFromLayer.SourceStart
                )

                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.DestStart - rangeFromLayer.SourceStart,
                    high + rangeFromLayer.DestStart - rangeFromLayer.SourceStart
                )

                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.DestStart - rangeFromLayer.SourceStart,
                high + rangeFromLayer.DestStart - rangeFromLayer.SourceStart
            )

            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.DestStart - rangeFromLayer.SourceStart,
                finish + rangeFromLayer.DestStart - rangeFromLayer.SourceStart
            )

            ValueSome (start, low - 1ul, ValueNone)
        else
            ValueSome (start, finish, ValueNone)

    let part2 (s : string) : uint32 =
        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 = UInt32.MaxValue

        for i, _ in intervals do
            best <- min best i

        best