2023 day 19 in F#

Real: 00:00:00.079, CPU: 00:00:00.080, GC gen0: 0, gen1: 0, gen2: 0

2023/data/19/example

@@ -0,0 +1,17 @@
+px{a<2006:qkq,m>2090:A,rfg}
+pv{a>1716:R,A}
+lnx{m>1548:A,A}
+rfg{s<537:gd,x>2440:R,A}
+qs{s>3448:A,lnx}
+qkq{x<1416:A,crn}
+crn{x>2662:A,R}
+in{s<1351:px,qqz}
+qqz{s>2770:qs,m<1801:hdj,R}
+gd{a>3333:R,R}
+hdj{m>838:A,pv}
+
+{x=787,m=2655,a=1222,s=2876}
+{x=1679,m=44,a=2067,s=496}
+{x=2036,m=264,a=79,s=2244}
+{x=2461,m=1339,a=466,s=291}
+{x=2127,m=1623,a=2188,s=1013}

2023/fsharp/day19.fsx

@@ -0,0 +1,194 @@
+#time
+
+open System
+open System.Text.RegularExpressions
+
+let (|Regex|_|) pattern input =
+    let m = Regex.Match(input, pattern)
+
+    if m.Success then
+        Some(List.tail [ for g in m.Groups -> g.Value ])
+    else
+        None
+
+type Part = { x: int; m: int; a: int; s: int }
+
+let parsePart line =
+    match line with
+    | Regex @"\{x=(\d+),m=(\d+),a=(\d+),s=(\d+)\}" values ->
+        match List.map int values with
+        | x :: m :: a :: s :: [] -> { x = x; m = m; a = a; s = s }
+        | _ -> failwith "unreachable"
+    | _ -> failwith "Unreachable"
+
+type Category =
+    | X
+    | M
+    | A
+    | S
+
+let parseCategory =
+    function
+    | "x" -> X
+    | "m" -> M
+    | "a" -> A
+    | "s" -> S
+    | _ -> failwith "Unreachable"
+
+type Resolution =
+    | Accepted
+    | Rejected
+
+type Destination =
+    | Ruleset of string
+    | Final of Resolution
+
+let parseDestination =
+    function
+    | "A" -> Final Accepted
+    | "R" -> Final Rejected
+    | x -> Ruleset x
+
+type ConditionOp =
+    | GT
+    | LT
+
+let parseOp =
+    function
+    | "<" -> LT
+    | ">" -> GT
+    | _ -> failwith "Unreachable"
+
+type Conditional = Category * ConditionOp * int
+
+type Rule =
+    | Jump of Destination
+    | ConditionalJump of Conditional * Destination
+
+let parseRule rule =
+    match rule with
+    | Regex @"([a-z]+)([<>])(\d+):([a-zAR]+)" (src :: op :: n :: dst :: []) ->
+        let cond = (parseCategory src, parseOp op, int n)
+        ConditionalJump(cond, parseDestination dst)
+    | Regex @"^([a-zAR]+)$" (dst :: []) -> Jump(parseDestination dst)
+    | _ -> failwith "Unreachable"
+
+let parseInput lines =
+    let parseWorkflow acc cur =
+        match cur with
+        | Regex @"([a-z]+)\{([^}]+)\}" (name :: body :: []) ->
+            let rules = body.Split [| ',' |] |> Seq.map parseRule |> List.ofSeq
+            Map.add name rules acc
+        | _ -> failwith "Unreachable"
+
+    let mid = Seq.findIndex (fun l -> l = "") lines
+    let workflows, parts = List.splitAt mid lines
+
+    let parts = parts |> Seq.skip 1 |> Seq.map parsePart
+
+    let workflows = workflows |> Seq.fold parseWorkflow Map.empty
+    (workflows, parts)
+
+let opF =
+    function
+    | GT -> (>)
+    | LT -> (<)
+
+let partRating (part: Part) = part.x + part.m + part.a + part.s
+
+type Range = (int * int)
+
+type Ranges =
+    { x: Range
+      m: Range
+      a: Range
+      s: Range }
+
+let withinRange x (s, e) = x >= s && x <= e
+
+let withinRanges (part: Part) (ranges: Ranges) =
+    withinRange part.x ranges.x
+    && withinRange part.m ranges.m
+    && withinRange part.a ranges.a
+    && withinRange part.s ranges.s
+
+let tightenCondition (s, e) op n =
+    match op with
+    | LT when e > n -> (s, n - 1)
+    | GT when s < n -> (n + 1, e)
+    | _ -> (s, e)
+
+let tightenConditions (conditions: Ranges) (condition: Conditional) : Ranges =
+    match condition with
+    | (X, op, n) ->
+        { conditions with
+            x = tightenCondition conditions.x op n }
+    | (M, op, n) ->
+        { conditions with
+            m = tightenCondition conditions.m op n }
+    | (A, op, n) ->
+        { conditions with
+            a = tightenCondition conditions.a op n }
+    | (S, op, n) ->
+        { conditions with
+            s = tightenCondition conditions.s op n }
+
+let tightenComplementaryConditions conditions cond =
+    match cond with
+    | ((attr, op, n)) when op = LT -> (attr, GT, n - 1)
+    | ((attr, op, n)) -> (attr, LT, n + 1)
+    |> tightenConditions conditions
+
+let sumRange (s, e) = uint64 (e - s + 1)
+
+let sumRanges (range: Ranges) =
+    [ range.x; range.m; range.a; range.s ]
+    |> Seq.fold (fun acc r -> acc * sumRange r) 1UL
+
+let aggregateConditions ruleset =
+    let defaultLimit = (1, 4000)
+
+    let defaultScope: Ranges =
+        { x = defaultLimit
+          m = defaultLimit
+          a = defaultLimit
+          s = defaultLimit }
+
+    let rec walk' acc conditions instructions =
+        match instructions with
+        | [] -> acc
+        | (Jump(Final Accepted)) :: xs -> Set.add conditions acc
+        | (Jump(Final Rejected)) :: xs -> acc
+        | (Jump(Ruleset dst)) :: xs -> Map.find dst ruleset |> walk' acc conditions
+        | (ConditionalJump(cond, Final Accepted)) :: xs ->
+            let branch = tightenConditions conditions cond
+            let complementary = tightenComplementaryConditions conditions cond
+            walk' (Set.add branch acc) complementary xs
+        | (ConditionalJump(cond, Final Rejected)) :: xs ->
+            let complementary = tightenComplementaryConditions conditions cond
+            walk' acc complementary xs
+        | (ConditionalJump(cond, Ruleset dst)) :: xs ->
+            let otherConditions = tightenConditions conditions cond
+            let branch = Map.find dst ruleset |> walk' acc otherConditions
+            let complementary = tightenComplementaryConditions conditions cond
+            walk' (Set.union acc branch) complementary xs
+
+    ruleset |> Map.find "in" |> walk' Set.empty defaultScope
+
+let part1 workflows parts =
+    parts
+    |> Seq.filter (fun p -> Seq.exists (withinRanges p) workflows)
+    |> Seq.sumBy partRating
+
+let part2 input =
+    input |> Set.toSeq |> Seq.sumBy sumRanges
+
+let main f =
+    let (workflows, parts) = f |> IO.File.ReadLines |> Seq.toList |> parseInput
+    let aggregatedWorkflows = aggregateConditions workflows
+
+    printfn "Part 1: %d" (part1 aggregatedWorkflows parts)
+    printfn "Part 2: %d" (part2 aggregatedWorkflows)
+    0
+
+main fsi.CommandLineArgs.[1]