MarsMap.hs

{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}
import Data.Monoid
import Data.Foldable
import Control.Monad

type Point = (Int, Int)
type Patch = (Point, Point)

data Quad a = Quad a a a a deriving (Eq, Ord, Read, Show, Functor, Foldable)
data FillStatus = Empty | Partial | Full deriving (Eq, Ord, Read, Show)
data QuadTree = Atom Point Bool
              | QuadTree Patch (Quad QuadTree) FillStatus
              deriving (Eq, Ord, Read, Show)

containedIn :: Point -> Patch -> Bool
containedIn (x, y) ((x1, y1), (x2, y2)) = x >= x1 && x < x2 && y >= y1 && y < y2

envelopedBy :: Patch -> Patch -> Bool
envelopedBy (p1, p2) patch = p1 `containedIn` patch && p2 `containedIn` patch

intersects :: Patch -> Patch -> Bool
intersects ((x1, y1), (x2, y2)) ((x3, y3), (x4, y4)) =
    not (x2 < x3 || x1 >= x4 || y2 < y3 || y1 >= y4)

patchArea :: Patch -> Int
patchArea ((x1, y1), (x2, y2)) = (x2 - x1) * (y2 - y1)

paintMap :: Patch -> QuadTree -> QuadTree
paintMap patch (Atom point f) = Atom point (f || point `containedIn` patch)
paintMap _ t@(QuadTree _ _ Full) = t
paintMap patch q@(QuadTree p qs _)
    | p `envelopedBy` patch = QuadTree p qs Full
    | p `intersects` patch = QuadTree p (fmap (paintMap patch) qs) Partial
    | otherwise = q

quadTreeArea :: QuadTree -> Int
quadTreeArea (Atom _ f) = if f then 1 else 0
quadTreeArea (QuadTree p _ Full) = patchArea p
quadTreeArea (QuadTree _ _ Empty) = 0
quadTreeArea (QuadTree _ qs Partial) = getSum (foldMap (Sum . quadTreeArea) qs)

makeTree :: Patch -> QuadTree
makeTree p@((x1, y1), (x2, y2))
    | patchArea p == 1 = Atom (x1, y1) False
    | otherwise =
        QuadTree p (Quad (makeTree ((x1, y1), (x1 + halfSize, y1 + halfSize)))
                         (makeTree ((x1 + halfSize, y1), (x2, y1 + halfSize)))
                         (makeTree ((x1, y1 + halfSize), (x1 + halfSize, y2)))
                         (makeTree ((x1 + halfSize, y1 + halfSize), (x2, y2))))
                 Empty
    where halfSize = (x2 - x1) `div` 2

initialTree :: QuadTree
initialTree = makeTree ((0, 0), (32768, 32768))

main :: IO ()
main = do
    n <- readLn
    ps <- replicateM n $ do
        [x1, y1, x2, y2] <- fmap (fmap read . words) getLine
        return ((x1, y1), (x2, y2))
    print (quadTreeArea (foldr' paintMap initialTree ps))