Day 12: Garden Groups
Megathread guidelines
- Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
- You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL
FAQ
- What is this?: Here is a post with a large amount of details: https://programming.dev/post/6637268
- Where do I participate?: https://adventofcode.com/
- Is there a leaderboard for the community?: We have a programming.dev leaderboard with the info on how to join in this post: https://programming.dev/post/6631465
You are viewing a single thread.
View all comments 
3 points
Haskell
This was a bit of a fiddly one. There’s probably scope for golfing it down some more, but I’ve had enough for today :3
Solution
import Control.Arrow
import Data.List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
readInput :: String -> Map (Int, Int) Char
readInput s = Map.fromList [((i, j), c) | (i, l) <- zip [0 ..] (lines s), (j, c) <- zip [0 ..] l]
(i1, j1) .+. (i2, j2) = (i1 + i2, j1 + j2)
(i1, j1) .-. (i2, j2) = (i1 - i2, j1 - j2)
directions = [(0, 1), (1, 0), (0, -1), (-1, 0)] :: [(Int, Int)]
edges = zip ps (drop 1 ps) :: [((Int, Int), (Int, Int))]
where
ps = [(0, 1), (1, 1), (1, 0), (0, 0), (0, 1)]
regions :: Map (Int, Int) Char -> [Set (Int, Int)]
regions = unfoldr (fmap (uncurry removeRegion) . Map.minViewWithKey)
where
removeRegion (p, t) = go Set.empty (Set.singleton p)
where
go r ps plots
| Set.null ps = (r, plots)
| otherwise =
let ps' =
Set.filter (\p -> plots Map.!? p == Just t) $
Set.fromList (concatMap adjacent ps) Set.\\ ps
in go (Set.union r ps) ps' (Map.withoutKeys plots ps')
adjacent = (`map` directions) . (.+.)
boundary :: Set (Int, Int) -> Set ((Int, Int), (Int, Int))
boundary region =
Set.fromList $
[ (p .+. e1, p .+. e2)
| p <- Set.elems region,
(d, (e1, e2)) <- zip directions edges,
p .+. d `Set.notMember` region
]
perimeter :: Set (Int, Int) -> [[(Int, Int)]]
perimeter = unfoldr (fmap (uncurry removeChain) . Set.minView) . boundary
where
removeChain e@(e1, e2) es = first (e1 :) $ go [] e es
go c e@(e1, e2) es =
case find ((== e2) . fst) es of
Nothing -> (e1 : c, es)
Just e' -> go (e1 : c) e' (Set.delete e' es)
countSides :: [(Int, Int)] -> Int
countSides ps = length $ group $ zipWith (.-.) (drop 1 ps) ps
main = do
input <- readInput <$> readFile "input12"
let rs = map (Set.size &&& perimeter) $ regions input
print . sum $ map (\(a, p) -> a * sum (map (subtract 1 . length) p)) rs
print . sum $ map (\(a, p) -> a * sum (map countSides p)) rs
2 points
*
