day 3 done!
Haldean Brown
2 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 |