day03/fabric.hs

   1 import qualified Data.Map.Strict as M
   2 import Text.ParserCombinators.ReadP
   3
   4 main = do
   5     claims <- map parseClaim <$> lines <$> getContents
   6     let layout = claimOverlap claims
   7     let counts = M.fromListWith (+) . map (\v -> (v,1)) . M.elems $ layout
   8     print $ counts M.! (-1)
   9     print . index . claimUnoverlapped counts $ claims
  10
  11 data Claim = Claim { index :: Int
  12                    , coord :: (Int, Int)
  13                    , size  :: (Int, Int)
  14                    } deriving (Show)
  15
  16 type ClaimMap = M.Map (Int, Int) Int
  17
  18 claimOverlap :: [Claim] -> ClaimMap
  19 claimOverlap = foldl go M.empty . map claimedAreas
  20     where cc :: Int -> Int -> Int
  21           cc _ _ = (-1)
  22           mn :: ClaimMap -> (Int, (Int, Int)) -> ClaimMap
  23           mn cmap (v, k) = M.insertWith cc k v cmap
  24           go :: ClaimMap -> [(Int, (Int, Int))] -> ClaimMap
  25           go cmap = foldl mn cmap
  26
  27 claimUnoverlapped :: M.Map Int Int -> [Claim] -> Claim
  28 claimUnoverlapped counts = head . filter go
  29     where go :: Claim -> Bool
  30           go (Claim ind _ (sx, sy)) =
  31               (Just (sx*sy)) == counts M.!? ind
  32
  33 claimedAreas :: Claim -> [(Int, (Int, Int))]
  34 claimedAreas (Claim ind (cx, cy) (sx, sy)) =
  35     [(ind,(i,j)) | i <- [cx+1..cx+sx], j <- [cy+1..cy+sy]]
  36
  37 parseClaim :: String -> Claim
  38 parseClaim = fst . head . readP_to_S go
  39     where digit :: ReadP Char
  40           digit = satisfy (\char -> char >= '0' && char <= '9')
  41           go :: ReadP Claim
  42           go = do
  43             char '#'
  44             ind <- read <$> many1 digit
  45             string " @ "
  46             cx <- read <$> many1 digit
  47             char ','
  48             cy <- read <$> many1 digit
  49             string ": "
  50             sx <- read <$> many1 digit
  51             char 'x'
  52             sy <- read <$> many1 digit
  53             eof
  54             return (Claim ind (cx, cy) (sx, sy))
  55
  56 countV :: Eq a => a -> [a] -> Int
  57 countV val = length . filter (== val)