From 5d18fdfc6b93800c555782153eb0e53a8c39cb59 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Sun, 10 Dec 2023 17:09:00 +0000 Subject: [PATCH] Done dsy 10 --- advent-of-code23.cabal | 5 ++ advent10/Main.hs | 180 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 185 insertions(+) create mode 100644 advent10/Main.hs diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal index eca8d28..d24a735 100644 --- a/advent-of-code23.cabal +++ b/advent-of-code23.cabal @@ -154,3 +154,8 @@ executable advent08 executable advent09 import: common-extensions, build-directives main-is: advent09/Main.hs + +executable advent10 + import: common-extensions, build-directives + main-is: advent10/Main.hs + build-depends: linear, array, split, containers diff --git a/advent10/Main.hs b/advent10/Main.hs new file mode 100644 index 0000000..4788403 --- /dev/null +++ b/advent10/Main.hs @@ -0,0 +1,180 @@ +-- Writeup at https://work.njae.me.uk/2023/12/10/advent-of-code-2023-day-10/ + +import AoC + +import Data.List hiding (map) +import Data.List.Split +import Prelude hiding (map) +import Data.Maybe +import Linear (V2(..), (^+^)) +import Linear.Vector ((^*)) +import Data.Array.IArray +import qualified Data.Set as S + +data Pipe = Empty | + NorthWest | NorthSouth | NorthEast | + WestEast | WestSouth | + SouthEast | + Start + deriving (Show, Eq, Enum) + +type Position = V2 Int -- r, c +type Grid = Array Position Pipe + +data Map = Map { getGrid :: Grid, getStart :: Position } deriving (Show) + +type Path = [Position] + +type BGrid = Array Position Bool +type Region = S.Set Position + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- readFile dataFileName + let map = mkMap text + let loop = fromJust $ search map + print $ part1 loop + print $ part2 map loop + +part1 :: Path -> Int +part1 loop = (length loop) `div` 2 + +part2 :: Map -> Path -> Int +part2 map loop = S.size $ truePoints $ head iRegions + where bgrid = expand (getGrid map) loop + regions = regionsFromMap map loop + iRegions = innerRegions bgrid $ filter (not . S.null) regions + +-- reading the map + +mkMap :: String -> Map +mkMap text = Map grid' start + where grid = mkGrid text + start = head $ filter (( == Start) . (grid !)) $ indices grid + grid' = grid // [(start, startIs $ Map grid start)] + +mkGrid :: String -> Grid +mkGrid text = grid + where rows = lines text + r = length rows - 1 + c = (length $ head rows) - 1 + grid = listArray ((V2 0 0), (V2 r c)) $ fmap readPipe $ concat rows + +readPipe :: Char -> Pipe +readPipe 'J' = NorthWest +readPipe '|' = NorthSouth +readPipe 'L' = NorthEast +readPipe '-' = WestEast +readPipe '7' = WestSouth +readPipe 'F' = SouthEast +readPipe 'S' = Start +readPipe _ = Empty + +deltas :: Pipe -> [Position] +deltas NorthWest = [V2 (-1) 0, V2 0 (-1)] +deltas NorthSouth = [V2 (-1) 0, V2 1 0] +deltas NorthEast = [V2 (-1) 0, V2 0 1] +deltas WestEast = [V2 0 (-1), V2 0 1] +deltas WestSouth = [V2 0 (-1), V2 1 0] +deltas SouthEast = [V2 1 0, V2 0 1] +deltas Start = (deltas NorthSouth) ++ (deltas WestEast) +deltas Empty = [] + +neighbours :: Map -> Position -> [Position] +neighbours Map{..} p = filter (inRange $ bounds getGrid) $ + fmap (^+^ p) $ deltas $ getGrid ! p + +connectorsToStart :: Map -> [Position] +connectorsToStart map@Map{..} = fmap fst connectors + where nbrs = neighbours map getStart + nbrsNbrs = fmap (\n -> (n, neighbours map n)) nbrs + connectors = filter ((getStart `elem`) . snd) nbrsNbrs + +startIs :: Map -> Pipe +startIs map = head [ t | t <- [NorthWest .. SouthEast] + , (sort $ fmap (^+^ s) $ deltas t) == conns ] + where conns = sort $ connectorsToStart map + s = getStart map + +-- Part 1: finding the loop + +search :: Map -> Maybe Path +search map = dfs map (initial map) + +dfs :: Map -> [Path] -> Maybe Path +dfs _ [] = Nothing +dfs map (p:ps) + | isGoal map p = Just p + | otherwise = dfs map $ (successors map p) ++ ps + +successors :: Map -> Path -> [Path] +successors map p = fmap (:p) ns' + where ns = neighbours map $ head p + ns' = filter (`notElem` p) ns + +isGoal :: Map -> Path -> Bool +isGoal map p@(h:_) = ((getStart map) `elem` (neighbours map h)) && length p >= 3 + +initial :: Map -> [Path] +initial map = fmap (:[s]) $ neighbours map s + where s = getStart map + +-- finding the inner region + +expand :: Grid -> Path -> BGrid +expand grid path = foldl' (addWall grid) bgrid path + where (b0, b1) = bounds grid + b' = (b0, (b1 ^* 2) ^+^ (V2 1 1)) + bgrid = array b' [(p, False) | p <- range b'] + +addWall :: Grid -> BGrid -> Position -> BGrid +addWall grid bgrid p = bgrid // fmap ((, True)) adds + where wallCell = grid ! p + ds = deltas wallCell + p' = p ^* 2 + adds = p' : fmap (^+^ p') ds + +showBGrid :: BGrid -> String +showBGrid bgrid = unlines $ fmap (fmap showCell) rows + where rows = chunksOf (c + 1) $ elems bgrid + (_, V2 _ c) = bounds bgrid + showCell True = '#' + showCell False = '.' + +fill :: [Position] -> Region -> BGrid -> Region +fill [] region _ = region +fill (p:ps) region bgrid + | bgrid ! p = fill ps region bgrid + | p `S.member` region = fill ps region bgrid + | otherwise = fill (ps ++ ns) region' bgrid + where ns = bNeighbours bgrid p + region' = S.insert p region + +bNeighbours :: BGrid -> Position -> [Position] +bNeighbours g p = filter (inRange $ bounds g) $ unboundedNeighbours p + +unboundedNeighbours :: Position -> [Position] +unboundedNeighbours p = fmap (^+^ p) [V2 (-1) 0, V2 1 0, V2 0 (-1), V2 0 1] + +getRegions :: BGrid -> [Position] -> [Region] +getRegions bgrid starts = fmap (\s -> fill [s] S.empty bgrid) starts + +regionsFromMap :: Map -> Path -> [Region] +regionsFromMap map boundary = getRegions bgrid starts + where bgrid = expand (getGrid map) boundary + starts = filter (inRange $ bounds bgrid) $ + fmap (\n -> n ^+^ (getStart map ^* 2)) + [V2 dr dc | dr <- [-1, 0, 1], dc <- [-1, 0, 1]] + +onEdge :: BGrid -> Position -> Bool +onEdge bgrid p = any (not . inRange (bounds bgrid)) $ unboundedNeighbours p + +touchesEdge :: BGrid -> Region -> Bool +touchesEdge bgrid region = any (onEdge bgrid) $ S.toList region + +innerRegions :: BGrid -> [Region] -> [Region] +innerRegions bgrid regions = filter (not . touchesEdge bgrid) regions + +truePoints :: Region -> Region +truePoints = S.filter (\(V2 r c) -> r `mod` 2 == 0 && c `mod` 2 == 0) -- 2.34.1