import qualified Data.List as L
import qualified Data.Maybe as M
import qualified Data.Set as S
import Text.Parsec
import Text.Parsec.String
data Rect = Rect Int Int Int Int deriving Show
contains :: Rect -> Int -> Int -> Bool
contains (Rect rx ry rw rh) x y = rx <= x && x < rx + rw && ry <= y && y < ry + rh
union :: Rect -> Rect -> Rect
union (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) =
let xmin = min x1 x2
xmax = max (x1 + w1) (x2 + w2)
ymin = min y1 y2
ymax = max (y1 + h1) (y2 + h2)
in Rect xmin ymin (xmax - xmin) (ymax - ymin)
intersection :: Rect -> Rect -> Maybe Rect
intersection (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) =
let xmin = max x1 x2
xmax = min (x1 + w1) (x2 + w2)
ymin = max y1 y2
ymax = min (y1 + h1) (y2 + h2)
in if xmin < xmax && ymin < ymax
then Just $ Rect xmin ymin (xmax - xmin) (ymax - ymin)
else Nothing
data Claim = Claim Int Rect deriving Show
claimRect :: Claim -> Rect
claimRect (Claim _ rect) = rect
parseInt :: Parser Int
parseInt = fmap (read :: String -> Int) $ many1 digit
parseClaim :: Parser Claim
parseClaim = do
_ <- char '#'
rid <- parseInt
_ <- many $ oneOf " @"
rx <- parseInt
_ <- char ','
ry <- parseInt
_ <- many $ oneOf " :"
rw <- parseInt
_ <- char 'x'
rh <- parseInt
return $ Claim rid (Rect rx ry rw rh)
readClaims :: String -> Either ParseError [Claim]
readClaims = parse (sepEndBy parseClaim (char '\n')) "input.txt"
findBounds :: [Claim] -> Rect
findBounds = (foldl1 union) . (map (\(Claim _ r) -> r))
allPointsInside :: Rect -> [(Int, Int)]
allPointsInside (Rect x y w h) =
let xs = enumFromTo x (x + w - 1)
ys = enumFromTo y (y + h - 1)
in concat $ map (\xx -> zip (repeat xx) ys) xs
allRelevantPoints :: [Claim] -> [(Int, Int)]
allRelevantPoints = S.toList . S.unions . map (S.fromList . allPointsInside . claimRect)
getCounts :: [Claim] -> [Int]
getCounts cs =
map (\(x, y) -> length $ filter (\(Claim _ cr) -> contains cr x y) cs) $ allRelevantPoints cs
getMultiCounted :: [Int] -> Int
getMultiCounted = length . (filter ((<) 1))
runMultiCounted :: [Claim] -> Int
runMultiCounted = getMultiCounted . getCounts
hasNoOverlaps :: [Claim] -> Claim -> Bool
hasNoOverlaps cs c = all (ok c) cs where
ok (Claim id1 r1) (Claim id2 r2) =
if id1 == id2 then True else M.isNothing $ intersection r1 r2
main :: IO ()
main = do
claims <- fmap readClaims (readFile "input.txt")
case claims of
Right cs -> do
print $ runMultiCounted cs
print $ filter (hasNoOverlaps cs) cs
Left err -> print err