Advent of Code 2023, December 5

AdventOfCode2023.12.05.fsx

#time "on"

open System
open System.IO

type Mapping = {
    Destination: int64
    Source: int64
    Range: int64
}

type ValueRange = {
    Start: int64
    Range: int64
}

let strToNum str =
    Int64.Parse str

let parseSeeds (str: string) =
    str.Trim().Split(' ')
    |> Seq.skip 1
    |> Seq.map strToNum
    |> Seq.toArray

let parseMapping (str: string) =
    let items = str.Trim().Split(' ')
    {
        Destination = strToNum items[0]
        Source = strToNum items[1]
        Range = strToNum items[2]
    }

let rec parseMappings (input: string array) ndx mappings =
    if ndx = input.Length || String.IsNullOrWhiteSpace input[ndx] then
        mappings |> List.rev
    else
        parseMapping input[ndx] :: (parseMappings input (ndx+1) mappings)


let input =
    File.ReadAllLines(__SOURCE_DIRECTORY__ + "/../data/input05.txt")
    |> Seq.toArray

let offsetSoil = 3
let seedToSoil = parseMappings input offsetSoil []
let offsetFertilizer = offsetSoil+seedToSoil.Length+2
let soilToFertilizer = parseMappings input offsetFertilizer []
let offsetWater = offsetFertilizer+soilToFertilizer.Length+2
let fertilizerToWater = parseMappings input offsetWater []
let offsetLight = offsetWater+fertilizerToWater.Length+2
let waterToLight = parseMappings input offsetLight []
let offsetTemperature = offsetLight+waterToLight.Length+2
let lightToTemperature = parseMappings input offsetTemperature []
let offsetHumidity = offsetTemperature+lightToTemperature.Length+2
let temperaturToHumidity = parseMappings input offsetHumidity []
let offsetLocation = offsetHumidity+temperaturToHumidity.Length+2
let humidityToLocation = parseMappings input offsetLocation []

// Part One

let findInMappings (mappings : Mapping list) src =
    match mappings |> List.tryFind (fun mapping -> src >= mapping.Source && src < mapping.Source + mapping.Range) with
    | Some mapping -> mapping.Destination + src - mapping.Source
    | None -> src

let seeds = parseSeeds input[0]

seeds
|> Array.map (fun seed -> 
    seed
    |> findInMappings seedToSoil
    |> findInMappings soilToFertilizer
    |> findInMappings fertilizerToWater
    |> findInMappings waterToLight
    |> findInMappings lightToTemperature
    |> findInMappings temperaturToHumidity
    |> findInMappings humidityToLocation)
|> Array.min


// Part Two

let rec compactRanges (acc: ValueRange list) currentRange (ranges: ValueRange list) =
    match ranges, currentRange with
    | [], Some currentRange -> currentRange :: acc |> List.rev
    | [], None -> acc |> List.rev
    | range :: ranges, Some currentRange ->
        if range.Start = currentRange.Start + currentRange.Range then
            compactRanges acc (Some { Start = currentRange.Start; Range = currentRange.Range + range.Range }) ranges
        else
            compactRanges (currentRange :: acc) (Some range) ranges
    | range :: ranges, None -> compactRanges acc (Some range) ranges

let rec mapRange (mappings : Mapping list) acc (range: ValueRange) =
    if range.Range = 0 then
        acc |> List.rev
    else
        match mappings |> List.tryFind (fun mapping -> range.Start >= mapping.Source && range.Start < mapping.Source + mapping.Range) with
        | Some mapping -> 
            let offset = range.Start - mapping.Source
            let length = Math.Min(range.Range, mapping.Range - offset)
            let start = mapping.Destination + range.Start - mapping.Source
            mapRange mappings ({Start = start; Range = length} :: acc) ({Start = range.Start + length; Range = range.Range - length})
        | None -> 
            let length = 
                match mappings |> List.filter (fun x -> x.Source > range.Start) with
                | [] -> range.Range
                | xs -> xs |> List.map (fun x -> x.Source) |> List.min |> fun x -> Math.Min(range.Range, x - range.Start)
            mapRange mappings ({Start = range.Start; Range = length} :: acc) ({Start = range.Start + length; Range = range.Range - length})

let mapRanges mappings src =
    src
    |> List.map (fun x -> x |> mapRange mappings [])
    |> List.concat
    |> List.sortBy (fun x -> x.Start)
    |> compactRanges [] None

parseSeeds input[0] |> Array.chunkBySize 2 |> Array.map (fun ar -> { Start = ar[0]; Range = ar[1] })
|> Array.toList
|> mapRanges seedToSoil
|> mapRanges soilToFertilizer
|> mapRanges fertilizerToWater
|> mapRanges waterToLight
|> mapRanges lightToTemperature
|> mapRanges temperaturToHumidity
|> mapRanges humidityToLocation
|> List.map (fun range -> range.Start)
|> List.min