git.haldean.org aoc-2018 / eb676ad
day 3 done! Haldean Brown 2 years ago
1 changed file(s) with 29 addition(s) and 12 deletion(s). Raw diff Collapse all Expand all
0 import Data.List
0 import qualified Data.List as L
1 import qualified Data.Maybe as M
12 import qualified Data.Set as S
23 import Text.Parsec
34 import Text.Parsec.String
56 data Rect = Rect Int Int Int Int deriving Show
67
78 contains :: Rect -> Int -> Int -> Bool
8 contains (Rect rx ry rw rh) x y = rx <= x && x <= rx + rw && ry <= y && y <= ry + rh
9 contains (Rect rx ry rw rh) x y = rx <= x && x < rx + rw && ry <= y && y < ry + rh
910
10 bounding :: Rect -> Rect -> Rect
11 bounding (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) =
11 union :: Rect -> Rect -> Rect
12 union (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) =
1213 let xmin = min x1 x2
1314 xmax = max (x1 + w1) (x2 + w2)
1415 ymin = min y1 y2
1516 ymax = max (y1 + h1) (y2 + h2)
1617 in Rect xmin ymin (xmax - xmin) (ymax - ymin)
18
19 intersection :: Rect -> Rect -> Maybe Rect
20 intersection (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) =
21 let xmin = max x1 x2
22 xmax = min (x1 + w1) (x2 + w2)
23 ymin = max y1 y2
24 ymax = min (y1 + h1) (y2 + h2)
25 in if xmin < xmax && ymin < ymax
26 then Just $ Rect xmin ymin (xmax - xmin) (ymax - ymin)
27 else Nothing
1728
1829 data Claim = Claim Int Rect deriving Show
1930 claimRect :: Claim -> Rect
4051 readClaims = parse (sepEndBy parseClaim (char '\n')) "input.txt"
4152
4253 findBounds :: [Claim] -> Rect
43 findBounds = (foldl1 bounding) . (map (\(Claim _ r) -> r))
54 findBounds = (foldl1 union) . (map (\(Claim _ r) -> r))
4455
4556 allPointsInside :: Rect -> [(Int, Int)]
4657 allPointsInside (Rect x y w h) =
4960 in concat $ map (\xx -> zip (repeat xx) ys) xs
5061
5162 allRelevantPoints :: [Claim] -> [(Int, Int)]
52 allRelevantPoints cs =
53 S.toList $ S.unions $ map (S.fromList . allPointsInside . claimRect) cs
63 allRelevantPoints = S.toList . S.unions . map (S.fromList . allPointsInside . claimRect)
5464
55 getCounts :: [(Int, Int)] -> [Claim] -> [Int]
56 getCounts ps cs =
57 map (\(x, y) -> length $ filter (\(Claim _ cr) -> contains cr x y) cs) ps
65 getCounts :: [Claim] -> [Int]
66 getCounts cs =
67 map (\(x, y) -> length $ filter (\(Claim _ cr) -> contains cr x y) cs) $ allRelevantPoints cs
5868
5969 getMultiCounted :: [Int] -> Int
6070 getMultiCounted = length . (filter ((<) 1))
6171
6272 runMultiCounted :: [Claim] -> Int
63 runMultiCounted cs = getMultiCounted $ getCounts (allRelevantPoints cs) cs
73 runMultiCounted = getMultiCounted . getCounts
74
75 hasNoOverlaps :: [Claim] -> Claim -> Bool
76 hasNoOverlaps cs c = all (ok c) cs where
77 ok (Claim id1 r1) (Claim id2 r2) =
78 if id1 == id2 then True else M.isNothing $ intersection r1 r2
6479
6580 main :: IO ()
6681 main = do
6782 claims <- fmap readClaims (readFile "input.txt")
6883 case claims of
69 Right cs -> print $ runMultiCounted cs
84 Right cs -> do
85 print $ runMultiCounted cs
86 print $ filter (hasNoOverlaps cs) cs
7087 Left err -> print err