Done dsy 10

diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal
index eca8d28041afe712b19240c48a81a47c9374d2aa..d24a7355d30301947d6248c8956387d2d070f133 100644 (file)
--- 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 (file)
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)