78 lines
2 KiB
Haskell
78 lines
2 KiB
Haskell
|
import Data.Char (digitToInt)
|
||
|
|
import Data.List (nub, sortBy)
|
||
|
|
import Data.Ord
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
input <- getContents
|
||
|
|
let
|
||
|
|
heightMap = parseHeights input
|
||
|
|
(putStrLn . show . solution1) heightMap
|
||
|
|
(putStrLn . show . solution2) heightMap
|
||
|
|
|
||
|
|
solution1 :: [[Int]] -> Int
|
||
|
|
solution1 heights = sum (map (\p -> heights !!! p + 1) (lowPoints heights))
|
||
|
|
|
||
|
|
solution2 :: [[Int]] -> Int
|
||
|
|
solution2 heights = product (take 3 (sortBy (comparing Down) (map length basins)))
|
||
|
|
where
|
||
|
|
basins :: [[(Int, Int)]]
|
||
|
|
basins = map (flip basin heights) (lowPoints heights)
|
||
|
|
|
||
|
|
basin :: (Int, Int) -> [[Int]] -> [(Int, Int)]
|
||
|
|
basin point heights
|
||
|
|
| null next = []
|
||
|
|
| otherwise = nub (point:(next)++flatmap (flip basin heights) next)
|
||
|
|
where
|
||
|
|
next = filter partOfBasin (adjacent point heights)
|
||
|
|
partOfBasin x =
|
||
|
|
let
|
||
|
|
xHeight = heights !!! x
|
||
|
|
in
|
||
|
|
xHeight > heights !!! point && xHeight /= 9
|
||
|
|
|
||
|
|
flatmap :: (t -> [a]) -> [t] -> [a]
|
||
|
|
flatmap _ [] = []
|
||
|
|
flatmap f (x:xs) = f x ++ flatmap f xs
|
||
|
|
|
||
|
|
lowPoints :: [[Int]] -> [(Int, Int)]
|
||
|
|
lowPoints heights = filter (flip isLowPoint heights) (indices heights)
|
||
|
|
where
|
||
|
|
indices :: [[Int]] -> [(Int, Int)]
|
||
|
|
indices m = [(x, y) |
|
||
|
|
x <- [0..length(m)-1],
|
||
|
|
y <- [0..length(m !! 0)-1]]
|
||
|
|
|
||
|
|
isLowPoint :: (Int, Int) -> [[Int]] -> Bool
|
||
|
|
isLowPoint point m = all (> (m !!! point)) (map ((!!!) m) (adjacent point m))
|
||
|
|
|
||
|
|
(!!!) :: [[Int]] -> (Int, Int) -> Int
|
||
|
|
(!!!) m index = m !! (fst index) !! (snd index)
|
||
|
|
|
||
|
|
adjacent :: (Int, Int) -> [[Int]] -> [(Int, Int)]
|
||
|
|
adjacent (x, y) m =
|
||
|
|
[(i+x, j+y) |
|
||
|
|
i <- [-1..1],
|
||
|
|
j <- [-1..1],
|
||
|
|
abs i /= abs j,
|
||
|
|
i+x >= 0 && i+x < length(m),
|
||
|
|
j+y >= 0 && j+y < length(m !! 0)]
|
||
|
|
|
||
|
|
parseHeights :: String -> [[Int]]
|
||
|
|
parseHeights = map (map digitToInt) . lines
|
||
|
|
|
||
|
|
-- Tests
|
||
|
|
|
||
|
|
testInput = unlines [
|
||
|
|
"2199943210",
|
||
|
|
"3987894921",
|
||
|
|
"9856789892",
|
||
|
|
"8767896789",
|
||
|
|
"9899965678"
|
||
|
|
]
|
||
|
|
|
||
|
|
testInputParsed = parseHeights testInput
|
||
|
|
|
||
|
|
test1 = solution1 testInputParsed -- 15
|
||
|
|
test2 = solution2 testInputParsed -- 1134
|