Complete Day 3

ETC: 2.5 hours

diff --git a/day03/fabric.hs b/day03/fabric.hs
new file mode 100644 (file)
index 0000000..7921588
--- /dev/null
+++ b/day03/fabric.hs
@@ -0,0 +1,51 @@
+import qualified Data.Map.Strict as M
+import Text.ParserCombinators.ReadP 
+
+main = do
+    claims <- map parseClaim <$> lines <$> getContents
+    let layout = claimOverlap claims
+    let counts = M.fromListWith (+) . map (\v -> (v,1)) . M.elems $ layout
+    print $ counts M.! (-1)
+    print . index . head . filter (\c -> (fst . size $ c)*(snd . size $ c) == M.findWithDefault 0 (index c) counts) $ claims
+
+data Claim = Claim { index :: Int
+                   , coord :: (Int, Int)
+                   , size  :: (Int, Int)
+                   } deriving (Show)
+
+type ClaimMap = M.Map (Int, Int) Int
+
+claimOverlap :: [Claim] -> ClaimMap
+claimOverlap = foldl go M.empty . map claimedAreas
+    where cc :: Int -> Int -> Int
+          cc _ _ = (-1)
+          mn :: ClaimMap -> (Int, (Int, Int)) -> ClaimMap
+          mn cmap (v, k) = M.insertWith cc k v cmap
+          go :: ClaimMap -> [(Int, (Int, Int))] -> ClaimMap
+          go cmap = foldl mn cmap
+
+claimedAreas :: Claim -> [(Int, (Int, Int))]
+claimedAreas (Claim ind (cx, cy) (sx, sy)) = 
+    [(ind,(i,j)) | i <- [cx+1..cx+sx], j <- [cy+1..cy+sy]]
+
+parseClaim :: String -> Claim
+parseClaim = fst . head . readP_to_S go
+    where digit :: ReadP Char
+          digit = satisfy (\char -> char >= '0' && char <= '9')
+          go :: ReadP Claim
+          go = do
+            char '#'
+            ind <- read <$> many1 digit
+            string " @ "
+            cx <- read <$> many1 digit
+            char ','
+            cy <- read <$> many1 digit
+            string ": "
+            sx <- read <$> many1 digit
+            char 'x'
+            sy <- read <$> many1 digit
+            eof
+            return (Claim ind (cx, cy) (sx, sy))
+
+countV :: Eq a => a -> [a] -> Int
+countV val = length . filter (== val)