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

namespace AdventOfCode2023

open System
open System.Collections.Generic
open System.Globalization

[<RequireQualifiedAccess>]
module Day19 =

    type Component =
        | X = 0
        | M = 1
        | A = 2
        | S = 3

    [<RequireQualifiedAccess>]
    module Component =
        let ofChar (c : char) : Component =
            match c with
            | 'x' -> Component.X
            | 'm' -> Component.M
            | 'a' -> Component.A
            | 's' -> Component.S
            | c -> failwith $"bad component: %c{c}"

    type Dest =
        | Register of string
        | Accept
        | Reject
        static member OfString (s : EfficientString) : Dest =
            if s.Length = 1 && s.[0] = 'A' then Dest.Accept
            elif s.Length = 1 && s.[0] = 'R' then Dest.Reject
            else Dest.Register (s.ToString ())

    type Rule =
        {
            Component : Component
            IsLess : bool
            Operand : int
            Target : Dest
        }

        static member OfString (s : EfficientString) : Choice<Rule, Dest> =
            match s.IndexOf ':' with
            | -1 ->
                Choice2Of2 (Dest.OfString (s.Slice (0, s.Length)))
            | colon ->

            let dest = Dest.OfString (s.Slice (colon + 1))
            let comp = Component.ofChar s.[0]
            let isLess =
                match s.[1] with
                | '>' -> false
                | '<' -> true
                | c -> failwith $"Bad comparison: %c{c}"
            let operand = Int32.Parse (s.Slice (2, colon - 2), NumberStyles.None)
            {
                Component = comp
                IsLess = isLess
                Target = dest
                Operand = operand
            }
            |> Choice1Of2

    let inline matches (rule : Rule) x m a s =
        match rule.Component with
        | Component.A ->
            if (rule.IsLess && a < rule.Operand) || (not rule.IsLess && a > rule.Operand) then Some rule.Target else None
        | Component.X ->
            if (rule.IsLess && x < rule.Operand) || (not rule.IsLess && x > rule.Operand) then Some rule.Target else None
        | Component.M ->
            if (rule.IsLess && m < rule.Operand) || (not rule.IsLess && m > rule.Operand) then Some rule.Target else None
        | Component.S ->
            if (rule.IsLess && s < rule.Operand) || (not rule.IsLess && s > rule.Operand) then Some rule.Target else None
        | _ -> failwith "bad component"

    let rec compute (components : Dictionary<string, Rule ResizeArray * Dest>) x m a s (reg : string) =
        match components.TryGetValue reg with
        | false, _ ->
            failwith $"no rule matched: %s{reg}"
        | true, (rules, dest) ->
            let mutable result = ValueNone
            let mutable i = 0
            while result.IsNone do
                if i = rules.Count then
                    result <- ValueSome dest
                else

                match matches rules.[i] x m a s with
                | Some dest ->
                    result <- ValueSome dest
                | None ->
                    i <- i + 1

            match result.Value with
            | Register reg -> compute components x m a s reg
            | Accept -> true
            | Reject -> false

    let readWorkflows (rows : byref<StringSplitEnumerator>) =
        let workflows = Dictionary<string, Rule ResizeArray * Dest> ()
        while rows.MoveNext () && not rows.Current.IsEmpty do
            let brace = rows.Current.IndexOf '{'
            let name = rows.Current.Slice(0, brace).ToString ()
            let rules = ResizeArray ()
            for rule in StringSplitEnumerator.make' ',' (rows.Current.Slice(brace + 1).TrimEnd '}') do
                match Rule.OfString rule with
                | Choice1Of2 rule ->
                    rules.Add rule
                | Choice2Of2 dest ->
                    workflows.[name] <- (rules, dest)
        workflows

    let part1 (s : string) =
        use mutable rows = StringSplitEnumerator.make '\n' s
        let workflows = readWorkflows &rows

        let mutable answer = 0
        for row in rows do
            if not row.IsEmpty then
                let mutable x = 0
                let mutable m = 0
                let mutable a = 0
                let mutable s = 0
                for comp in StringSplitEnumerator.make' ',' (row.Slice (1, row.Length - 2)) do
                    let number = Int32.Parse (comp.Slice 2, NumberStyles.None)
                    match comp.[0] with
                    | 'x' -> x <- number
                    | 'm' -> m <- number
                    | 'a' -> a <- number
                    | 's' -> s <- number
                    | c -> failwith $"Bad char: %c{c}"

                if compute workflows x m a s "in" then
                    answer <- answer + x + m + a + s

        answer

    type AcceptanceCriterion =
        | True
        | False
        | Base of Component * low : int * high : int
        | And of AcceptanceCriterion * AcceptanceCriterion
        | Or of AcceptanceCriterion * AcceptanceCriterion

    let rec acAnd a b =
        match a, b with
        | AcceptanceCriterion.Or (a1, a2), _ ->
            AcceptanceCriterion.Or (acAnd a1 b, acAnd a2 b)
        | AcceptanceCriterion.True, _ -> b
        | AcceptanceCriterion.False, _ -> False
        | _, AcceptanceCriterion.Or (b1, b2) ->
            AcceptanceCriterion.Or (acAnd a b1, acAnd a b2)
        | _, AcceptanceCriterion.True -> a
        | _, AcceptanceCriterion.False -> False
        | _, _ -> AcceptanceCriterion.And (a, b)

    let inline acOr a b =
        match a, b with
        | AcceptanceCriterion.False, _ -> b
        | AcceptanceCriterion.True, _ -> AcceptanceCriterion.True
        | _, AcceptanceCriterion.False -> a
        | _, AcceptanceCriterion.True -> AcceptanceCriterion.True
        | _, _ -> AcceptanceCriterion.Or (a, b)

    let rec acceptance (store : Dictionary<string, AcceptanceCriterion>) (workflows : Dictionary<string, ResizeArray<Rule> * Dest>) (key : string) : AcceptanceCriterion =
        match store.TryGetValue key with
        | true, v -> v
        | false, _ ->

        let rules, final = workflows.[key]
        let seed =
            match final with
            | Register s -> acceptance store workflows s
            | Accept -> AcceptanceCriterion.True
            | Reject -> AcceptanceCriterion.False

        let result =
            (seed, Seq.rev rules)
            ||> Seq.fold (fun crit rule ->
                match rule.Target with
                | Register target ->
                    let cond =
                        if rule.IsLess then
                            AcceptanceCriterion.Base (rule.Component, 1, rule.Operand - 1)
                        else
                            AcceptanceCriterion.Base (rule.Component, rule.Operand + 1, 4000)
                    acOr (acAnd cond (acceptance store workflows target)) crit
                | Accept ->
                    let cond =
                        if rule.IsLess then
                            AcceptanceCriterion.Base (rule.Component, 1, rule.Operand - 1)
                        else
                            AcceptanceCriterion.Base (rule.Component, rule.Operand + 1, 4000)
                    acOr cond crit
                | Reject ->
                    let negCond =
                        if not rule.IsLess then
                            AcceptanceCriterion.Base (rule.Component, 1, rule.Operand - 1)
                        else
                            AcceptanceCriterion.Base (rule.Component, rule.Operand + 1, 4000)
                    acAnd negCond crit
            )
        store.[key] <- result
        result

    let part2 (s : string) =
        use mutable rows = StringSplitEnumerator.make '\n' s
        let workflows = readWorkflows &rows

        let acceptanceRanges = Dictionary<string, AcceptanceCriterion> ()

        let a = acceptance acceptanceRanges workflows "in"

        printfn "%+A" a

        //uint64 (IntervalSet.count resolved.X) * uint64 (IntervalSet.count resolved.M) * uint64 (IntervalSet.count resolved.A) * uint64 (IntervalSet.count resolved.S)
        0uL