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
    20 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.

    Takes 0.2s

    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+1, p2), (p1, p2+1), (p1, p2-1)]
    
    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) -> UArray (Int, Int) Char -> Set (Int, Int)
    floodArea region garden
            | neighbors == region = region
            | otherwise = floodArea neighbors garden
            where
                    neighbors = Set.toList
                            >>> map (flip regionNeighbors garden)
                            >>> map (Set.fromList)
                            >>> (region:)
                            >>> Set.unions
                            $ region
    
    findRegions garden = findRegions' (Set.fromList . UArray.indices $ garden) garden
    
    findRegions' remainingIndices garden
            | Set.null remainingIndices = []
            | otherwise = removedIndices : findRegions' (Set.difference remainingIndices removedIndices) garden
            where
                    removedIndices = floodArea (Set.singleton . Set.findMin $ remainingIndices) garden
    
    perimeterCoordinates region = Set.toList
            >>> List.map (flip Set.difference region . Set.fromList . neighborCoordinates)
            $ region
    
    perimeter region = Set.toList
            >>> List.map (Set.fromList . neighborCoordinates)
            >>> List.map (flip Set.difference region)
            >>> List.map Set.size
            >>> sum
            $ 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.unions [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