AdventOfCode 2020, December 16

AdventOfCode2020.12.16.fsx

module Sixteeen =

    open System
    open System.IO
    open System.Text.RegularExpressions

    type Range = {
        Min : int
        Max : int
    }

    type FieldRange = {
        Name : string
        Left : Range
        Right : Range
    }

    type Input = {
        FieldRanges : FieldRange list
        YourTicket : int array
        NearbyTickets : int array list
    }

    let parseFieldRange (line : string) =
        let m = Regex.Match(line, @"^([a-zA-Z0-9_ ]+): (\d+)-(\d+) or (\d+)-(\d+)$")
        if m.Success 
        then Some {
            Name = m.Groups.[1].Value
            Left = { Min = m.Groups.[2].Value |> Int32.Parse; Max = m.Groups.[3].Value  |> Int32.Parse }
            Right = { Min = m.Groups.[4].Value |> Int32.Parse; Max = m.Groups.[5].Value  |> Int32.Parse } }
        else None

    let parseTicket (line : string) =
        line.Split ',' |> Array.map Int32.Parse

    let parseInput lines =
        lines
        |> Array.fold (fun acc line -> 
            match parseFieldRange line with
            | Some r -> { acc with FieldRanges = r::acc.FieldRanges }
            | None -> 
                if line.Contains "," then
                    if acc.YourTicket.Length = 0 then
                        { acc with YourTicket = parseTicket line }
                    else
                        { acc with NearbyTickets = (parseTicket line) :: acc.NearbyTickets }
                else
                    acc
        ) { FieldRanges = List.empty; YourTicket = Array.empty; NearbyTickets = List.empty }

    let hasValidRange (range : FieldRange) num =
        num >= range.Left.Min && num <= range.Left.Max ||
        num >= range.Right.Min && num <= range.Right.Max

    let getInvalidFields ranges ticket =
        ticket
        |> Array.filter (fun field -> 
            ranges |> List.forall (fun range -> not (hasValidRange range field)))
        |> Array.toList

    let input = 
        File.ReadAllLines("Data/input16.txt")
        |> parseInput

    // Part One

    input.NearbyTickets 
    |> List.map (fun ticket -> getInvalidFields input.FieldRanges ticket)
    |> List.concat
    |> List.sum

    // Part Two

    let getSatisfyingFields (ranges : FieldRange list) ticket =
        ticket
        |> Array.mapi (fun i num ->
            i, 
            ranges 
            |> List.mapi (fun j range -> if hasValidRange range num then Some j else None)
            |> List.choose id
            |> Set.ofList)
        |> Map.ofArray

    getSatisfyingFields input.FieldRanges input.YourTicket

    let validInput = {
        input with NearbyTickets =
                    input.NearbyTickets 
                    |> List.choose (fun ticket -> 
                        match getInvalidFields input.FieldRanges ticket with
                        | [] -> Some ticket
                        | _ -> None)
    }

    let rec findPosition sets =
        match sets with
        | [] -> None
        | (pos, fields) :: sets ->
            match fields with
            | [] -> None
            | [field] -> Some (pos,field)
            | _ -> findPosition sets

    let rec findPositions result sets =
        match sets with
        | [] -> result
        | _ ->
            match findPosition sets with
            | Some (pos,field) ->
                let sets =
                    sets 
                    |> List.filter (fun (n,s) -> n <> pos)
                    |> List.map (fun (n,s) -> n, s |> List.filter (fun f -> f <> field))
                    |> List.filter (fun (n,s) -> s.Length > 0)
                findPositions ((pos,field) :: result) sets 
            | None -> result

    let fieldPositions =
        validInput.NearbyTickets
        |> List.map (fun ticket -> getSatisfyingFields validInput.FieldRanges ticket)
        |> List.reduce (fun acc sets -> 
            sets |> Map.fold (fun acc' n s -> 
                acc' |> Map.add n (Set.intersect (acc' |> Map.find n) s)) acc)
        |> Map.map (fun k v -> v |> Set.toList)
        |> Map.toList
        |> findPositions [] 

    let departureFields =
        validInput.FieldRanges
        |> List.mapi (fun i x -> i, x.Name)
        |> List.filter (fun (i,name) -> name.StartsWith "departure")
        |> List.map fst

    let departurePositions =
        fieldPositions 
        |> List.filter (fun (n,f) -> departureFields |> List.contains f)
        |> List.map fst    

    validInput.YourTicket
    |> Array.mapi (fun i v -> i,v)
    |> Array.filter (fun (pos,v) -> departurePositions |> List.contains pos)
    |> Array.map snd
    |> Array.map int64
    |> Array.reduce (fun acc n -> acc * n)