AoC2018/Day3/Part2.hs

50 lines
1.8 KiB
Haskell
Executable File

#! /usr/bin/env stack
-- stack --resolver lts-12.20 --install-ghc script
module Main where
import Data.Function (on)
import qualified Data.List as L
import qualified Text.Parsec as P
import qualified Text.Parsec.Language as PL
import qualified Text.Parsec.Token as PT
main :: IO ()
main = interact $ (show .) $ (. map parseLine . lines) $ \claims ->
let noOverlaps c = not $ L.any ((overlaps `on` claimArea) c) (filter (/= c) claims)
in claimID $ head $ filter noOverlaps claims
overlaps :: Rect -> Rect -> Bool
overlaps (Rect c1 r1 w1 h1) (Rect c2 r2 w2 h2) = rowOverlaps && colOverlaps
where
check (l1, u1) (l2, u2) = sorted [l1, l2, u1]
|| sorted [l1, u2, u1]
|| sorted [l2, l1, u2]
|| sorted [l2, u1, u2]
rowOverlaps = check (r1, r1+h1-1) (r2, r2+h2-1)
colOverlaps = check (c1, c1+w1-1) (c2, c2+w2-1)
sorted :: Ord a => [a] -> Bool
sorted xs = L.all (uncurry (<=)) (zip xs (drop 1 xs))
data Rect = Rect { rectCol :: Int
, rectRow :: Int
, rectWidth :: Int
, rectHeight :: Int
} deriving (Eq, Show)
data Claim = Claim { claimID :: Int
, claimArea :: Rect
} deriving (Eq, Show)
parseLine :: String -> Claim
parseLine = either (error . show) id . P.runParser p () ""
where
decimal = fromInteger <$> PT.decimal PL.haskell
whiteSpace = PT.whiteSpace PL.haskell
p = Claim <$ P.char '#' <*> decimal
<* whiteSpace <* P.char '@' <* whiteSpace
<*> (Rect <$> decimal <* P.char ',' <*> decimal
<* P.char ':' <* whiteSpace
<*> decimal <* P.char 'x' <*> decimal)