Day 11 Part 2

Kodfodrasz.AoC.Year2024.Tests/Day11Tests.fs

@@ -27,38 +27,78 @@ let ``Answer 1 for example input`` () =
   test
     <@ answer1 [125L; 17L] = Ok 55312 @>
 
-[<Fact(Skip="TODO")>]
+[<Fact(Skip = "No expected value in problem")>]
 let ``Answer 2 for example input`` () =
-  let input = parseInput exampleInput
-
   test
-    <@ let actual = Result.bind answer2 input
-       let expected: Result<int, string> = Ok -99999 // TODO
-       actual = expected @>
+    <@ answer2 [125L; 17L] = Ok 55312 @>
 
 [<Fact>]
 let ``Answer 1 helper test`` () =
   test
     <@ 
-      pluto 0L = [ 1L ]
+      pluto 0L = [| 1L |]
     @>
   test
     <@ 
-      pluto 1L = [ 2024L ]
+      pluto 1L = [| 2024L |]
     @>
   test
     <@ 
-      pluto 2024L = [ 20L; 24L ]
+      pluto 2024L = [| 20L; 24L |]
     @>
   test
     <@ 
-      pluto 1000L = [ 10L; 0L ]
+      pluto 1000L = [| 10L; 0L |]
     @>
   test
     <@ 
-      pluto 99 = [ 9L; 9L ]
+      pluto 99 = [| 9L; 9L |]
     @>
   test
     <@ 
-      pluto 999 = [ 2021976L ]
+      pluto 999 = [| 2021976L |]
     @>
+
+[<Fact>]
+let ``Answer 2 helper test for example input`` () =
+  test
+    <@ answer2_raw 1 1 [125L; 17L] = Ok 3 @>
+  test
+    <@ answer2_raw 1 2 [125L; 17L] = Ok 4 @>
+  test
+    <@ answer2_raw 2 3 [125L; 17L] = Ok 5 @>
+  test
+    <@ answer2_raw 2 6 [125L; 17L] = Ok 22 @>
+  test
+    <@ answer2_raw 3 6 [125L; 17L] = Ok 22 @>
+  test
+    <@ answer2_raw 4 6 [125L; 17L] = Ok 22 @>
+  test
+    <@ answer2_raw 5 6 [125L; 17L] = Ok 22 @>
+  test
+    <@ answer2_raw 3 25 [125L; 17L] = Ok 55312 @>
+  test
+    <@ answer2_raw 5 25 [125L; 17L] = Ok 55312 @>
+  test
+    <@ answer2_raw 7 25 [125L; 17L] = Ok 55312 @>
+  test
+    <@ answer2_raw 10 25 [125L; 17L] = Ok 55312 @>
+  test
+    <@ answer2_raw 25 25 [125L; 17L] = Ok 55312 @>
+
+[<Fact>]
+let ``Answer 2 helper test for example input 2`` () =
+  test
+    <@ answer2_raw 1 1 [0L; ] = Ok 1 @>
+  test
+    <@ answer2_raw 1 1 [1L; ] = Ok 1 @>
+  test
+    <@ answer2_raw 1 1 [17L; ] = Ok 2 @>
+  test
+    <@ answer2_raw 1 1 [177L; ] = Ok 1 @>
+  test
+    <@ answer2_raw 1 1 [111000L; ] = Ok 2 @>
+  test
+    <@ answer2_raw 1 3 [11111111L; ] = Ok 8 @>
+  test
+    <@ answer2_raw 1 3 [10010000L; ] = Ok 4 @>

Kodfodrasz.AoC.Year2024/Day11.fs

@@ -16,26 +16,94 @@ let parseInput (input: string): Result<parsedinput, string> =
 let pluto (n:int64) =
   let str = sprintf "%i" n
   match n with
-  | 0L -> [ 1L ]
+  | 0L -> [| 1L |]
   | n when str.Length % 2 = 0 -> 
     let halflen= str.Length / 2
     let left = str.Substring(0,halflen) |> int64
     let right = str.Substring(halflen)|> int64
-    [ left; right ]
-  | _ -> [ n * 2024L ]
+    [| left; right |]
+  | _ -> [| n * 2024L |]
 
 
-let answer1 (input : parsedinput) : Result<int,string> =
+let answer1 (input : parsedinput) : Result<int64,string> =
   // clone for mutation
-  let mutable mutato = input
+  let mutable mutato = input |> List.toArray
   for i in 1..25 do
-    mutato <- List.collect pluto mutato
+    mutato <- Array.collect pluto mutato
 
-  List.length mutato
+  Array.length mutato
+  |> int64
   |> Ok
 
-let answer2 (input : parsedinput) : Result<int,string>  =
-  failwith "TODO"
+
+let prepareLUT depth =
+  let empty = Array.empty<int64>
+  // depth 0 : the numbers themselves. small waste, easier indexing 
+  let lut = Array2D.create 10 (depth+1) empty 
+
+  for num in 0..9 do
+    let mutable nash = [| int64 num |]
+    lut[num, 0] <- nash
+    for depth in 1..depth do
+      nash <- Array.collect pluto nash // Not that terrible film actually
+      lut[num, depth] <- nash
+
+  lut
+
+let rec dive (lut : int64 array array2d) depth num =
+  if depth = 0 then
+    1L
+  else 
+    let str = sprintf "%i" num
+    match str.Length with
+    | 1 -> 
+        let max_step = (Array2D.length2 lut) - 1
+        if depth <= max_step then
+          // we can directly answer
+          Array.length lut[int num, depth] |> int64
+        else
+          let leap = lut[int num, max_step]
+          let remaining_depth = depth - max_step
+          // (numbers, count) list
+          let groups = 
+            Array.groupBy id leap 
+            |> Array.map (fun (num, arr) -> num, Array.length arr)
+            |> Map.ofArray
+
+          groups
+          |> Map.map (fun num count -> (int64 count) * (dive lut remaining_depth num))
+          |> Map.values 
+          |> Seq.sum
+    | n when str.Length % 2 = 0 -> 
+        let halflen= str.Length / 2
+        let left = str.Substring(0,halflen) |> int64
+        let right = str.Substring(halflen)|> int64
+        let leap = [| left; right |]
+        let groups = 
+          Array.groupBy id leap 
+          |> Array.map (fun (num, arr) -> num, Array.length arr)
+          |> Map.ofArray
+        groups
+        |> Map.map (fun num count -> (int64 count) * (dive lut (depth - 1) num))
+        |> Map.values 
+        |> Seq.sum
+    | _ -> 
+        dive lut (depth - 1) (num * 2024L)
+
+let answer2_raw lutDepth calcDepth (input : parsedinput) : Result<int64,string> =
+  let lut = prepareLUT lutDepth
+
+  input 
+  |> Array.ofList
+  |> Array.Parallel.map (dive lut calcDepth)
+  |> Seq.sum
+  |> Ok
+
+let answer2 =
+  // bad: 862423061625454 TOO HIGH
+  // Good:241651071960597
+  answer2_raw 25 75
+
 
 type Solver() =
   inherit SolverBase("Plutonian Pebbles")