aoc/2025/aoc/app/day4/Main.hs
2025-12-07 22:43:52 +01:00

82 lines
2.1 KiB
Haskell

module Main (main) where
data Cell = Paper | Empty deriving (Eq, Show)
type Row = [Cell]
type Grid = [Row]
type Coords = (Int, Int)
parseGrid :: [String] -> Grid
parseGrid = map parseRow
where
parseCell :: Char -> Cell
parseCell '@' = Paper
parseCell '.' = Empty
parseCell _ = error "Invalid!"
parseRow :: String -> Row
parseRow = map parseCell
paperCount :: Grid -> Int
paperCount = sum . map (length . filter (== Paper))
validPosition :: Grid -> Coords -> Bool
validPosition grid (row, col) = row >= 0 && row < length grid && col >= 0 && col < length (head grid)
isPaper :: Grid -> Coords -> Bool
isPaper grid (row, col)
| validPosition grid (row, col) = grid !! row !! col == Paper
| otherwise = False
getSurrounding :: Coords -> [Coords]
getSurrounding (row, col) =
[ (row + i, col + j)
| i <- [-1 .. 1],
j <- [-1 .. 1],
i /= 0 || j /= 0
]
paperSurrounding :: Grid -> Coords -> Int
paperSurrounding grid (row, col) = (length . filter id . map (isPaper grid)) (getSurrounding (row, col))
eligibleForPickup :: Grid -> Coords -> Bool
eligibleForPickup grid (row, col) = isPaper grid (row, col) && paperSurrounding grid (row, col) < 4
countEligibleRolls :: Grid -> Int
countEligibleRolls grid =
(length . filter id)
[ eligibleForPickup grid (row, col)
| row <- [0 .. length grid - 1],
col <- [0 .. length (head grid) - 1]
]
part1 :: IO ()
part1 =
getContents
>>= print . countEligibleRolls . parseGrid . lines
removeEligibleRolls :: Grid -> Grid
removeEligibleRolls grid =
[ [ if eligibleForPickup grid (row, col) then Empty else grid !! row !! col
| col <- [0 .. length (head grid) - 1]
]
| row <- [0 .. length grid - 1]
]
loopRemoveRolls :: Grid -> Grid
loopRemoveRolls grid
| grid == removeEligibleRolls grid = grid
| otherwise = loopRemoveRolls (removeEligibleRolls grid)
totalRollsEligible :: Grid -> Int
totalRollsEligible grid = paperCount grid - paperCount (loopRemoveRolls grid)
part2 :: IO ()
part2 =
getContents
>>= print . totalRollsEligible . parseGrid . lines
main :: IO ()
main = part2