275 lines
9.3 KiB
Forth
275 lines
9.3 KiB
Forth
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 cata<'ret>
|
|
(atOr : 'ret -> 'ret -> 'ret)
|
|
(atAnd : 'ret -> 'ret -> 'ret)
|
|
(atFalse : unit -> 'ret)
|
|
(atTrue : unit -> 'ret)
|
|
(atBase : Component -> int -> int -> 'ret)
|
|
(ac : AcceptanceCriterion)
|
|
: 'ret
|
|
=
|
|
match ac with
|
|
| AcceptanceCriterion.False -> atFalse ()
|
|
| AcceptanceCriterion.True -> atTrue ()
|
|
| AcceptanceCriterion.Base (comp, low, high) -> atBase comp low high
|
|
| AcceptanceCriterion.And (a1, a2) ->
|
|
atAnd (cata atOr atAnd atFalse atTrue atBase a1) (cata atOr atAnd atFalse atTrue atBase a2)
|
|
| AcceptanceCriterion.Or (a1, a2) ->
|
|
atOr (cata atOr atAnd atFalse atTrue atBase a1) (cata atOr atAnd atFalse atTrue atBase a2)
|
|
|
|
type UnionOfConjunctions = (Component * int * int) list list
|
|
|
|
let toUnion (ac : AcceptanceCriterion) : UnionOfConjunctions =
|
|
cata
|
|
List.append
|
|
(fun l1 l2 -> [ List.concat (l1 @ l2) ])
|
|
(fun () -> failwith "no falses")
|
|
(fun () -> failwith "no trues")
|
|
(fun comp low high -> [ [ comp, low, high ] ])
|
|
ac
|
|
|
|
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"
|
|
let union = toUnion a
|
|
|
|
printfn "%+A" a
|
|
printfn "%+A" union
|
|
|
|
//uint64 (IntervalSet.count resolved.X) * uint64 (IntervalSet.count resolved.M) * uint64 (IntervalSet.count resolved.A) * uint64 (IntervalSet.count resolved.S)
|
|
0uL
|