Done day 21

diff --git a/advent21/Main.hs b/advent21/Main.hs
index 40c429cd49816270a820d623f36e844e85da5941..de641720451546b29a6a347f7b8429034ce51bea 100644 (file)
--- a/advent21/Main.hs
+++ b/advent21/Main.hs
@@ -5,16 +5,20 @@ import AoC
 import Data.Char
 import Linear (V2(..), (^+^), (^-^))
 -- import qualified Data.Set as S
--- import qualified Data.Map.Strict as M
+import qualified Data.Map.Strict as M
 -- import Data.Maybe
 import Data.List
-import Control.Monad
+-- import Control.Monad
 
 type Position = V2 Int -- r, c
 
-data Action = R | U | D | L | A deriving (Eq, Ord, Show)
+data Action = R | U | D | L | A deriving (Eq, Ord, Show, Enum, Bounded)
 type ActionSeq = [Action]
 
+data CacheKey = CacheKey { moveFrom :: Action, moveTo :: Action, layer :: Int } 
+  deriving (Eq, Ord, Show)
+type Cache = M.Map CacheKey Int
+
 class Button a where
   buttonPos :: a -> Position
   aButton :: a
@@ -54,21 +58,39 @@ main =
   do  dataFileName <- getDataFileName
       text <- readFile dataFileName
       let codes = lines text
-      print codes
+      -- print codes
       -- print $ fmap showMoves $ moves $ head codes
       -- print $ fmap showMoves $ concatMap moves $ moves $ head codes
       -- print $ fmap showMoves $ concatMap moves $ concatMap moves $ moves $ head codes
       -- print $ showMoves $ head $ sortOn length $ concatMap moves $ concatMap moves $ moves $ head codes
       print $ part1 codes
+      -- print cache1
+      -- let cache2 = extendCache cache1 2
+      let cache = buildCache 25
+      -- print $ moves "029A"
+      -- print $ fmap (sequenceCostUsingCache cache1 1) $ moves "029A"
+      -- print $ minimum $ fmap (sequenceCostUsingCache cache 2) $ moves "029A"
+      print $ part2 cache codes
 
 part1 :: [String] -> Int
 part1 codes = sum $ fmap complexity codes
 
--- complexity :: String -> (Int, Int)
+part2 :: Cache -> [String] -> Int
+part2 cache codes = sum $ fmap (complexity2 cache) codes
+
+complexity :: String -> Int
 complexity code = (length ms) * ns
   where ms = head $ sortOn length $ concatMap moves $ concatMap moves $ moves code
         ns = read $ filter isDigit code
 
+complexity2 :: Cache -> String -> Int
+complexity2 cache code = ms * ns
+  where ms = minimum $ fmap (sequenceCostUsingCache cache 25) $ moves code
+        ns = read $ filter isDigit code
+
+moves :: Button a => [a] -> [ActionSeq]
+moves bs = fmap concat $ sequence $ fmap moveBetween $ zip (aButton : bs) bs
+
 moveBetween :: Button a => (a, a) -> [ActionSeq]
 moveBetween (a, b) = filter (allLegal a) $ filter groupTogether possibles
   where aPos = buttonPos a
@@ -78,12 +100,35 @@ moveBetween (a, b) = filter (allLegal a) $ filter groupTogether possibles
         mv = replicate (abs dr) (if dr > 0 then D else U)
         possibles = fmap (++ [A]) $ nub $ permutations $ mh ++ mv
         groupTogether p = sort (group p) == group (sort p)
-
-allLegal :: Button a => a -> ActionSeq -> Bool
-allLegal a t = all (legalPos a) (positionsOf a t)
-
-moves :: Button a => [a] -> [ActionSeq]
-moves bs = fmap concat $ sequence $ fmap moveBetween $ zip (aButton : bs) bs
+        allLegal a t = all (legalPos a) (positionsOf a t)
+
+sequenceCostUsingCache :: Cache -> Int -> ActionSeq -> Int
+sequenceCostUsingCache cache level bs = 
+  sum $ fmap (moveCostUsingCache cache level) $ zip (aButton : bs) bs
+
+moveCostUsingCache :: Cache -> Int -> (Action, Action) -> Int
+moveCostUsingCache cache level (a, b) = 
+  M.findWithDefault (maxBound :: Int) (CacheKey a b level) cache
+
+cheapestCostMove :: Button a => Cache -> Int -> (a, a) -> Int
+cheapestCostMove cache level (a, b) = minimum $ fmap (sequenceCostUsingCache cache level) stepChoices
+  where stepChoices = moveBetween (a, b)
+
+buildCache :: Int -> Cache
+buildCache maxLevel = foldl' extendCache cache1 [2..maxLevel]
+
+extendCache :: Cache -> Int -> Cache
+extendCache cache level = foldl' go cache allPairs
+  where
+    allPairs = [(a, b) | a <- [R .. A], b <- [R .. A]]
+    go c (a, b) = M.insert (CacheKey a b level) (cheapestCostMove c (level - 1) (a, b)) c
+
+cache1 :: Cache
+cache1 = M.fromList $ fmap go allPairs
+  where allPairs = [(a, b) | a <- [R .. A], b <- [R .. A]]
+        go (a, b) = (CacheKey a b 1, 1 + mdist a b)
+        mdist p q = let V2 dr dc = (buttonPos q) ^-^ (buttonPos p) 
+                    in abs dr + abs dc
 
 delta :: Action -> Position
 delta U = V2 (-1) 0

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index fc84f17dc18d34cc8703a1515e786f96440d4ed4..57ca291fb7ac04fe3488aa050a3fe060c43b8297 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -203,4 +203,4 @@ executable advent20
 executable advent21
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent21/Main.hs
-  build-depends: linear
+  build-depends: linear, containers