Advent of Code 2023, December 19

AdventOfCode2023.12.19.fsx

open System
open System.IO

type Operator = | Less | Greater

type Condition = {
    Attribute: char
    Operator: Operator
    Value: int
}

type Rule = 
    | Goto of string
    | GotoOn of Condition * string
    | Accept
    | AcceptOn of Condition
    | Reject
    | RejectOn of Condition

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

let splitIndex = input |> List.findIndex String.IsNullOrEmpty

let parseCondition (str: string) =
    let tokens = str.Split [|'<';'>'|]
    { 
        Attribute = tokens[0][0]
        Operator = if str.Contains "<" then Less else Greater
        Value = Int32.Parse tokens[1]
    }

let parseWorkflow (str: string) =
    let tokens = str.Split [|'{';'}'|]
    let name = tokens[0]
    let rules = 
        tokens[1].Split ',' 
        |> Seq.map (fun str ->
            let tokens = str.Split ':'
            if tokens.Length = 1 then
                if tokens[0] = "A" then Accept
                else if tokens[0] = "R" then Reject
                else Goto tokens[0]
            else if str.EndsWith "A" then
                AcceptOn (parseCondition tokens[0])
            else if str.EndsWith "R" then
                RejectOn (parseCondition tokens[0])
            else
                GotoOn (parseCondition tokens[0], tokens[1]))
        |> Seq.toList
    name, rules

let workflows = input |> List.take splitIndex |> List.map parseWorkflow |> Map.ofSeq

// PartOne

let parsePart (str: string) =
    str.Substring(1, str.Length-2).Split ','
    |> Seq.map (fun token ->
        let tokens = token.Split '='
        tokens[0][0], Int32.Parse tokens[1])
    |> Seq.toList

module One =

    type PartState = 
        | Workflow of string
        | Accepted
        | Rejected

    let parts = input |> List.skip (splitIndex + 1) |> List.map parsePart

    let satisfies part (condition: Condition) =
        let attr = part |> List.find (fun x -> fst x = condition.Attribute)
        match condition.Operator with
        | Less -> snd attr < condition.Value
        | Greater -> snd attr > condition.Value

    let rec applyRules part (rules: Rule list) =
        match rules with
        | Accept :: _ -> Accepted
        | Reject :: _ -> Rejected
        | Goto workflow :: _ -> Workflow workflow
        | AcceptOn c :: rules -> if satisfies part c then Accepted else applyRules part rules
        | RejectOn c :: rules -> if satisfies part c then Rejected else applyRules part rules
        | GotoOn (c, workflow) :: rules -> if satisfies part c then Workflow workflow else applyRules part rules
        | _ -> raise <| Exception "Unexpected rule"

    let applyWorkflow part workflow =
        let rules = workflows |> Map.find workflow
        applyRules part rules

    let rec runWorkflows part state =
        match state with
        | Accepted -> part, state
        | Rejected -> part, state
        | Workflow workflow -> applyWorkflow part workflow |> runWorkflows part

    parts
    |> List.map (fun part -> runWorkflows part (Workflow "in"))
    |> List.filter (fun (part, state) -> state = Accepted)
    |> List.map (fun (part, state) -> part |> List.map snd |> List.sum)
    |> List.sum

module Two =

    type RangeState = 
        | Workflow of Map<char,int*int> * string
        | Accepted of Map<char,int*int>
        | Rejected of Map<char,int*int>

    let initialRange = 
        [
            ('x',(1,4000))
            ('m',(1,4000))
            ('a',(1,4000))
            ('s',(1,4000))
        ]
        |> Map.ofSeq

    let splitRange range (condition: Condition) =
        let minValue,maxValue = range |> Map.find condition.Attribute
        let included,excluded =
            match condition.Operator with
            | Less -> 
                let maxValue' = Math.Min(maxValue, condition.Value-1)
                (minValue,maxValue'), (maxValue'+1,maxValue)
            | Greater ->
                let minValue' = Math.Max(minValue, condition.Value+1)
                (minValue',maxValue), (minValue,minValue'-1)
        let includedRange = range |> Map.add condition.Attribute included
        let excludedRange = range |> Map.add condition.Attribute excluded
        (includedRange, excludedRange)        

    let rec applyRules range (rules: Rule list) =
        match rules with
        | Accept :: _ -> [Accepted range]
        | Reject :: _ -> [Rejected range]
        | Goto workflow :: _ -> [Workflow (range, workflow)]
        | AcceptOn c :: rules -> 
            let included,excluded = splitRange range c
            (Accepted included) :: (applyRules excluded rules)
        | RejectOn c :: rules -> 
            let included,excluded = splitRange range c
            (Rejected included) :: (applyRules excluded rules)
        | GotoOn (c, workflow) :: rules -> 
            let included,excluded = splitRange range c
            (Workflow (included, workflow)) :: (applyRules excluded rules)
        | _ -> raise <| Exception "Unexpected rule"

    let applyWorkflow range workflow =
        let rules = workflows |> Map.find workflow
        applyRules range rules

    let rec runWorkflows states =
        let accepted = 
            states
            |> List.choose (fun state -> 
                match state with 
                | Accepted range -> Some range 
                | _ -> None)
        let pending = 
            states
            |> List.choose (fun state -> 
                match state with 
                | Workflow (range, workflow) -> Some(range,workflow) 
                | _ -> None)
        if List.isEmpty pending then
            accepted
        else
            let applied = pending |> List.map (fun (range, workflow) -> applyWorkflow range workflow) |> List.concat
            List.concat [accepted; applied |> runWorkflows]

    runWorkflows [Workflow (initialRange, "in")]
    |> List.map (fun range -> range |> Map.map (fun _ v -> int64 (snd v - fst v + 1)))
    |> List.map (Map.values >> List.ofSeq)
    |> List.map (fun vals -> vals[0] * vals[1] * vals[2] * vals[3])
    |> List.sum