From a94312463b9fcd4f2a4aa24620829c528435e55a Mon Sep 17 00:00:00 2001 From: Daniele Fucini Date: Fri, 6 Dec 2024 19:20:09 +0100 Subject: [PATCH] Day 6, Part 2 --- Day6/puzzle1.hs | 78 ++++++++++++++++++------------------------ Day6/puzzle2.hs | 91 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 125 insertions(+), 44 deletions(-) create mode 100644 Day6/puzzle2.hs diff --git a/Day6/puzzle1.hs b/Day6/puzzle1.hs index a362607..7dc4037 100644 --- a/Day6/puzzle1.hs +++ b/Day6/puzzle1.hs @@ -11,64 +11,54 @@ getDirection '>' = R getDirection 'v' = D getDirection '<' = L -getStartPositionition :: Char -> Grid -> Position -getStartPositionition c grid = (x, y) - where x = fromMaybe (-1) . elemIndex True . map (isJust . elemIndex c) $ grid - y = if x == -1 - then -1 - else fromMaybe (-1) . elemIndex c $ grid !! x +getStartPosition:: Char -> Grid -> Position +getStartPosition c grid = (x, y) + where x = fromMaybe (-1) . elemIndex True . map (isJust . elemIndex c) $ grid + y = if x == -1 then -1 else fromMaybe (-1) . elemIndex c $ grid !! x getGridVal :: Position -> Grid -> Char getGridVal (x, y) grid = (grid !! x) !! y -moveUp :: Position -> Position -moveUp (x, y) = (x - 1, y) - -moveDown :: Position -> Position -moveDown (x, y) = (x + 1, y) - -moveLeft :: Position -> Position -moveLeft (x, y) = (x, y - 1) - -moveRight :: Position -> Position -moveRight (x, y) = (x, y + 1) - isInside :: Position -> Grid -> Bool isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (head grid) getNextPosition :: Position -> Direction -> Grid -> (Position, Direction) -getNextPosition (x, y) U grid = let newPos = moveUp (x, y) - in if newPos `isInside` grid && getGridVal newPos grid == '#' - then (moveRight (x, y), R) - else (newPos, U) -getNextPosition (x, y) R grid = let newPos = moveRight (x, y) - in if newPos `isInside` grid && getGridVal newPos grid == '#' - then (moveDown (x, y), D) - else (newPos, R) -getNextPosition (x, y) D grid = let newPos = moveDown (x, y) - in if newPos `isInside` grid && getGridVal newPos grid == '#' - then (moveLeft (x, y), L) - else (newPos, D) -getNextPosition (x, y) L grid = let newPos = moveLeft (x, y) - in if newPos `isInside` grid && getGridVal newPos grid == '#' - then (moveUp (x, y), U) - else (newPos, L) +getNextPosition (x, y) U grid = let newPos = (x - 1, y) + gridVal = getGridVal newPos grid + in if newPos `isInside` grid && gridVal == '#' + then getNextPosition (x, y) R grid + else (newPos, U) +getNextPosition (x, y) R grid = let newPos = (x, y + 1) + gridVal = getGridVal newPos grid + in if newPos `isInside` grid && gridVal == '#' + then getNextPosition (x, y) D grid + else (newPos, R) +getNextPosition (x, y) D grid = let newPos = (x + 1, y) + gridVal = getGridVal newPos grid + in if newPos `isInside` grid && gridVal == '#' + then getNextPosition (x, y) L grid + else (newPos, D) +getNextPosition (x, y) L grid = let newPos = (x, y - 1) + gridVal = getGridVal newPos grid + in if newPos `isInside` grid && gridVal == '#' + then getNextPosition (x, y) U grid + else (newPos, L) -markVisited :: Position -> Grid -> Grid -markVisited (x, y) grid = let row = grid !! x - newRow = take y row ++ ['X'] ++ drop (y + 1) row - in take x grid ++ [newRow] ++ drop (x + 1) grid +markVisited :: Position -> Char -> Grid -> Grid +markVisited (x, y) c grid = let row = grid !! x + newRow = take y row ++ [c] ++ drop (y + 1) row + in take x grid ++ [newRow] ++ drop (x + 1) grid visitGrid :: Position -> Direction -> Grid -> Grid -visitGrid (x, y) direction grid = let newGrid = markVisited (x, y) grid - (newPosition, newDirection) = getNextPosition (x, y) direction grid - in if newPosition `isInside` newGrid - then visitGrid newPosition newDirection newGrid +visitGrid (x, y) direction grid = let newGrid = markVisited (x, y) 'X' grid + (nextPosition, newDirection) = getNextPosition (x, y) direction grid + in if nextPosition `isInside` newGrid + then visitGrid nextPosition newDirection newGrid else newGrid main = do contents <- lines <$> readFile "day6.txt" - let (x, y) = (\w x y z -> head $ filter ((>= 0) . fst) [w, x, y, z]) <$> getStartPositionition 'v' <*> getStartPositionition '^' - <*> getStartPositionition '<' <*> getStartPositionition '>' $ contents + let (x, y) = (\w x y z -> head $ filter ((>= 0) . fst) [w, x, y, z]) <$> getStartPosition 'v' <*> getStartPosition '^' + <*> getStartPosition '<' <*> getStartPosition '>' $ contents direction = getDirection $ (contents !! x) !! y print . length . filter (== 'X') . concat $ visitGrid (x, y) direction contents diff --git a/Day6/puzzle2.hs b/Day6/puzzle2.hs new file mode 100644 index 0000000..37e44f9 --- /dev/null +++ b/Day6/puzzle2.hs @@ -0,0 +1,91 @@ +import Data.List (elemIndex) +import Data.Maybe (isJust, fromMaybe) + +type Grid = [String] +type Position = (Int, Int) +data Direction = U | R | D | L deriving Eq + +getDirection :: Char -> Direction +getDirection '^' = U +getDirection '>' = R +getDirection 'v' = D +getDirection '<' = L + +printDirection :: Direction -> Char +printDirection U = '^' +printDirection R = '>' +printDirection D = 'v' +printDirection L = '<' + +getStartPosition :: Char -> Grid -> Position +getStartPosition c grid = (x, y) + where x = fromMaybe (-1) . elemIndex True . map (isJust . elemIndex c) $ grid + y = if x == -1 then -1 else fromMaybe (-1) . elemIndex c $ grid !! x + +getGridVal :: Position -> Grid -> Char +getGridVal (x, y) grid = (grid !! x) !! y + +isInside :: Position -> Grid -> Bool +isInside (x, y) grid = x >= 0 && y >= 0 && x < length grid && y < length (head grid) + +getNextPosition :: Position -> Direction -> Grid -> (Position, Direction) +getNextPosition (x, y) U grid = let newPos = (x - 1, y) + gridVal = getGridVal newPos grid + in if newPos `isInside` grid && gridVal == '#' + then getNextPosition (x, y) R grid + else (newPos, U) +getNextPosition (x, y) R grid = let newPos = (x, y + 1) + gridVal = getGridVal newPos grid + in if newPos `isInside` grid && gridVal == '#' + then getNextPosition (x, y) D grid + else (newPos, R) +getNextPosition (x, y) D grid = let newPos = (x + 1, y) + gridVal = getGridVal newPos grid + in if newPos `isInside` grid && gridVal == '#' + then getNextPosition (x, y) L grid + else (newPos, D) +getNextPosition (x, y) L grid = let newPos = (x, y - 1) + gridVal = getGridVal newPos grid + in if newPos `isInside` grid && gridVal == '#' + then getNextPosition (x, y) U grid + else (newPos, L) + +markVisited :: Position -> Char -> Grid -> Grid +markVisited (x, y) c grid = let gridVal = getGridVal (x, y) grid + in if gridVal == '#' || gridVal == '^' || gridVal == '>' || gridVal == 'v' || gridVal == '<' + then grid + else let row = grid !! x + newRow = take y row ++ [c] ++ drop (y + 1) row + in take x grid ++ [newRow] ++ drop (x + 1) grid + +visitGrid :: Position -> Direction -> Grid -> Grid +visitGrid (x, y) direction grid = let newGrid = markVisited (x, y) 'X' grid + (nextPosition, newDirection) = getNextPosition (x, y) direction grid + in if nextPosition `isInside` newGrid + then visitGrid nextPosition newDirection newGrid + else newGrid + +checkGridLoop :: Position -> Direction -> Grid -> Bool +checkGridLoop startPosition direction grid = let (nextPosition, newDirection) = getNextPosition startPosition direction grid + newDirectionChar = printDirection newDirection + newGrid = markVisited nextPosition newDirectionChar grid + in if not $ nextPosition `isInside` grid + then False + else if getGridVal nextPosition grid == newDirectionChar + then True + else checkGridLoop nextPosition newDirection newGrid + +setGridObstacles :: Position -> Grid -> [Grid] +setGridObstacles startPosition grid = let positions = [ (x, y) | x <- [0..(length grid - 1)], y <- [0..(length (head grid) - 1)], (x, y) /= startPosition, getGridVal (x, y) grid == 'X' ] + in zipWith (`markVisited` '#') positions (replicate (length positions) grid) + + +main = do + contents <- lines <$> readFile "day6.txt" + let (x, y) = (\w x y z -> head $ filter ((>= 0) . fst) [w, x, y, z]) <$> getStartPosition 'v' <*> getStartPosition '^' + <*> getStartPosition '<' <*> getStartPosition '>' $ contents + direction = getDirection $ (contents !! x) !! y + grid = visitGrid (x, y) direction contents + gridObstacles = setGridObstacles (x, y) grid + loops = filter (checkGridLoop (x, y) direction) gridObstacles + print $ length loops