X-Git-Url: https://git.njae.me.uk/?p=advent-of-code-22.git;a=blobdiff_plain;f=advent22%2FMain.hs;fp=advent22%2FMain.hs;h=93af26916a4a5e139f484816c96ddd061a4fdae1;hp=0000000000000000000000000000000000000000;hb=ea35652beea3aa2e32ae15c13388d893b0044e1a;hpb=fac89b5e50afe5c2d64d597c9e0873af5a1b9302 diff --git a/advent22/Main.hs b/advent22/Main.hs new file mode 100644 index 0000000..93af269 --- /dev/null +++ b/advent22/Main.hs @@ -0,0 +1,264 @@ +-- Writeup at https://work.njae.me.uk/2022/12/19/advent-of-code-2022-day-18/ + +import Debug.Trace + +import AoC +import Prelude hiding (Left, Right) +import qualified Data.Map.Strict as M +import Data.Map.Strict ((!)) +import Linear hiding (E) +import Control.Lens +import Data.Ix +import Data.Maybe +import Data.List +import Data.Char +import Control.Monad.Reader + + +type Position = V2 Int -- r, c +_r :: Lens' (V2 Int) Int +_r = _x +_c :: Lens' (V2 Int) Int +_c = _y + +data Cell = Tile | Wall + deriving (Show, Eq) + +type FieldMap = M.Map Position Cell + +data Direction = Right | Down | Left | Up + deriving (Show, Eq, Ord, Enum, Bounded) + +predW, succW :: (Eq a, Bounded a, Enum a) => a -> a +predW a + | a == minBound = maxBound + | otherwise = pred a +succW a + | a == maxBound = minBound + | otherwise = succ a + +data PathElement = Forward Int | Clockwise | Anticlockwise + deriving (Show, Eq) + +data Person = Person {_position :: Position, _facing :: Direction} + deriving (Show, Eq) +makeLenses ''Person + +data Field = Field { getMap :: FieldMap, whatsAheadFunc :: Person -> FieldContext Person, whatsAtFunc :: Position -> FieldContext Cell} +type FieldContext = Reader Field + +data Face = A | B | C | D | E | F + deriving (Show, Eq) + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- readFile dataFileName + let (field, instrs) = successfulParse text + print $ part1 field instrs + print $ part2 field instrs + -- print $ probeAllCorners field + +part1 fieldMap instrs = passwordOf endPerson + where field = mkFlatField fieldMap + startPos = V2 0 $ fromJust $ minimumOf (folded . filteredBy (_r . only 0) . _c) $ M.keysSet fieldMap + startPerson = Person startPos Right + endPerson = runReader (walk startPerson instrs) field + +part2 fieldMap instrs = passwordOf endPerson + where field = mkCubeField fieldMap + startPos = V2 0 $ fromJust $ minimumOf (folded . filteredBy (_r . only 0) . _c) $ M.keysSet fieldMap + startPerson = Person startPos Right + endPerson = runReader (walk startPerson instrs) field + +-- probeCube fieldMap startPos startDirection = endPerson +-- where field = mkCubeField fieldMap +-- startPerson = Person startPos startDirection +-- endPerson = runReader (whatsAheadCube startPerson) field + +-- probeAllCorners fieldMap = [(p, probeACorner p field) | p <- persons] +-- where persons = [ Person (V2 r c) f +-- | r <- [0, 49, 50, 99, 100, 149] +-- , c <- [0, 49, 50, 99, 100, 149, 150, 199] +-- , f <- [Right, Down, Left, Up] +-- , (V2 r c) `M.member` fieldMap +-- ] +-- field = mkCubeField fieldMap + +-- probeACorner person field +-- | Debug.Trace.trace (show person) False = undefined +-- | otherwise = runReader (whatsAheadCube person) field + + +passwordOf :: Person -> Int +passwordOf person = 1000 * (person ^. position . _r + 1) + + 4 * (person ^. position . _c + 1) + + (fromEnum $ person ^. facing) + + +mkFlatField :: FieldMap -> Field +mkFlatField fieldMap = + Field { getMap = fieldMap + , whatsAheadFunc = whatsAheadFlat + , whatsAtFunc = whatsAt} + + +mkCubeField :: FieldMap -> Field +mkCubeField fieldMap = + Field { getMap = fieldMap + , whatsAheadFunc = whatsAheadCube + , whatsAtFunc = whatsAt} + +whatsAt :: Position -> FieldContext Cell +whatsAt posiiton = + do fieldMap <- asks getMap + return $ fieldMap ! posiiton + +whatsAheadFlat :: Person -> FieldContext Person +whatsAheadFlat person = + do let easyNext = (person ^. position) + (deltaOf $ person ^. facing) + fieldMap <- asks getMap + if easyNext `M.member` fieldMap + then return $ person & position .~ easyNext + else do let currenFacing = person ^. facing + let currentRow = person ^. position . _r + let currentCol = person ^. position . _c + let rightMovingCol = fromJust $ minimumOf (folded . filteredBy (_r . only currentRow) . _c) $ M.keysSet fieldMap + let leftMovingCol = fromJust $ maximumOf (folded . filteredBy (_r . only currentRow) . _c) $ M.keysSet fieldMap + let upMovingRow = fromJust $ maximumOf (folded . filteredBy (_c . only currentCol) . _r) $ M.keysSet fieldMap + let downMovingRow = fromJust $ minimumOf (folded . filteredBy (_c . only currentCol) . _r) $ M.keysSet fieldMap + return $ case currenFacing of + Right -> person & position . _c .~ rightMovingCol + Left -> person & position . _c .~ leftMovingCol + Up -> person & position . _r .~ upMovingRow + Down -> person & position . _r .~ downMovingRow + + +-- A B +-- C +-- D E +-- F + +whatsAheadCube :: Person -> FieldContext Person +whatsAheadCube person = + do let easyNext = (person ^. position) + (deltaOf $ person ^. facing) + let currentFace = faceOf (person ^. position) + let nextFace = faceOf easyNext + fieldMap <- asks getMap + if (easyNext `M.member` fieldMap) && (currentFace == nextFace) + then return $ person & position .~ easyNext + else return $ crossEdge person currentFace + +faceOf :: Position -> Face +faceOf position + | (inRange (0, 49) r) && (inRange (50, 99) c) = A + | (inRange (0, 49) r) && (inRange (100, 149) c) = B + | (inRange (50, 99) r) && (inRange (50, 99) c) = C + | (inRange (100, 149) r) && (inRange (0, 49) c) = D + | (inRange (100, 149) r) && (inRange (50, 99) c) = E + | (inRange (150, 199) r) && (inRange (0, 49) c) = F + | otherwise = error "Not a face" + where r = position ^. _r + c = position ^. _c + +crossEdge :: Person -> Face -> Person +crossEdge person face = + case (d, face) of + (Up, A) -> person & position . _r .~ (interpol c 150 199) & position . _c .~ 0 & facing .~ Right + (Right, A) -> person & position . _c .~ 100 + (Down, A) -> person & position . _r .~ 50 + (Left, A) -> person & position . _r .~ (interpol r 149 100) & position . _c .~ 0 & facing .~ Right + + (Up, B) -> person & position . _r .~ 199 & position . _c .~ (interpol c 0 49) + (Right, B) -> person & position . _r .~ (interpol r 149 100) & position . _c .~ 99 & facing .~ Left + (Down, B) -> person & position . _r .~ (interpol c 50 99) & position . _c .~ 99 & facing .~ Left + (Left, B) -> person & position . _c .~ 99 + + (Up, C) -> person & position . _r .~ 49 + (Right, C) -> person & position . _r .~ 49 & position . _c .~ (interpol r 100 149) & facing .~ Up + (Down, C) -> person & position . _r .~ 100 + (Left, C) -> person & position . _r .~ 100 & position . _c .~ (interpol r 0 49) & facing .~ Down + + (Up, D) -> person & position . _r .~ (interpol c 50 99) & position . _c .~ 50 & facing .~ Right + (Right, D) -> person & position . _c .~ 50 + (Down, D) -> person & position . _r .~ 150 + (Left, D) -> person & position . _r .~ (interpol r 49 0) & position . _c .~ 50 & facing .~ Right + + (Up, E) -> person & position . _r .~ 99 + (Right, E) -> person & position . _r .~ (interpol r 49 0) & position . _c .~ 149 & facing .~ Left + (Down, E) -> person & position . _r .~ (interpol c 150 199) & position . _c .~ 49 & facing .~ Left + (Left, E) -> person & position . _c .~ 49 + + (Up, F) -> person & position . _r .~ 149 + (Right, F) -> person & position . _r .~ 149 & position . _c .~ (interpol r 50 99) & facing .~ Up + (Down, F) -> person & position . _r .~ 0 & position . _c .~ (interpol c 100 149) + (Left, F) -> person & position . _r .~ 0 & position . _c .~ (interpol r 50 99) & facing .~ Down + + otherwise -> error ("Crossing illegal boundary " ++ show (person, face)) + + where r = person ^. position . _r + c = person ^. position . _c + d = person ^. facing + interpol x start end = (signum (end - start)) * (x `mod` 50) + start + + +walk :: Person -> [PathElement] -> FieldContext Person +walk person [] = return person +walk person (step:steps) = + do person' <- walkOne person step + walk person' steps + +walkOne :: Person -> PathElement -> FieldContext Person +walkOne person (Forward n) + | n == 0 = return person + | otherwise = + do whatsAhead <- asks whatsAheadFunc + person' <- whatsAhead person + whatsAt <- asks whatsAtFunc + nextCell <- whatsAt (person' ^. position) + if nextCell == Wall + then return person + else walkOne person' (Forward (n - 1)) +walkOne person Clockwise = return $ person & facing %~ succW +walkOne person Anticlockwise = return $ person & facing %~ predW + +deltaOf :: Direction -> Position +deltaOf Right = V2 0 1 +deltaOf Down = V2 1 0 +deltaOf Left = V2 0 -1 +deltaOf Up = V2 -1 0 + + +-- Parse the input file + +successfulParse :: String -> (FieldMap, [PathElement]) +successfulParse text = (mkField $ takeWhile ((> 0) . length) $ init $ lines text, mkInstructions $ last $ lines text) + +mkField :: [String] -> FieldMap +mkField rows = M.fromList + [ (V2 r c, mkCell r c) + | r <- [0..maxR], c <- [0..maxC] + , isCell r c rows + ] + where maxR = length rows - 1 + maxC = (length $ head rows) - 1 + -- isCell r c = ((rows !! r) !! c) `elem` (".#" :: String) + mkCell r c + | cell == '.' = Tile + | cell == '#' = Wall + where cell = (rows !! r) !! c + +isCell r c rows = isRow && isCol && ((rows !! r) !! c) `elem` (".#" :: String) + where isRow = r < length rows + isCol = c < (length $ rows !! r) + +mkInstructions :: String -> [PathElement] +mkInstructions [] = [] +mkInstructions text@(t:ts) + | isDigit t = mkWalk text + | otherwise = mkTurn text +mkWalk text = (Forward $ read digits) : (mkInstructions remainder) + where (digits, remainder) = span (isDigit) text +mkTurn (t:ts) + | t == 'R' = Clockwise : (mkInstructions ts) + | t == 'L' = Anticlockwise : (mkInstructions ts)