1 {-# LANGUAGE OverloadedStrings #-}
4 import Data.Tuple (swap)
6 import Data.Text (Text)
7 import qualified Data.Text.IO as TIO
9 import Data.Void (Void)
11 import Text.Megaparsec
12 import Text.Megaparsec.Char
13 import qualified Text.Megaparsec.Char.Lexer as L
14 import qualified Control.Applicative as CA
16 import qualified Data.Map.Strict as M
17 -- import Data.Map.Strict ((!))
20 type Position = (Int, Int) -- row, column
21 data Claim = Claim { claimId :: Int, claimTopLeft :: Position, claimWidth :: Int, claimHeight :: Int } deriving (Show, Eq)
22 type Fabric = M.Map Position Int
26 text <- TIO.readFile "data/advent03.txt"
27 let claims = successfulParse text
28 let fabric = foldl' addClaim M.empty claims
30 print $ part2 fabric claims
33 part1 :: Fabric -> Int
34 part1 = M.size . overclaimed
36 part2 :: Fabric -> [Claim] -> Int
37 part2 fabric claims = claimId $ head $ filter noOverlap' claims
38 where noOverlap' claim = noOverlap fabric claim
41 claimedSquares :: Claim -> [Position]
42 claimedSquares claim = [(r, c) | r <- [r0 .. (r0 + h - 1)]
43 , c <- [c0 .. (c0 + w - 1)]
45 where (r0, c0) = claimTopLeft claim
49 addClaim :: Fabric -> Claim -> Fabric
50 addClaim fabric claim = foldl' addSquare fabric squares
51 where squares = claimedSquares claim
53 addSquare :: Fabric -> Position -> Fabric
54 addSquare fabric square = M.insert square (currentClaims + 1) fabric
55 where currentClaims = M.findWithDefault 0 square fabric
57 overclaimed :: Fabric -> Fabric
58 overclaimed = M.filter ( > 1)
60 noOverlap fabric claim = M.null $ overclaimed existing
61 where claimedFabric = addClaim M.empty claim
62 existing = fabric `M.intersection` claimedFabric
64 -- Parse the input file
66 type Parser = Parsec Void Text
69 sc = L.space (skipSome spaceChar) CA.empty CA.empty
70 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
73 integer = lexeme L.decimal
82 claimsFileP = many claimP
84 idP = hashP *> integer
85 leftTopP = (,) <$> integer <* commaP <*> integer
86 widthHeightP = (,) <$> integer <* exP <*> integer
88 claimP = claimify <$> idP <* atP <*> leftTopP <* colonP <*> widthHeightP
89 where claimify cid cr (w, h) = Claim { claimId = cid, claimTopLeft = swap cr, claimWidth = w, claimHeight = h }
91 successfulParse :: Text -> [Claim]
92 successfulParse input =
93 case parse claimsFileP "input" input of
94 Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
95 Right claims -> claims