Tree of ors with 'and' at leaf

This commit is contained in:
Smaug123
2023-12-23 12:52:29 +00:00
parent 8519bdfe05
commit 8c60bfb744

View File

@@ -143,107 +143,25 @@ module Day19 =
| And of AcceptanceCriterion * AcceptanceCriterion
| Or of AcceptanceCriterion * AcceptanceCriterion
[<RequireQualifiedAccess>]
module AcceptanceCriterion =
let rec simplify (ac : AcceptanceCriterion) : AcceptanceCriterion =
match ac with
| AcceptanceCriterion.True
| AcceptanceCriterion.False
| AcceptanceCriterion.Base _ -> ac
| AcceptanceCriterion.And (a1, a2) ->
let a1 = simplify a1
let a2 = simplify a2
match a1, a2 with
| AcceptanceCriterion.True, _ -> a2
| AcceptanceCriterion.False, _ -> AcceptanceCriterion.False
| _, AcceptanceCriterion.True -> a1
| _, AcceptanceCriterion.False -> AcceptanceCriterion.False
| _, _ -> AcceptanceCriterion.And (a1, a2)
| AcceptanceCriterion.Or (a1, a2) ->
let a1 = simplify a1
let a2 = simplify a2
match a1, a2 with
| AcceptanceCriterion.True, _ -> AcceptanceCriterion.True
| AcceptanceCriterion.False, _ -> a2
| _, AcceptanceCriterion.True -> AcceptanceCriterion.True
| _, AcceptanceCriterion.False -> a1
| _, _ -> AcceptanceCriterion.Or (a1, a2)
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 acAnd a b = AcceptanceCriterion.And (a, b)
let inline acOr a b = AcceptanceCriterion.Or (a, b)
type Accepted =
{
X : IntervalSet
M : IntervalSet
A : IntervalSet
S : IntervalSet
}
static member None =
{
X = IntervalSet.empty
M = IntervalSet.empty
A = IntervalSet.empty
S = IntervalSet.empty
}
static member All =
let i = IntervalSet.empty |> IntervalSet.add 1 4000
{
X = i
M = i
A = i
S = i
}
static member Union (a1 : Accepted) (a2 : Accepted) =
{
X = IntervalSet.union a1.X a2.X
M = IntervalSet.union a1.M a2.M
A = IntervalSet.union a1.A a2.A
S = IntervalSet.union a1.S a2.S
}
static member Intersection (a1 : Accepted) (a2 : Accepted) =
{
X = IntervalSet.intersection a1.X a2.X
M = IntervalSet.intersection a1.M a2.M
A = IntervalSet.intersection a1.A a2.A
S = IntervalSet.intersection a1.S a2.S
}
[<RequireQualifiedAccess>]
type AcceptedAlg =
| Accepted of Accepted
| Or of AcceptedAlg * AcceptedAlg
| And of AcceptedAlg * AcceptedAlg
let aaAnd (a1 : AcceptedAlg) (a2 : AcceptedAlg) =
match a1, a2 with
| AcceptedAlg.Accepted a1, AcceptedAlg.Accepted a2 ->
AcceptedAlg.Accepted (Accepted.Intersection a1 a2)
| _, _ -> AcceptedAlg.And (a1, a2)
let rec resolve (ac : AcceptanceCriterion) : AcceptedAlg =
match ac with
| AcceptanceCriterion.True -> AcceptedAlg.Accepted Accepted.All
| AcceptanceCriterion.False -> AcceptedAlg.Accepted Accepted.None
| Base(comp, low, high) ->
match comp with
| Component.X -> AcceptedAlg.Accepted { Accepted.All with X = IntervalSet.empty |> IntervalSet.add low high }
| Component.M -> AcceptedAlg.Accepted { Accepted.All with M = IntervalSet.empty |> IntervalSet.add low high }
| Component.A -> AcceptedAlg.Accepted { Accepted.All with A = IntervalSet.empty |> IntervalSet.add low high }
| Component.S -> AcceptedAlg.Accepted { Accepted.All with S = IntervalSet.empty |> IntervalSet.add low high }
| _ -> failwith "bad"
| And(ac1, ac2) ->
let ac1 = resolve ac1
let ac2 = resolve ac2
aaAnd ac1 ac2
| Or(ac1, ac2) ->
let ac1 = resolve ac1
let ac2 = resolve ac2
AcceptedAlg.Or (ac1, ac2)
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
@@ -283,7 +201,6 @@ module Day19 =
AcceptanceCriterion.Base (rule.Component, rule.Operand + 1, 4000)
acAnd negCond crit
)
|> AcceptanceCriterion.simplify
store.[key] <- result
result
@@ -297,9 +214,5 @@ module Day19 =
printfn "%+A" a
let resolved = resolve a
printfn "%+A" resolved
//uint64 (IntervalSet.count resolved.X) * uint64 (IntervalSet.count resolved.M) * uint64 (IntervalSet.count resolved.A) * uint64 (IntervalSet.count resolved.S)
0uL