day 21 reflections

Author: mstksg

2024/AOC2024/Day21.hs

@@ -95,16 +95,8 @@ buttonGraph = (G.mkGraph (swap <$> M.toList nodes) edges, startMap, endMap)
       M.fromList . flip zip [0 ..] $
         (Left <$> liftA3 (,,) allPushable' allPushable' allPushable')
           ++ (Right <$> allPushable')
-    startMap =
-      M.fromList
-        [ (n, i)
-        | (Left (n, Nothing, Nothing), i) <- M.toList nodes
-        ]
-    endMap =
-      M.fromList
-        [ (n, i)
-        | (Right n, i) <- M.toList nodes
-        ]
+    startMap = M.fromList [(n, i) | (Left (n, Nothing, Nothing), i) <- M.toList nodes]
+    endMap = M.fromList [(n, i) | (Right n, i) <- M.toList nodes]
     edges :: [(Int, Int, DirPad)]
     edges = do
       (Left (b, d, e), node) <- M.toList nodes
@@ -156,8 +148,8 @@ runPath x = \case
 dirPathChain :: Int -> Map DirPad (Map DirPad Int)
 dirPathChain n = iterate (`composeDirPathLengths` dirPath @Dir) (dirPathCosts @Dir) !!! n
 
-solveCodeNoSearch :: Int -> [NumPad] -> Int
-solveCodeNoSearch n = spellDirPathLengths mp . (Nothing :)
+solveCode :: Int -> [NumPad] -> Int
+solveCode n = spellDirPathLengths mp . (Nothing :)
   where
     mp = dirPathChain (n - 1) `composeDirPathLengths` dirPath @(Finite 10)
 
@@ -174,7 +166,7 @@ day21 n =
           sum . map solve
     }
   where
-    solve p = num * solveCodeNoSearch n p
+    solve p = num * solveCode n p
       where
         num = read (map intToDigit (mapMaybe (fmap fromIntegral) p :: [Int]))
 

bench-results/2024/day21.txt

@@ -1,19 +1,19 @@
 >> Day 21a
 benchmarking...
-time                 3.965 μs   (3.959 μs .. 3.970 μs)
-                     1.000 R²   (1.000 R² .. 1.000 R²)
-mean                 3.967 μs   (3.961 μs .. 3.973 μs)
-std dev              17.27 ns   (14.75 ns .. 20.43 ns)
+time                 3.840 μs   (3.834 μs .. 3.851 μs)
+                     1.000 R²   (0.999 R² .. 1.000 R²)
+mean                 3.883 μs   (3.848 μs .. 4.052 μs)
+std dev              222.9 ns   (19.15 ns .. 512.1 ns)
+variance introduced by outliers: 69% (severely inflated)
 
 * parsing and formatting times excluded
 
 >> Day 21b
 benchmarking...
-time                 3.971 μs   (3.958 μs .. 3.988 μs)
-                     0.999 R²   (0.996 R² .. 1.000 R²)
-mean                 4.020 μs   (3.971 μs .. 4.206 μs)
-std dev              304.7 ns   (22.58 ns .. 645.9 ns)
-variance introduced by outliers: 80% (severely inflated)
+time                 3.839 μs   (3.831 μs .. 3.849 μs)
+                     1.000 R²   (1.000 R² .. 1.000 R²)
+mean                 3.841 μs   (3.835 μs .. 3.845 μs)
+std dev              16.92 ns   (13.66 ns .. 20.87 ns)
 
 * parsing and formatting times excluded
 

reflections/2024/day21.md

@@ -0,0 +1,51 @@
+Everything reveals itself if we imagine a lookup table of "best path from A to
+B".  For my own purposes I've made the functions parameterized by button pad,
+using `Maybe a`, where `Nothing` is the `A` key and `Just x` is the `x` key.
+
+```haskell
+type LookupTable a b = Map (Maybe a) (Map (Maybe a) [Maybe b])
+
+type LookupTableLengths a = Map (Maybe a) (Map (Maybe a) Int)
+
+toLengths :: LookupTable a b -> LookupTableLengths a
+toLengths = fmap (fmap length)
+```
+
+The key is that now these maps are composable:
+
+```haskell
+spellDirPathLengths :: Ord a => LookupTableLengths a -> [Maybe a] -> Int
+spellDirPathLengths mp xs = sum $ zipWith (\x y -> (mp M.! x) M.! y) xs (drop 1 xs)
+
+composeDirPathLengths :: Ord b => LookupTableLengths b -> LookupTable a b -> LookupTableLengths a
+composeDirPathLengths mp = (fmap . fmap) (spellDirPathLengths mp . (Nothing :))
+```
+
+That is, if you have the lookup table for two layers, you can compose them to
+create one big lookup table.
+
+```haskell
+data Dir = North | East | West | South
+data NumButton = Finite 10
+
+dirPathChain :: [LookupTableLengths NumButton]
+dirPathChain = iterate (`composeDirPathLengths` dirPath @Dir) (dirPathCosts @Dir)
+
+solveCode :: Int -> [Maybe NumButton] -> Int
+solveCode n = spellDirPathLengths mp . (Nothing :)
+  where
+    lengthChain = dirPathChain !! (n - 1)
+    mp = lengthChain `composeDirPathLengths` dirPath @NumButton
+````
+
+The nice thing is that you only need to compute `dirPathChain` once, to get the
+final `LookupTableLengths` for a given `n`, and you can re-use it for
+everything.
+
+Generating the actual `LookupTable NumButton Dir` and `LookupTable Dir Dir` is
+the tricky part. For me I generated it based on the shortest path considering
+the third bot up the chain from the bottom: I used an *fgl* graph where the
+nodes were the state of three bots and the edges were the actions that the
+fourth "controller" would take, and computed the shortest path in terms of the
+fourth controller.  This seems to be the magic number: anything higher and you
+get the same answer, anything lower and you get suboptimal final paths.