git.haldean.org
day 3 done! Haldean Brown 2 years ago
1 changed file(s) with 29 addition(s) and 12 deletion(s).
 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