diff --git a/solutions/src/2022/22_alt.hs b/solutions/src/2022/22_alt.hs index f3be84c..6a0c3d4 100644 --- a/solutions/src/2022/22_alt.hs +++ b/solutions/src/2022/22_alt.hs @@ -1,4 +1,4 @@ -{-# Language QuasiQuotes, TemplateHaskell, ImportQualifiedPost, LambdaCase, ImplicitParams, BangPatterns, DataKinds #-} +{-# Language QuasiQuotes, ConstraintKinds, TemplateHaskell, ImportQualifiedPost, LambdaCase, ImplicitParams, DataKinds #-} {-| Module : Main Description : Day 22 solution @@ -8,6 +8,10 @@ Maintainer : emertens@gmail.com +This solution works by first exploring the input file and assigning a cube +location to each flattened location. The path is explored in terms of the cube +coordinates and then is converted back into input file coordinates at the end. + >>> :{ :main + " ...# .#.. @@ -40,28 +44,41 @@ import Data.Map qualified as Map import Data.Maybe (isJust) import Data.Set (Set) import Data.Set qualified as Set +import qualified Advent.AsmProg as cube data D = DL | DR stageTH +type HiVal = ?hiVal :: Int + -- | -- >>> :main -- 55267 main :: IO () main = do (rawmap, path) <- [format|2022 22 (( |.|#)*!%n)*%n(%u|@D)*%n|] + + -- figure out the side-length of the cube we're working with + -- so that we can handle both examples and regular inputs let elts = countBy (`elem` ".#") (concat rawmap) - let ?highVal = until (\x -> 6*x*x >= elts) (1 +) 1 - 1 + let ?hiVal = until (\x -> 6*x*x >= elts) (1 +) 1 - 1 + + -- associate cube coordinates with all of the input file coordinates let maze = explore (Set.fromList [c | (c, '.') <- coordLines rawmap]) - (endLoc, endFacing) = foldl (applyCommand maze) (originLoc, 0) path - Just (C y x) = onMaze maze endLoc - endFacing' = fixFacing maze endLoc endFacing - print (1000 * (y + 1) + 4 * (x + 1) + endFacing') + + -- figure out the cube coordinate that our path ends on + let S endLoc endFacing = fixFacing maze (foldl (applyCommand maze) (S originLoc 0) path) + + -- translate the cube coordinates back into flat coordinates + let C y x = maze Map.! endLoc + + -- compute the "password" from the end location + print (1000 * (y + 1) + 4 * (x + 1) + endFacing) -- | Given the set of flat path coordinates compute the cube-coordinate -- to flat coordinate map. -explore :: (?highVal :: Int) => Set Coord -> Map Loc Coord +explore :: HiVal => Set Coord -> Map Loc Coord explore input = Map.fromList (dfsOn snd step (originLoc, Set.findMin input)) where step (l, c) = @@ -70,19 +87,24 @@ explore input = Map.fromList (dfsOn snd step (originLoc, Set.findMin input)) [(locUp l, above c) | above c `Set.member` input] ++ [(locDown l, below c) | below c `Set.member` input] -applyCommand :: (?highVal :: Int) => Map Loc Coord -> (Loc, Facing) -> Either Int D -> (Loc, Facing) -applyCommand maze (!here, !dir) = \case - Left n -> (walkN maze n dir here, dir) - Right t -> (here, turn t dir) +-- | A location on the cube and a direction +data S = S !Loc !Facing + +-- | Apply a command to the state of the walker on the cube. +-- Each move is either forward a certain number or a turn. +applyCommand :: HiVal => Map Loc Coord -> S -> Either Int D -> S +applyCommand maze (S here dir) = \case + Left n -> S (walkN maze n dir here) dir + Right t -> S here (turn t dir) -- | Walk a number of steps in the given direction -walkN :: (?highVal :: Int) => Map Loc Coord -> Int -> Facing -> Loc -> Loc +walkN :: HiVal => Map Loc Coord -> Int -> Facing -> Loc -> Loc walkN maze n dir here = last (takeWhile valid (take (n + 1) (iterate (move dir) here))) where valid = isJust . onMaze maze -- | Find the location in the input file corresponding to this -- cube location if one exists. -onMaze :: (?highVal :: Int) => Map Loc Coord -> Loc -> Maybe Coord +onMaze :: HiVal => Map Loc Coord -> Loc -> Maybe Coord onMaze maze loc = msum (map (`Map.lookup` maze) (take 4 (iterate locRotate loc))) -- | Symmetric group S4 corresponds to the symmetries of a cube. @@ -97,34 +119,37 @@ rotZ = mkPermutation ([2,3,1,0]!!) data Loc = Loc { locFace :: S4, locCoord :: Coord } deriving (Show, Ord, Eq) +-- | Initial location on the top-left or a face. originLoc :: Loc originLoc = Loc mempty origin -locRight, locLeft, locUp, locDown, locRotate :: (?highVal :: Int) => Loc -> Loc +locRight, locLeft, locUp, locDown, locRotate :: HiVal => Loc -> Loc locRight (Loc p (C y x)) - | x < ?highVal = Loc p (C y (x + 1)) + | x < ?hiVal = Loc p (C y (x + 1)) | otherwise = Loc (p <> invert rotY) (C y 0) locLeft (Loc p (C y x)) | 0 < x = Loc p (C y (x - 1)) - | otherwise = Loc (p <> rotY) (C y ?highVal) + | otherwise = Loc (p <> rotY) (C y ?hiVal) locDown (Loc p (C y x)) - | y < ?highVal = Loc p (C (y + 1) x) + | y < ?hiVal = Loc p (C (y + 1) x) | otherwise = Loc (p <> rotX) (C 0 x) locUp (Loc p (C y x)) | 0 < y = Loc p (C (y - 1) x) - | otherwise = Loc (p <> invert rotX) (C ?highVal x) + | otherwise = Loc (p <> invert rotX) (C ?hiVal x) -locRotate (Loc p (C y x)) = Loc (p <> rotZ) (C x (?highVal - y)) +-- Rotate the representation of the current location 90-degrees +-- clockwise in order to put it onto a symmetric cube-face. +locRotate (Loc p (C y x)) = Loc (p <> rotZ) (C x (?hiVal - y)) -- | Rotate the facing until we're on the cube face as it -- is oriented on the input text. -fixFacing :: (?highVal :: Int) => Map Loc Coord -> Loc -> Facing -> Facing -fixFacing maze loc n - | Map.member loc maze = n - | otherwise = fixFacing maze (locRotate loc) (turn DR n) +fixFacing :: HiVal => Map Loc Coord -> S -> S +fixFacing maze (S loc n) + | Map.member loc maze = S loc n + | otherwise = fixFacing maze (S (locRotate loc) (turn DR n)) type Facing = Int @@ -132,7 +157,7 @@ turn :: D -> Facing -> Facing turn DL x = (x - 1) `mod` 4 turn DR x = (x + 1) `mod` 4 -move :: (?highVal :: Int) => Facing -> Loc -> Loc +move :: HiVal => Facing -> Loc -> Loc move 0 = locRight move 1 = locDown move 2 = locLeft