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 2 points
*
Haskell
Detecting regions is a floodfill. For Part 2, I select all adjacent tiles that are not part of a region and group them by the direction relative to the closest region tile, then group adjacent tiles with the same direction again and count.
Edit:
Takes 0.06s
Reveal Code
import Control.Arrow
import Data.Array.Unboxed (UArray)
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Array.Unboxed as UArray
parse :: String -> UArray (Int, Int) Char
parse s = UArray.listArray ((1, 1), (n, m)) . filter (/= '\n') $ s
where
n = takeWhile (/= '\n') >>> length $ s
m = filter (== '\n') >>> length >>> pred $ s
neighborCoordinates (p1, p2) = [(p1-1, p2), (p1, p2-1), (p1, p2+1), (p1+1, p2)]
allNeighbors p a = neighborCoordinates
>>> filter (UArray.inRange (UArray.bounds a))
$ p
regionNeighbors p a = allNeighbors p
>>> filter ((a UArray.!) >>> (== pTile))
$ a
where
pTile = a UArray.! p
floodArea :: Set (Int, Int) -> Set (Int, Int) -> UArray (Int, Int) Char -> Set (Int, Int)
floodArea e o a
| Set.null o = e
| otherwise = floodArea e' o' a
where
e' = Set.union e o
o' = Set.fold (Set.union . Set.fromDistinctAscList . (filter (`Set.notMember` e')) . (flip regionNeighbors a)) Set.empty o
findRegions garden = findRegions' (Set.fromList . UArray.indices $ garden) garden
findRegions' remainingIndices garden
| Set.null remainingIndices = []
| otherwise = removedIndices : findRegions' remainingIndices' garden
where
removedIndices = floodArea Set.empty (Set.singleton . Set.findMin $ remainingIndices) garden
remainingIndices' = Set.difference remainingIndices removedIndices
perimeter region = Set.fold ((+) . length . filter (`Set.notMember` region) . neighborCoordinates) 0 region
part1 rs = map (Set.size &&& perimeter)
>>> map (uncurry (*))
>>> sum
$ rs
turnLeft ( 0, 1) = (-1, 0) -- right
turnLeft ( 0,-1) = ( 1, 0) -- left
turnLeft ( 1, 0) = ( 0, 1) -- down
turnLeft (-1, 0) = ( 0,-1) -- up
turnRight = turnLeft . turnLeft . turnLeft
move (py, px) (dy, dx) = (py + dy, px + dx)
tupleDelta (y1, x1) (y2, x2) = (y1-y2, x1-x2)
isRegionInner region p = all (`Set.member` region) (neighborCoordinates p)
groupEdges d ps
| Set.null ps = []
| otherwise = collectedEdge : groupEdges d ps'
where
ps' = Set.difference ps collectedEdge
collectedEdge = Set.union leftPoints rightPoints
leftPoints = iterate (move dl)
>>> takeWhile (`Set.member` ps)
>>> Set.fromList
$ currentPoint
rightPoints = iterate (move dr)
>>> takeWhile (`Set.member` ps)
>>> Set.fromList
$ currentPoint
currentPoint = Set.findMin ps
dr = turnRight d
dl = turnLeft d
linearPerimeter region = Map.foldr ((+) . length) 0 $ groupedEdges
where
edgeTiles = Set.filter (not . isRegionInner region) region
regionNeighbors = List.concatMap (\ p -> map (p,). filter (`Set.notMember` region) . neighborCoordinates $ p) . Set.toList $ region
groupedNeighbors = List.map (uncurry tupleDelta &&& Set.singleton . snd)
>>> Map.fromListWith (Set.union)
$ regionNeighbors
groupedEdges = Map.mapWithKey groupEdges
$ groupedNeighbors
part2 rs = map (Set.size &&& linearPerimeter)
>>> map (uncurry (*))
>>> sum
$ rs
main = getContents
>>= print
. (part1 &&& part2)
. findRegions
. parse
