From 8519bdfe05204da5ae84dcb56d2eb46fc94ab5c1 Mon Sep 17 00:00:00 2001 From: Smaug123 Date: Sat, 23 Dec 2023 12:52:25 +0000 Subject: [PATCH] wip --- .gitignore | 1 + .../AdventOfCode2023.FSharp.Lib.fsproj | 2 + .../AdventOfCode2023.FSharp.Lib/Day19.fs | 305 ++++++++++++++++++ .../IntervalSet.fs | 80 +++++ .../AdventOfCode2023.FSharp/Program.fs | 16 + AdventOfCode2023.FSharp/Test/Test.fsproj | 10 +- AdventOfCode2023.FSharp/Test/TestDay19.fs | 44 +++ .../Test/TestIntervalSet.fs | 70 ++++ .../Test/samples/day19.txt | 17 + mathematica/day_21.m | 30 ++ 10 files changed, 574 insertions(+), 1 deletion(-) create mode 100644 AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day19.fs create mode 100644 AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/IntervalSet.fs create mode 100644 AdventOfCode2023.FSharp/Test/TestDay19.fs create mode 100644 AdventOfCode2023.FSharp/Test/TestIntervalSet.fs create mode 100644 AdventOfCode2023.FSharp/Test/samples/day19.txt create mode 100644 mathematica/day_21.m diff --git a/.gitignore b/.gitignore index 104abff..a1cae0b 100644 --- a/.gitignore +++ b/.gitignore @@ -10,3 +10,4 @@ result .profile* inputs/ +AdventOfCode2023.FSharp/Test/TestResults/ diff --git a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/AdventOfCode2023.FSharp.Lib.fsproj b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/AdventOfCode2023.FSharp.Lib.fsproj index 4cd3651..2e2f842 100644 --- a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/AdventOfCode2023.FSharp.Lib.fsproj +++ b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/AdventOfCode2023.FSharp.Lib.fsproj @@ -12,6 +12,7 @@ + @@ -28,6 +29,7 @@ + diff --git a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day19.fs b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day19.fs new file mode 100644 index 0000000..ab992c6 --- /dev/null +++ b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/Day19.fs @@ -0,0 +1,305 @@ +namespace AdventOfCode2023 + +open System +open System.Collections.Generic +open System.Globalization + +[] +module Day19 = + + type Component = + | X = 0 + | M = 1 + | A = 2 + | S = 3 + + [] + 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 = + 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) 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) = + let workflows = Dictionary () + 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 + + [] + 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 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 + } + + [] + 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 rec acceptance (store : Dictionary) (workflows : Dictionary * 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 + ) + |> AcceptanceCriterion.simplify + store.[key] <- result + result + + let part2 (s : string) = + use mutable rows = StringSplitEnumerator.make '\n' s + let workflows = readWorkflows &rows + + let acceptanceRanges = Dictionary () + + let a = acceptance acceptanceRanges workflows "in" + + 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 diff --git a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/IntervalSet.fs b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/IntervalSet.fs new file mode 100644 index 0000000..060f2da --- /dev/null +++ b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp.Lib/IntervalSet.fs @@ -0,0 +1,80 @@ +namespace AdventOfCode2023 + +type IntervalSet = + private + | IntervalSet of (int * int) list + +[] +module IntervalSet = + let empty = IntervalSet [] + + let private add' (low : int) (high : int) intervals : _ list = + let rec go (low : int) (high : int) (intervals : (int * int) list) = + match intervals with + | [] -> [low, high] + | (lowExisting, highExisting) :: intervals -> + if low > highExisting then + (lowExisting, highExisting) :: go low high intervals + elif high < lowExisting then + (low, high) :: (lowExisting, highExisting) :: intervals + elif high = lowExisting then + (low, highExisting) :: intervals + elif high <= highExisting then + (min low lowExisting, highExisting) :: intervals + else + // low <= highExisting, highExisting < high + (min low lowExisting, highExisting) :: go (highExisting + 1) high intervals + + go low high intervals + + let add (low : int) (high : int) (IntervalSet intervals) : IntervalSet = + add' low high intervals + |> IntervalSet + + let contains (x : int) (IntervalSet intervals) : bool = + let rec go (intervals : (int * int) list) = + match intervals with + | [] -> false + | (low, high) :: intervals -> + if low > x then false + elif x <= high then true + else go intervals + + go intervals + + let private union' i1 i2 = + (i2, i1) + ||> List.fold (fun i (low, high) -> add' low high i) + + let union (IntervalSet i1) (IntervalSet i2) : IntervalSet = + union' i1 i2 + |> IntervalSet + + let private intersectionHelper (low : int) (high : int) (ints : (int * int) list) = + let rec go (low : int) (high : int) (ints : (int * int) list) = + match ints with + | [] -> [] + | (lowExisting, highExisting) :: ints -> + if low > highExisting then go low high ints + elif high < lowExisting then [] + elif high <= highExisting then + [max low lowExisting, high] + else + (max low lowExisting, highExisting) :: go (highExisting + 1) high ints + + go low high ints + + let private intersection' i1 i2 = + // a int (b U c) = (a int b) U (a int c) + ([], i1) + ||> List.fold (fun soFar (low, high) -> + union' soFar (intersectionHelper low high i2) + ) + + let intersection (IntervalSet i1) (IntervalSet i2) : IntervalSet = + intersection' i1 i2 + |> IntervalSet + + let count (IntervalSet i) = + i + |> List.sumBy (fun (low, high) -> high - low + 1) diff --git a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp/Program.fs b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp/Program.fs index 817d6cb..0324bff 100644 --- a/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp/Program.fs +++ b/AdventOfCode2023.FSharp/AdventOfCode2023.FSharp/Program.fs @@ -316,6 +316,22 @@ module Program = Console.WriteLine (part2.ToString ()) Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms") + Console.WriteLine "=====Day 19=====" + + do + let input = Path.Combine (dir.FullName, "day19.txt") |> File.ReadAllText + + sw.Restart () + let part1 = Day19.part1 input + sw.Stop () + Console.WriteLine (part1.ToString ()) + Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms") + sw.Restart () + let part2 = Day19.part2 input + sw.Stop () + Console.WriteLine (part2.ToString ()) + Console.Error.WriteLine ((1_000.0 * float sw.ElapsedTicks / float Stopwatch.Frequency).ToString () + "ms") + endToEnd.Stop () Console.Error.WriteLine ( diff --git a/AdventOfCode2023.FSharp/Test/Test.fsproj b/AdventOfCode2023.FSharp/Test/Test.fsproj index 4094e13..da895b2 100644 --- a/AdventOfCode2023.FSharp/Test/Test.fsproj +++ b/AdventOfCode2023.FSharp/Test/Test.fsproj @@ -5,10 +5,14 @@ false true + + False + False + @@ -25,6 +29,7 @@ + @@ -44,11 +49,14 @@ + + - + + diff --git a/AdventOfCode2023.FSharp/Test/TestDay19.fs b/AdventOfCode2023.FSharp/Test/TestDay19.fs new file mode 100644 index 0000000..2149218 --- /dev/null +++ b/AdventOfCode2023.FSharp/Test/TestDay19.fs @@ -0,0 +1,44 @@ +namespace AdventOfCode2023.Test + +open AdventOfCode2023 +open NUnit.Framework +open FsUnitTyped +open System.IO + +[] +module TestDay19 = + + [] + let sample = Assembly.getEmbeddedResource typeof.Assembly "day19.txt" + + [] + let part1Sample () = sample |> Day19.part1 |> shouldEqual 19114 + + [] + let part2Sample () = sample |> Day19.part2 |> shouldEqual 167409079868000uL + + [] + let part1Actual () = + let s = + try + File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day19.txt")) + with + | :? DirectoryNotFoundException + | :? FileNotFoundException -> + Assert.Inconclusive () + failwith "unreachable" + + Day19.part1 s |> shouldEqual 368964 + + [] + let part2Actual () = + let s = + try + File.ReadAllText (Path.Combine (__SOURCE_DIRECTORY__, "../../inputs/day19.txt")) + with + | :? DirectoryNotFoundException + | :? FileNotFoundException -> + Assert.Inconclusive () + failwith "unreachable" + + Day19.part2 s |> shouldEqual 8314uL diff --git a/AdventOfCode2023.FSharp/Test/TestIntervalSet.fs b/AdventOfCode2023.FSharp/Test/TestIntervalSet.fs new file mode 100644 index 0000000..abe311c --- /dev/null +++ b/AdventOfCode2023.FSharp/Test/TestIntervalSet.fs @@ -0,0 +1,70 @@ +namespace AdventOfCode2023.Test + +open System.Threading +open AdventOfCode2023 +open NUnit.Framework +open FsUnitTyped +open FsCheck + +[] +module TestIntervalSet = + + /// Normalises e.g. (5, 3) to (3, 5) too. + let toIntervalSet (model : (int * int) list) = + (IntervalSet.empty, model) + ||> List.fold (fun intervals (x1, x2) -> IntervalSet.add (min x1 x2) (max x1 x2) intervals) + + let modelContains (x : int) (model : (int * int) list) = + model + |> List.exists (fun (x1, x2) -> + let x1, x2 = min x1 x2, max x1 x2 + x1 <= x && x <= x2 + ) + + [] + let ``IntervalSet add works`` () = + let property (pos : int ref) (neg : int ref) (x : int) (xs : (int * int) list) = + let intervals = toIntervalSet xs + + let actual = IntervalSet.contains x intervals + let expected = modelContains x xs + + if actual then + Interlocked.Increment pos + |> ignore + else + Interlocked.Increment neg + |> ignore + + expected = actual + + let pos = ref 0 + let neg = ref 0 + Check.One ({Config.Default with MaxTest = 1000}, property pos neg) + printfn "Fraction of positive cases: %f" ((float pos.Value) / (float pos.Value + float neg.Value)) + + [] + let ``Intersection works`` () = + let property (pos : int ref) (neg : int ref) (trials : int list) (xsModel : (int * int) list) (ysModel : (int * int) list) = + let xs = toIntervalSet xsModel + let ys = toIntervalSet ysModel + + let intervals = IntervalSet.intersection xs ys + + for x in trials do + let actual = IntervalSet.contains x intervals + let expected = modelContains x xsModel && modelContains x ysModel + + expected |> shouldEqual actual + + if actual then + Interlocked.Increment pos + |> ignore + else + Interlocked.Increment neg + |> ignore + + let pos = ref 0 + let neg = ref 0 + Check.One ({Config.Default with MaxTest = 1000}, property pos neg) + printfn "Fraction of positive cases: %f" ((float pos.Value) / (float pos.Value + float neg.Value)) diff --git a/AdventOfCode2023.FSharp/Test/samples/day19.txt b/AdventOfCode2023.FSharp/Test/samples/day19.txt new file mode 100644 index 0000000..e5b5d64 --- /dev/null +++ b/AdventOfCode2023.FSharp/Test/samples/day19.txt @@ -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} diff --git a/mathematica/day_21.m b/mathematica/day_21.m new file mode 100644 index 0000000..ecd4cd6 --- /dev/null +++ b/mathematica/day_21.m @@ -0,0 +1,30 @@ +(* ::Package:: *) + +(* ::Input:: *) +(*s="...........*) +(*.....###.#.*) +(*.###.##..#.*) +(*..#.#...#..*) +(*....#.#....*) +(*.##..S####.*) +(*.##..#...#.*) +(*.......##..*) +(*.##.#.####.*) +(*.##..##.##.*) +(*...........";*) + + +(* ::Input:: *) +(*reachable[grid_,{row_Integer,col_Integer}]:=reachable[grid,{row,col}]=Select[{{row+1,col},{row-1,col},{row,col+1},{row,col-1}},*) +(*1<=#[[1]]<=Length[grid]&&1<=#[[2]]<=Length[First@grid]&&grid[[#[[1]],#[[2]]]]!="#"&*) +(*]*) + + +(* ::Input:: *) +(*f[grid_,pos_,0]:={pos}*) +(*f[grid_,pos_,timestepsRemaining_Integer]:=*) +(*f[grid,pos,timestepsRemaining]=DeleteDuplicates@Flatten[f[grid,#,timestepsRemaining-1]&/@reachable[grid,pos],1]*) + + +(* ::Input:: *) +(*With[{grid=Characters/@StringSplit[s,"\n"]},f[grid,FirstPosition[grid,"S"],64]//Length]*)