day 3 done!
Haldean Brown
3 years ago
0 | import Data.List | |
0 | import qualified Data.List as L | |
1 | import qualified Data.Maybe as M | |
1 | 2 | import qualified Data.Set as S |
2 | 3 | import Text.Parsec |
3 | 4 | import Text.Parsec.String |
5 | 6 | data Rect = Rect Int Int Int Int deriving Show |
6 | 7 | |
7 | 8 | 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 | |
9 | 10 | |
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) = | |
12 | 13 | let xmin = min x1 x2 |
13 | 14 | xmax = max (x1 + w1) (x2 + w2) |
14 | 15 | ymin = min y1 y2 |
15 | 16 | ymax = max (y1 + h1) (y2 + h2) |
16 | 17 | 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 | |
17 | 28 | |
18 | 29 | data Claim = Claim Int Rect deriving Show |
19 | 30 | claimRect :: Claim -> Rect |
40 | 51 | readClaims = parse (sepEndBy parseClaim (char '\n')) "input.txt" |
41 | 52 | |
42 | 53 | findBounds :: [Claim] -> Rect |
43 | findBounds = (foldl1 bounding) . (map (\(Claim _ r) -> r)) | |
54 | findBounds = (foldl1 union) . (map (\(Claim _ r) -> r)) | |
44 | 55 | |
45 | 56 | allPointsInside :: Rect -> [(Int, Int)] |
46 | 57 | allPointsInside (Rect x y w h) = |
49 | 60 | in concat $ map (\xx -> zip (repeat xx) ys) xs |
50 | 61 | |
51 | 62 | 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) | |
54 | 64 | |
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 | |
58 | 68 | |
59 | 69 | getMultiCounted :: [Int] -> Int |
60 | 70 | getMultiCounted = length . (filter ((<) 1)) |
61 | 71 | |
62 | 72 | 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 | |
64 | 79 | |
65 | 80 | main :: IO () |
66 | 81 | main = do |
67 | 82 | claims <- fmap readClaims (readFile "input.txt") |
68 | 83 | case claims of |
69 | Right cs -> print $ runMultiCounted cs | |
84 | Right cs -> do | |
85 | print $ runMultiCounted cs | |
86 | print $ filter (hasNoOverlaps cs) cs | |
70 | 87 | Left err -> print err |