Advent of Code 2023 4

advent2023-5.fs

open System

type Rule =
    { srcStart: int64
      destStart: int64
      length: int64 }
    member this.offset = this.destStart - this.srcStart
    member this.srcFinish = this.srcStart + this.length - 1L
    member this.destFinish = this.destStart + this.length - 1L
    
type Range =
    { start: int64
      finish: int64 }
    member this.Length = this.finish - this.start + 1L

type Game =
    { Seeds: int64[]
      Maps: Rule list list }
    member this.SeedRanges =
        this.Seeds
        |> Seq.chunkBySize 2
        |> Seq.map (fun [| srcStart; length |] ->
            { start = srcStart
              finish = srcStart + length - 1L }
        )
        |> Seq.toArray
        |> Array.sortBy (fun x -> x.start)

let mapRange (rules: Rule list) (initialRange: Range) =
    let rec loop srcRange (rules: Rule list) destRanges lastSrcRangeFinish =
        if srcRange.finish < srcRange.start then
            // if our range is done, return
            destRanges
        else
        match rules with
        | [] ->
            if lastSrcRangeFinish < srcRange.finish then
                // we have a reminder range which maps to itself
                { start = lastSrcRangeFinish + 1L
                  finish = srcRange.finish } :: destRanges
            else
                destRanges
        | rule :: rulesLeft ->
            
            // if rule finishes before baseRange.start, skip
            // -------------| baseRange |---------
            // ---| rule |------------------------
            if rule.srcFinish < srcRange.start then
                loop srcRange rulesLeft destRanges lastSrcRangeFinish
                
            // if rule start after baseRange.finish, skip
            // ---------| baseRange |-------------
            // ------------------------| rule |---
            elif rule.srcStart > srcRange.finish then
                loop srcRange rulesLeft destRanges lastSrcRangeFinish

            // if rule start before initialRange.start, add mapped range
            // -------| baseRange |------------------------
            // ---| rule .............. // don't know where it finishes
            elif rule.srcStart <= srcRange.start then
                let newRangeStart = srcRange.start
                let newRangeEnd = min rule.srcFinish srcRange.finish
                let newDestRange =
                    { start = newRangeStart + rule.offset
                      finish = newRangeEnd + rule.offset }
                let newSrcRange =
                    { start = newRangeEnd + 1L
                      finish = srcRange.finish }
                loop newSrcRange rulesLeft (newDestRange :: destRanges) newRangeEnd

            // rule starts after initialRange.start, add mapped range
            // -------| baseRange |------------------------
            // -----------| rule .............. // don't know where it finishes
            else
                let newRangeStart = srcRange.start
                let newRangeEnd = rule.srcStart - 1L
                let newDestRange =
                    { start = newRangeStart
                      finish = newRangeEnd }
                let newSrcRange =
                    { start = rule.srcStart
                      finish = srcRange.finish } 
                loop newSrcRange rulesLeft (newDestRange :: destRanges) newRangeEnd

    loop initialRange rules [] (initialRange.start-1L)
    |> List.sortBy (fun x -> x.start)

let splitInts (str: string) = str.Split(' ', StringSplitOptions.RemoveEmptyEntries) |> Array.map int64

let parseInput (input: string[]) =
    let seeds = input.[0].Substring 6 |> splitInts
    let result, lastMap =
        input
        |> Seq.skip 3
        |> Seq.fold (fun (rulesList: Rule list list, prevRules: _ list) line ->
            if line = "" || not(Char.IsDigit line[0]) then
                // word line, skip
                if prevRules.IsEmpty then
                    rulesList, []
                else
                    prevRules
                    |> List.sortBy (fun x -> x.srcStart)
                    |> fun x -> x :: rulesList, []
            else
                // parse rule and add to prevRules
                let rule = splitInts line |> fun [| destStart; srcStart; length |] ->
                    { srcStart = srcStart
                      destStart = destStart
                      length = length }
                rulesList, rule :: prevRules

        ) ([], [])
    
    { Seeds = seeds
      Maps =
          lastMap
          
          |> List.sortBy (fun x -> x.srcStart)
          |> fun x -> x :: result
          |> List.rev }

let play rules seeds =
    let rec play rulesList ranges  =
        match rulesList with
        | [] -> ranges
        | rules :: rulesLeft ->
            ranges
            |> Seq.collect (mapRange rules)
            |> Seq.sortBy (fun x -> x.start)
            |> play rulesLeft 

    play rules seeds
    |> Seq.head
    |> fun x -> x.start

let input =
    """seeds: 79 14 55 13

seed-to-soil map:
50 98 2
52 50 48

soil-to-fertilizer map:
0 15 37
37 52 2
39 0 15

fertilizer-to-water map:
49 53 8
0 11 42
42 0 7
57 7 4

water-to-light map:
88 18 7
18 25 70

light-to-temperature map:
45 77 23
81 45 19
68 64 13

temperature-to-humidity map:
0 69 1
1 0 69

humidity-to-location map:
60 56 37
56 93 4""" |> fun x -> x.Split('\n')

let game = parseInput input

//part 1
game.Seeds
|> Seq.map (fun x -> { start = x; finish = x })
|> play game.Maps 
|> printfn "part 1: %A" // 35

// part 2
play game.Maps game.SeedRanges
|> printfn "part 1: %A" // 46