eldridge.cam
Advent of Code solutions
1{-# LANGUAGE ViewPatterns #-}
2
3import Control.Arrow
4import Control.Monad
5import Control.Monad.State
6import Data.Array.Unboxed
7import Data.Maybe
8import Data.Set (Set)
9import Data.Set qualified as Set
10
11type Pos = (Int, Int)
12
13type Dir = (Int, Int)
14
15type Grid = Array Pos Char
16
17readGrid :: String -> Grid
18readGrid contents = listArray ((0, 0), (height - 1, width - 1)) $ concat input
19 where
20 input = lines contents
21 height = length input
22 width = length (input !! 0)
23
24visit pos = modify' (Set.insert pos)
25
26been pos = gets (Set.member pos)
27
28add2 (a1, p1) (a2, p2) = (a1 + a2, p1 + p2)
29
30collect (a1, p1) (a2, p2) = (a1 + a2, Set.union p1 p2)
31
32neighbours pos = fmap (add2 pos) directions
33
34directions = [(-1, 0), (1, 0), (0, -1), (0, 1)]
35
36turn (y, x) = (x, -y)
37
38unturn = turn . turn . turn
39
40fence pos = add2 pos &&& id
41
42flood :: Grid -> Pos -> State (Set Pos) (Maybe (Int, Set (Pos, Dir)))
43flood grid pos = do
44 hasbeen <- been pos
45 if hasbeen
46 then return Nothing
47 else Just <$> flood_ (grid ! pos) pos
48 where
49 flood_ :: Char -> Pos -> State (Set Pos) (Int, Set (Pos, Dir))
50 flood_ ch pos = do
51 hasbeen <- been pos
52 if grid !? pos /= Just ch || hasbeen
53 then return (0, Set.empty)
54 else do
55 visit pos
56 floods <- mapM (flood_ ch) (neighbours pos)
57 let fenceSides = filter (\p -> grid !? add2 pos p /= Just ch) directions
58 in return $ foldl collect (1, Set.fromList (fence pos <$> fenceSides)) floods
59
60sides :: Set (Pos, Dir) -> Int
61sides (Set.minView -> Nothing) = 0
62sides (Set.minView -> Just (seg, rest)) = 1 + sides (go unturn seg $ go turn seg rest)
63 where
64 go rot (pos, dir) rest
65 | Set.member seg rest = go rot seg $ Set.delete seg rest
66 | otherwise = rest
67 where
68 target = add2 pos $ rot dir
69 seg = (target, dir)
70
71answer :: String -> Int
72answer contents = sum $ fmap (uncurry (*) . second sides) $ catMaybes $ evalState (mapM (flood grid) (indices grid)) Set.empty
73 where
74 grid = readGrid contents
75
76main = getContents >>= print . answer