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

  • VegOwOtenks@lemmy.world
    link
    fedilink
    English
    arrow-up
    2
    ·
    edit-2
    15 days ago

    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