aoc-2021/day5/second.hs

49 lines
1.1 KiB
Haskell

{-# LANGUAGE RecordWildCards #-}
import Data.List (group, sort)
wordsWhen :: (a -> Bool) -> [a] -> [[a]]
wordsWhen pred s =
case dropWhile pred s of
[] -> []
s' -> w : wordsWhen pred s''
where (w, s'') = break pred s'
type Point = (Int, Int)
data Line = Line
{ x1 :: Int
, y1 :: Int
, x2 :: Int
, y2 :: Int
} deriving (Show, Eq)
toLine :: [Int] -> Line
toLine (x1:y1:x2:y2:[]) = Line x1 y1 x2 y2
parseLines :: String -> [Line]
parseLines = map toLine
. map (map (read :: String -> Int))
. map (filter (/="->"))
. map (wordsWhen (\c -> c == ',' || c == ' '))
. lines
pointsOfLine :: Line -> [Point]
pointsOfLine Line{..}
| x1 == x2 = [(x1, y) | y <- [min y1 y2 .. max y1 y2]]
| y1 == y2 = [(x, y1) | x <- [min x1 x2 .. max x1 x2]]
| otherwise = [(x1 + xoff * dx, y1 + yoff * dy)
| (xoff, yoff) <- zip [0..abs $ x1 - x2] [0..abs $ y1 - y2]]
where dx = if x1 < x2 then 1 else -1
dy = if y1 < y2 then 1 else -1
solution :: [Line] -> Int
solution = length
. filter (>1)
. map length
. group
. sort
. concat
. map pointsOfLine
main = interact $ show . solution . parseLines