src/advent03/advent03.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 import Data.List
   4 import Data.Tuple (swap)
   5
   6 import Data.Text (Text)
   7 import qualified Data.Text.IO as TIO
   8
   9 import Data.Void (Void)
  10
  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
  15
  16 import qualified Data.Map.Strict as M
  17 -- import Data.Map.Strict ((!))
  18
  19
  20 type Position = (Int, Int)
  21 data Claim = Claim { claimId :: Int, claimTopLeft :: Position, claimWidth :: Int, claimHeight :: Int } deriving (Show, Eq)
  22 type Fabric = M.Map Position Int
  23
  24 main :: IO ()
  25 main = do
  26         text <- TIO.readFile "data/advent03.txt"
  27         let claims = successfulParse text
  28         let fabric = foldl' addClaim M.empty claims
  29         print $ part1 fabric
  30         print $ part2 fabric claims
  31
  32
  33 part1 :: Fabric -> Int
  34 part1  = M.size . overclaimed
  35
  36 part2 :: Fabric -> [Claim] -> Int
  37 part2 fabric claims = claimId $ head $ filter noOverlap' claims
  38     where noOverlap' claim = noOverlap fabric claim
  39
  40
  41 claimedSquares :: Claim -> [Position]
  42 claimedSquares claim = [(r, c) | r <- [l .. (l + w - 1)]
  43                                , c <- [t .. (t + h - 1)]
  44                        ]
  45     where (t, l) = claimTopLeft claim
  46           h = claimHeight claim
  47           w = claimWidth claim
  48
  49 addClaim :: Fabric -> Claim -> Fabric
  50 addClaim fabric claim = foldl' addSquare fabric squares
  51     where squares = claimedSquares claim
  52
  53 addSquare :: Fabric -> Position -> Fabric
  54 addSquare fabric square = M.insert square (currentClaims + 1) fabric
  55     where currentClaims = M.findWithDefault 0 square fabric
  56
  57 overclaimed :: Fabric -> Fabric
  58 overclaimed = M.filter ( > 1)
  59
  60 noOverlap fabric claim = M.null $ overclaimed existing
  61     where claimedFabric = addClaim M.empty claim
  62           existing = fabric `M.intersection` claimedFabric
  63
  64 -- Parse the input file
  65
  66 type Parser = Parsec Void Text
  67
  68 sc :: Parser ()
  69 sc = L.space (skipSome spaceChar) CA.empty CA.empty
  70 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
  71
  72 lexeme  = L.lexeme sc
  73 integer = lexeme L.decimal
  74 symb = L.symbol sc
  75
  76 hashP = symb "#"
  77 atP = symb "@"
  78 colonP = symb ":"
  79 commaP = symb ","
  80 exP = "x"
  81
  82 claimsFileP = many claimP
  83
  84 idP = hashP *> integer
  85 leftTopP = (,) <$> integer <* commaP <*> integer
  86 widthHeightP = (,) <$> integer <* exP <*> integer
  87
  88 claimP = claimify <$> idP <* atP <*> leftTopP <* colonP <*> widthHeightP
  89     where claimify cid lt (w, h) = Claim { claimId = cid, claimTopLeft = swap lt, claimWidth = w, claimHeight = h }
  90
  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