Day 20 Part 2

Kodfodrasz.AoC.Year2024.Tests/Day20Tests.fs

@@ -61,11 +61,14 @@ let ``Answer 1 for example input`` () =
   test
     <@ answer1_params 20 input = Ok 5 @>
 
-[<Fact(Skip="TODO")>]
+[<Fact>]
 let ``Answer 2 for example input`` () =
-  let input = parseInput exampleInput
+  let input = 
+    parseInput exampleInput 
+    // TODO: Result.get
+    |> Result.defaultWith (fun _ -> failwith "shouldn't happen")
 
   test
-    <@ let actual = Result.bind answer2 input
-       let expected: Result<int, string> = Ok 31
-       actual = expected @>
+    <@ answer2_params 20 50 input = Ok 285 @>
+  test
+    <@ answer2_params 20 76 input = Ok 3 @>

Kodfodrasz.AoC.Year2024/Day20.fs

@@ -3,6 +3,8 @@ module Kodfodrasz.AoC.Year2024.Day20
 open System
 open System.Text.RegularExpressions
 open Kodfodrasz.AoC
+open MathNet.Numerics
+open MathNet.Numerics.LinearAlgebra
 
 type parsedInput = char array array
 
@@ -47,8 +49,6 @@ let cheats i j (arr : char array array) =
       yield i, j-2
   }
 
-
-
 let answer1_params limit (data : parsedInput) =
   let start = data |> tryFindIndex ((=)'S') |> Option.get
   let finish = data |> tryFindIndex ((=)'E') |> Option.get
@@ -102,8 +102,67 @@ let answer1_params limit (data : parsedInput) =
 
 let answer1 = answer1_params 100
 
-let answer2 (data : parsedInput) =
-  failwith "TODO"
+let answer2_params radius threshold (data : parsedInput) =
+  let start = data |> tryFindIndex ((=)'S') |> Option.get
+  let finish = data |> tryFindIndex ((=)'E') |> Option.get
+
+  let rec walk path (i,j) =
+    let c = data[i][j]
+    match c with
+    | 'E' -> (i,j) :: path |> List.rev |> List.toArray
+    | '.' | 'S' -> 
+      let next = 
+        data 
+        |> steps i j 
+        |> Seq.where (fun (ii,jj) -> 
+            let s = data[ii][jj]
+            s = 'S' || s = '.' || s = 'E')
+        |> Seq.except (Seq.truncate 1 path) 
+        |> Seq.exactlyOne
+      walk ((i,j) :: path) next
+    | _ -> failwith "Invalid position, should never happen"
+
+  let path = walk [] start
+
+  assert (finish = (Array.last path))
+
+  let distances = 
+    path
+    |> Array.mapi (fun idx (row, col) -> (row, col), (Array.length path - idx - 1))
+    |> Map.ofArray
+
+  let cheat_savings =
+    distances.Keys
+    |> Seq.collect (fun (i, j) ->
+        distances
+        |> Map.filter (fun (k, l) v -> 
+          let md = int <| Distance.Manhattan (
+            vector [double i; double j],
+            vector [double k; double l])
+          md <= radius
+        )
+        |> Map.map (fun (k, l) d -> 
+          let md = int <| Distance.Manhattan (
+            vector [double i; double j],
+            vector [double k; double l])
+          let f = distances |> Map.find (i, j)
+          let t = distances |> Map.find (k, l)
+          let saved = f - t - md
+          saved
+        )
+        |> Map.values
+    )
+    |> Seq.groupBy id
+    |> Map.ofSeq
+    |> Map.map (fun _ s -> s |> Seq.length)
+
+  cheat_savings
+  |> Map.filter (fun k v -> k >= threshold)
+  |> Map.values
+  |> Seq.sum
+  |> Ok
+
+let answer2 = answer2_params 20 100
 
 type Solver() =
   inherit SolverBase("Race Condition")

Kodfodrasz.AoC/Kodfodrasz.AoC.fsproj

@@ -18,6 +18,7 @@
   </ItemGroup>
 
   <ItemGroup>
+    <PackageReference Include="MathNet.Numerics.FSharp" Version="5.0.0" />
     <PackageReference Include="Microsoft.Extensions.Caching.Memory" Version="9.0.0" />
   </ItemGroup>