Done day 21 part 1

diff --git a/advent21/Main.hs b/advent21/Main.hs
new file mode 100644 (file)
index 0000000..40c429c
--- /dev/null
+++ b/advent21/Main.hs
@@ -0,0 +1,104 @@
+-- Writeup at https://work.njae.me.uk/2024/12/20/advent-of-code-2024-day-20/
+
+import AoC
+
+import Data.Char
+import Linear (V2(..), (^+^), (^-^))
+-- import qualified Data.Set as S
+-- import qualified Data.Map.Strict as M
+-- import Data.Maybe
+import Data.List
+import Control.Monad
+
+type Position = V2 Int -- r, c
+
+data Action = R | U | D | L | A deriving (Eq, Ord, Show)
+type ActionSeq = [Action]
+
+class Button a where
+  buttonPos :: a -> Position
+  aButton :: a
+  legalPos :: a -> Position -> Bool
+
+instance Button Action where
+  buttonPos U = V2 0 1
+  buttonPos A = V2 0 2
+  buttonPos L = V2 1 0
+  buttonPos D = V2 1 1
+  buttonPos R = V2 1 2
+
+  aButton = A
+
+  legalPos _ p = p `elem` [V2 0 1, V2 0 2, V2 1 0, V2 1 1, V2 1 2]
+
+instance Button Char where
+  buttonPos '7' = V2 0 0
+  buttonPos '8' = V2 0 1
+  buttonPos '9' = V2 0 2
+  buttonPos '4' = V2 1 0
+  buttonPos '5' = V2 1 1
+  buttonPos '6' = V2 1 2
+  buttonPos '1' = V2 2 0
+  buttonPos '2' = V2 2 1
+  buttonPos '3' = V2 2 2
+  buttonPos '0' = V2 3 1
+  buttonPos 'A' = V2 3 2
+
+  aButton = 'A'
+
+  legalPos _ p = p `elem` [V2 0 0, V2 0 1, V2 0 2, V2 1 0, V2 1 1, V2 1 2, V2 2 0, V2 2 1, V2 2 2, V2 3 1, V2 3 2]
+
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let codes = lines text
+      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
+
+part1 :: [String] -> Int
+part1 codes = sum $ fmap complexity codes
+
+-- complexity :: String -> (Int, Int)
+complexity code = (length ms) * ns
+  where ms = head $ sortOn length $ concatMap moves $ concatMap moves $ moves code
+        ns = read $ filter isDigit code
+
+moveBetween :: Button a => (a, a) -> [ActionSeq]
+moveBetween (a, b) = filter (allLegal a) $ filter groupTogether possibles
+  where aPos = buttonPos a
+        bPos = buttonPos b 
+        V2 dr dc = bPos ^-^ aPos
+        mh = replicate (abs dc) (if dc > 0 then R else L)
+        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
+
+delta :: Action -> Position
+delta U = V2 (-1) 0
+delta D = V2 1 0
+delta L = V2 0 (-1)
+delta R = V2 0 1
+delta A = V2 0 0
+
+positionsOf :: Button a => a -> ActionSeq -> [Position]
+positionsOf a bs = scanl' (^+^) (buttonPos a) $ fmap delta bs
+
+showMoves :: ActionSeq -> String
+showMoves = fmap (\a -> case a of
+                          U -> '^'
+                          D -> 'V'
+                          L -> '<'
+                          R -> '>'
+                          A -> 'A')

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