Renames rect to claim

3/3.hs

@@ -10,64 +10,68 @@ import Data.List (maximumBy, foldl', sort, sortOn)
 import Data.Ord (comparing)
 import Text.Parsec hiding (Empty)
 
-data Rect = Rect { rectID     :: Int
-                 , rectLeft   :: Int
-                 , rectTop    :: Int
-                 , rectWidth  :: Int
-                 , rectHeight :: Int
-                 }
-
-instance Eq Rect where
-  (==) = (==) `on` rectID
-
-instance Ord Rect where
-  compare = compare `on` rectID
-
-instance Show Rect where
-  show (Rect id l t w h) = "#" ++ show id ++ " " ++ show l ++ "," ++ show t ++ ":" ++ show (l+w) ++ "," ++ show (t+h)
-
-inputP :: Parsec String () Rect
-inputP =
-  (\id (l,t) (w,h) -> Rect id l t w h)
+data Claim = Claim { claimID     :: Int
+                   , claimLeft   :: Int
+                   , claimTop    :: Int
+                   , claimWidth  :: Int
+                   , claimHeight :: Int
+                   }
+
+instance Eq Claim where
+  (==) = (==) `on` claimID
+
+instance Ord Claim where
+  compare = compare `on` claimID
+
+instance Show Claim where
+  show (Claim id l t w h) =
+    "<#" ++ show id ++ " "
+    ++ "(" ++ show l ++ "," ++ show t ++ ")-"
+    ++ "(" ++ show (l+w) ++ "," ++ show (t+h) ++ ")>"
+
+claimParser :: Parsec String () Claim
+claimParser =
+  (\id (l,t) (w,h) -> Claim id l t w h)
   <$> (idP <* spaces <* char '@' <* spaces)
   <*> (posP <* char ':' <* spaces)
   <*> dimP
   where
     intP = read <$> some digit
-    idP = char '#' *> intP
+    idP  = char '#' *> intP
     posP = (,) <$> (intP <* char ',') <*> intP
     dimP = (,) <$> (intP <* char 'x') <*> intP
 
-readInput :: [String] -> [Rect]
-readInput ls = case traverse (parse inputP "") ls of
-  Left e -> error (show e)
+readInput :: String -> [Claim]
+readInput input = case traverse (parse claimParser "") $ lines input of
+  Left e   -> error (show e)
   Right rs -> rs
 
-sheetSize :: [Rect] -> (Int, Int)
-sheetSize rects =
-  ( calcBound (\(Rect _ l _ w _) -> l + w)
-  , calcBound (\(Rect _ _ t _ h) -> t + h))
+sheetSize :: [Claim] -> (Int, Int)
+sheetSize claims = (calcBound claimRight, calcBound claimBottom)
   where
-    calcBound f = f (maximumBy (comparing f) rects)
+    claimRight  (Claim _ l _ w _) = l + w
+    claimBottom (Claim _ _ t _ h) = t + h
+    calcBound f = f (maximumBy (comparing f) claims)
 
-isOverlapCell :: [Rect] -> (Int, Int) -> Bool
-isOverlapCell rects cell =
-  (> 1) . length . take 2 . filter (cellInRect cell) $ rects
+isOverlapCell :: [Claim] -> (Int, Int) -> Bool
+isOverlapCell claims cell =
+  (> 1) . length . filter (cellInClaim cell) $ claims
   where
-    cellInRect (x, y) (Rect _ l t w h) =
+    cellInClaim (x, y) (Claim _ l t w h) =
       l <= x && (l+w) >= (x+1) && t <= y && (t+h) >= (y+1)
 
 ---------------- Brute force ----------------
 
-bruteForceSolve :: [Rect] -> (Int, [Rect])
-bruteForceSolve rects =
-  let (w, h) = sheetSize rects
-      cells = [(i, j) | i <- [0..w-1], j <- [0..h-1]]
-      overlapArea = length . filter (isOverlapCell rects) $ cells
-      noOverlapRects = filter (\r -> not $ any (\r1 -> r1 /= r && r1 `overlaps` r) rects) rects
-  in (overlapArea, noOverlapRects)
+bruteForceSolve :: [Claim] -> (Int, [Claim])
+bruteForceSolve claims =
+  let (width, height) = sheetSize claims
+      cells           = [(i, j) | i <- [0..width-1], j <- [0..height-1]]
+      overlapArea     = length . filter (isOverlapCell claims) $ cells
+      noOverlapClaims =
+        filter (\c -> not $ any (\c' -> c' /= c && c' `overlaps` c) claims) claims
+  in (overlapArea, noOverlapClaims)
   where
-    (Rect _ l1 t1 w1 h1) `overlaps` (Rect _ l2 t2 w2 h2) =
+    (Claim _ l1 t1 w1 h1) `overlaps` (Claim _ l2 t2 w2 h2) =
       l1 < (l2+w2) && (l1+w1) > l2 && t1 < (t2+h2) && (t1+h1) > t2
 
 ---------------- Interval tree ----------------
@@ -132,44 +136,44 @@ intersectingIntervals =
 fromList :: (Ord a, Ord b, Bits a, Num a) => a -> a -> [(Interval a, b)] -> IntervalTree a b
 fromList start end = foldl' (flip insert) (Empty start end)
 
-toInterval :: (Rect -> Int) -> (Rect -> Int) -> Rect -> Interval Int
-toInterval pos dim rect = Interval (pos rect, pos rect + dim rect)
+toInterval :: (Claim -> Int) -> (Claim -> Int) -> Claim -> Interval Int
+toInterval pos dim claim = Interval (pos claim, pos claim + dim claim)
 
-rectIntervalTrees :: [Rect] -> (IntervalTree Int Rect, IntervalTree Int Rect)
-rectIntervalTrees rects =
-  let (w, h) = sheetSize rects
-  in ( fromList 0 w . map (\r -> (toInterval rectLeft rectWidth r, r)) $ rects
-     , fromList 0 h . map (\r -> (toInterval rectTop rectHeight r, r)) $ rects
+claimIntervalTrees :: [Claim] -> (IntervalTree Int Claim, IntervalTree Int Claim)
+claimIntervalTrees claims =
+  let (w, h) = sheetSize claims
+  in ( fromList 0 w . map (\c -> (toInterval claimLeft claimWidth c, c)) $ claims
+     , fromList 0 h . map (\c -> (toInterval claimTop claimHeight c, c)) $ claims
      )
 
 toTree :: (Show a, Show b) => IntervalTree a b -> T.Tree String
 toTree (Empty start end) = T.Node (show ("E", start, end)) []
 toTree (Node l c is _ r) = T.Node (show ("N", c, is)) [toTree l, toTree r]
 
-intervalTreeSolve :: [Rect] -> (Int, [Rect])
-intervalTreeSolve rects =
-  let (w, h) = sheetSize rects
+intervalTreeSolve :: [Claim] -> (Int, [Claim])
+intervalTreeSolve claims =
+  let (w, h) = sheetSize claims
       cells = [(i, j) | i <- [0..w-1], j <- [0..h-1]]
-      (xTree, yTree) = rectIntervalTrees rects
-      overlapArea = length . filter (\c -> isOverlapCell (cellRects xTree yTree c) c) $ cells
-      noOverlapRects = filter ((== 1) . Set.size . overlappingRects xTree yTree) rects
-  in (overlapArea, noOverlapRects)
+      (xTree, yTree) = claimIntervalTrees claims
+      overlapArea = length . filter (\c -> isOverlapCell (cellClaims xTree yTree c) c) $ cells
+      noOverlapClaims = filter ((== 1) . Set.size . overlappingClaims xTree yTree) claims
+  in (overlapArea, noOverlapClaims)
   where
-    cellRects xTree yTree (x,y) =
+    cellClaims xTree yTree (x,y) =
       nub . map snd
       $ includingIntervals (Interval (x, x+1)) xTree ++ includingIntervals (Interval (y, y+1)) yTree
 
     nub = Set.toList . Set.fromList
 
-    rectIntervals tree pos dim rect =
-      Set.fromList . map snd . intersectingIntervals (toInterval pos dim rect) $ tree
+    claimIntervals tree pos dim claim =
+      Set.fromList . map snd . intersectingIntervals (toInterval pos dim claim) $ tree
 
-    overlappingRects xTree yTree rect =
-      rectIntervals xTree rectLeft rectWidth rect `Set.intersection` rectIntervals yTree rectTop rectHeight rect
+    overlappingClaims xTree yTree claim =
+      claimIntervals xTree claimLeft claimWidth claim `Set.intersection` claimIntervals yTree claimTop claimHeight claim
 
 main :: IO ()
 main = do
-  rects <- readInput . lines <$> getContents
-  let (overlapArea, noOverlapRects) = intervalTreeSolve rects
+  claims <- readInput <$> getContents
+  let (overlapArea, noOverlapClaims) = intervalTreeSolve claims
   putStrLn $ "Overlap Area = " ++ show overlapArea
-  putStrLn $ "No overlap rects = " ++ show noOverlapRects
+  putStrLn $ "No overlap claims = " ++ show noOverlapClaims