Browse Source

Renames rect to claim

Abhinav Sarkar 2 years ago
parent
commit
1095c18980
1 changed files with 66 additions and 62 deletions
  1. 66
    62
      3/3.hs

+ 66
- 62
3/3.hs View File

@@ -10,64 +10,68 @@ import Data.List (maximumBy, foldl', sort, sortOn)
10 10
 import Data.Ord (comparing)
11 11
 import Text.Parsec hiding (Empty)
12 12
 
13
-data Rect = Rect { rectID     :: Int
14
-                 , rectLeft   :: Int
15
-                 , rectTop    :: Int
16
-                 , rectWidth  :: Int
17
-                 , rectHeight :: Int
18
-                 }
19
-
20
-instance Eq Rect where
21
-  (==) = (==) `on` rectID
22
-
23
-instance Ord Rect where
24
-  compare = compare `on` rectID
25
-
26
-instance Show Rect where
27
-  show (Rect id l t w h) = "#" ++ show id ++ " " ++ show l ++ "," ++ show t ++ ":" ++ show (l+w) ++ "," ++ show (t+h)
28
-
29
-inputP :: Parsec String () Rect
30
-inputP =
31
-  (\id (l,t) (w,h) -> Rect id l t w h)
13
+data Claim = Claim { claimID     :: Int
14
+                   , claimLeft   :: Int
15
+                   , claimTop    :: Int
16
+                   , claimWidth  :: Int
17
+                   , claimHeight :: Int
18
+                   }
19
+
20
+instance Eq Claim where
21
+  (==) = (==) `on` claimID
22
+
23
+instance Ord Claim where
24
+  compare = compare `on` claimID
25
+
26
+instance Show Claim where
27
+  show (Claim id l t w h) =
28
+    "<#" ++ show id ++ " "
29
+    ++ "(" ++ show l ++ "," ++ show t ++ ")-"
30
+    ++ "(" ++ show (l+w) ++ "," ++ show (t+h) ++ ")>"
31
+
32
+claimParser :: Parsec String () Claim
33
+claimParser =
34
+  (\id (l,t) (w,h) -> Claim id l t w h)
32 35
   <$> (idP <* spaces <* char '@' <* spaces)
33 36
   <*> (posP <* char ':' <* spaces)
34 37
   <*> dimP
35 38
   where
36 39
     intP = read <$> some digit
37
-    idP = char '#' *> intP
40
+    idP  = char '#' *> intP
38 41
     posP = (,) <$> (intP <* char ',') <*> intP
39 42
     dimP = (,) <$> (intP <* char 'x') <*> intP
40 43
 
41
-readInput :: [String] -> [Rect]
42
-readInput ls = case traverse (parse inputP "") ls of
43
-  Left e -> error (show e)
44
+readInput :: String -> [Claim]
45
+readInput input = case traverse (parse claimParser "") $ lines input of
46
+  Left e   -> error (show e)
44 47
   Right rs -> rs
45 48
 
46
-sheetSize :: [Rect] -> (Int, Int)
47
-sheetSize rects =
48
-  ( calcBound (\(Rect _ l _ w _) -> l + w)
49
-  , calcBound (\(Rect _ _ t _ h) -> t + h))
49
+sheetSize :: [Claim] -> (Int, Int)
50
+sheetSize claims = (calcBound claimRight, calcBound claimBottom)
50 51
   where
51
-    calcBound f = f (maximumBy (comparing f) rects)
52
+    claimRight  (Claim _ l _ w _) = l + w
53
+    claimBottom (Claim _ _ t _ h) = t + h
54
+    calcBound f = f (maximumBy (comparing f) claims)
52 55
 
53
-isOverlapCell :: [Rect] -> (Int, Int) -> Bool
54
-isOverlapCell rects cell =
55
-  (> 1) . length . take 2 . filter (cellInRect cell) $ rects
56
+isOverlapCell :: [Claim] -> (Int, Int) -> Bool
57
+isOverlapCell claims cell =
58
+  (> 1) . length . filter (cellInClaim cell) $ claims
56 59
   where
57
-    cellInRect (x, y) (Rect _ l t w h) =
60
+    cellInClaim (x, y) (Claim _ l t w h) =
58 61
       l <= x && (l+w) >= (x+1) && t <= y && (t+h) >= (y+1)
59 62
 
60 63
 ---------------- Brute force ----------------
61 64
 
62
-bruteForceSolve :: [Rect] -> (Int, [Rect])
63
-bruteForceSolve rects =
64
-  let (w, h) = sheetSize rects
65
-      cells = [(i, j) | i <- [0..w-1], j <- [0..h-1]]
66
-      overlapArea = length . filter (isOverlapCell rects) $ cells
67
-      noOverlapRects = filter (\r -> not $ any (\r1 -> r1 /= r && r1 `overlaps` r) rects) rects
68
-  in (overlapArea, noOverlapRects)
65
+bruteForceSolve :: [Claim] -> (Int, [Claim])
66
+bruteForceSolve claims =
67
+  let (width, height) = sheetSize claims
68
+      cells           = [(i, j) | i <- [0..width-1], j <- [0..height-1]]
69
+      overlapArea     = length . filter (isOverlapCell claims) $ cells
70
+      noOverlapClaims =
71
+        filter (\c -> not $ any (\c' -> c' /= c && c' `overlaps` c) claims) claims
72
+  in (overlapArea, noOverlapClaims)
69 73
   where
70
-    (Rect _ l1 t1 w1 h1) `overlaps` (Rect _ l2 t2 w2 h2) =
74
+    (Claim _ l1 t1 w1 h1) `overlaps` (Claim _ l2 t2 w2 h2) =
71 75
       l1 < (l2+w2) && (l1+w1) > l2 && t1 < (t2+h2) && (t1+h1) > t2
72 76
 
73 77
 ---------------- Interval tree ----------------
@@ -132,44 +136,44 @@ intersectingIntervals =
132 136
 fromList :: (Ord a, Ord b, Bits a, Num a) => a -> a -> [(Interval a, b)] -> IntervalTree a b
133 137
 fromList start end = foldl' (flip insert) (Empty start end)
134 138
 
135
-toInterval :: (Rect -> Int) -> (Rect -> Int) -> Rect -> Interval Int
136
-toInterval pos dim rect = Interval (pos rect, pos rect + dim rect)
139
+toInterval :: (Claim -> Int) -> (Claim -> Int) -> Claim -> Interval Int
140
+toInterval pos dim claim = Interval (pos claim, pos claim + dim claim)
137 141
 
138
-rectIntervalTrees :: [Rect] -> (IntervalTree Int Rect, IntervalTree Int Rect)
139
-rectIntervalTrees rects =
140
-  let (w, h) = sheetSize rects
141
-  in ( fromList 0 w . map (\r -> (toInterval rectLeft rectWidth r, r)) $ rects
142
-     , fromList 0 h . map (\r -> (toInterval rectTop rectHeight r, r)) $ rects
142
+claimIntervalTrees :: [Claim] -> (IntervalTree Int Claim, IntervalTree Int Claim)
143
+claimIntervalTrees claims =
144
+  let (w, h) = sheetSize claims
145
+  in ( fromList 0 w . map (\c -> (toInterval claimLeft claimWidth c, c)) $ claims
146
+     , fromList 0 h . map (\c -> (toInterval claimTop claimHeight c, c)) $ claims
143 147
      )
144 148
 
145 149
 toTree :: (Show a, Show b) => IntervalTree a b -> T.Tree String
146 150
 toTree (Empty start end) = T.Node (show ("E", start, end)) []
147 151
 toTree (Node l c is _ r) = T.Node (show ("N", c, is)) [toTree l, toTree r]
148 152
 
149
-intervalTreeSolve :: [Rect] -> (Int, [Rect])
150
-intervalTreeSolve rects =
151
-  let (w, h) = sheetSize rects
153
+intervalTreeSolve :: [Claim] -> (Int, [Claim])
154
+intervalTreeSolve claims =
155
+  let (w, h) = sheetSize claims
152 156
       cells = [(i, j) | i <- [0..w-1], j <- [0..h-1]]
153
-      (xTree, yTree) = rectIntervalTrees rects
154
-      overlapArea = length . filter (\c -> isOverlapCell (cellRects xTree yTree c) c) $ cells
155
-      noOverlapRects = filter ((== 1) . Set.size . overlappingRects xTree yTree) rects
156
-  in (overlapArea, noOverlapRects)
157
+      (xTree, yTree) = claimIntervalTrees claims
158
+      overlapArea = length . filter (\c -> isOverlapCell (cellClaims xTree yTree c) c) $ cells
159
+      noOverlapClaims = filter ((== 1) . Set.size . overlappingClaims xTree yTree) claims
160
+  in (overlapArea, noOverlapClaims)
157 161
   where
158
-    cellRects xTree yTree (x,y) =
162
+    cellClaims xTree yTree (x,y) =
159 163
       nub . map snd
160 164
       $ includingIntervals (Interval (x, x+1)) xTree ++ includingIntervals (Interval (y, y+1)) yTree
161 165
 
162 166
     nub = Set.toList . Set.fromList
163 167
 
164
-    rectIntervals tree pos dim rect =
165
-      Set.fromList . map snd . intersectingIntervals (toInterval pos dim rect) $ tree
168
+    claimIntervals tree pos dim claim =
169
+      Set.fromList . map snd . intersectingIntervals (toInterval pos dim claim) $ tree
166 170
 
167
-    overlappingRects xTree yTree rect =
168
-      rectIntervals xTree rectLeft rectWidth rect `Set.intersection` rectIntervals yTree rectTop rectHeight rect
171
+    overlappingClaims xTree yTree claim =
172
+      claimIntervals xTree claimLeft claimWidth claim `Set.intersection` claimIntervals yTree claimTop claimHeight claim
169 173
 
170 174
 main :: IO ()
171 175
 main = do
172
-  rects <- readInput . lines <$> getContents
173
-  let (overlapArea, noOverlapRects) = intervalTreeSolve rects
176
+  claims <- readInput <$> getContents
177
+  let (overlapArea, noOverlapClaims) = intervalTreeSolve claims
174 178
   putStrLn $ "Overlap Area = " ++ show overlapArea
175
-  putStrLn $ "No overlap rects = " ++ show noOverlapRects
179
+  putStrLn $ "No overlap claims = " ++ show noOverlapClaims

Loading…
Cancel
Save