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 . head . filter (\c -> (fst . size $ c)*(snd . size $ c) == M.findWithDefault 0 (index c) 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 claimedAreas :: Claim -> [(Int, (Int, Int))]
  28 claimedAreas (Claim ind (cx, cy) (sx, sy)) =
  29     [(ind,(i,j)) | i <- [cx+1..cx+sx], j <- [cy+1..cy+sy]]
  30
  31 parseClaim :: String -> Claim
  32 parseClaim = fst . head . readP_to_S go
  33     where digit :: ReadP Char
  34           digit = satisfy (\char -> char >= '0' && char <= '9')
  35           go :: ReadP Claim
  36           go = do
  37             char '#'
  38             ind <- read <$> many1 digit
  39             string " @ "
  40             cx <- read <$> many1 digit
  41             char ','
  42             cy <- read <$> many1 digit
  43             string ": "
  44             sx <- read <$> many1 digit
  45             char 'x'
  46             sy <- read <$> many1 digit
  47             eof
  48             return (Claim ind (cx, cy) (sx, sy))
  49
  50 countV :: Eq a => a -> [a] -> Int
  51 countV val = length . filter (== val)