Day 3, parts 1 & 2: Initial solutions.

Day3/Part1.hs

@@ -0,0 +1,50 @@
+#! /usr/bin/env stack
+-- stack --resolver lts-12.20 --install-ghc script
+{-# LANGUAGE TupleSections #-}
+module Main where
+
+import qualified Data.Array           as A
+import qualified Data.List            as L
+import qualified Text.Parsec          as P
+import qualified Text.Parsec.Language as PL
+import qualified Text.Parsec.Token    as PT
+
+main :: IO ()
+main = interact $ (show .) $ (. map parseLine . lines) $ \claims ->
+   let outerRect  = L.foldl1' merge (map claimArea claims)
+       countArray = A.accumArray (+) 0 (rectBounds outerRect) $
+          concatMap (map (,1) . A.range . rectBounds . claimArea) claims
+   in length $ filter (> 1) (A.elems countArray)
+
+data Rect = Rect { rectCol    :: Int
+                 , rectRow    :: Int
+                 , rectWidth  :: Int
+                 , rectHeight :: Int
+                 } deriving (Eq, Show)
+
+rectBounds :: Rect -> ((Int, Int), (Int, Int))
+rectBounds = ((,) <$> ((,) <$> rectRow <*> rectCol)
+                  <*> ((,) <$> ((+) <$> rectRow <*> subtract 1 . rectHeight)
+                           <*> ((+) <$> rectCol <*> subtract 1 . rectWidth)))
+
+data Claim = Claim { claimID   :: Int
+                   , claimArea :: Rect
+                   } deriving (Eq, Show)
+
+merge (Rect c1 r1 w1 h1) (Rect c2 r2 w2 h2) = Rect cMin rMin (cMax - cMin) (rMax - rMin)
+   where
+      rMin = min r1 r2
+      cMin = min c1 c2
+      rMax = max (r1 + h1) (r2 + h2)
+      cMax = max (c1 + w1) (c2 + w2)
+
+parseLine :: String -> Claim
+parseLine = either (error . show) id . P.runParser p () ""
+   where
+      decimal    = fromInteger <$> PT.decimal PL.haskell
+      whiteSpace = PT.whiteSpace PL.haskell
+      p = Claim <$  P.char '#' <*> decimal
+                <*  whiteSpace <* P.char '@' <* whiteSpace
+                <*> (Rect <$> decimal    <* P.char ',' <*> decimal
+                          <*  P.char ':' <* whiteSpace
+                          <*> decimal    <* P.char 'x' <*> decimal)

Day3/Part2.hs

@@ -0,0 +1,49 @@
+#! /usr/bin/env stack
+-- stack --resolver lts-12.20 --install-ghc script
+module Main where
+
+import Data.Function (on)
+
+import qualified Data.List            as L
+import qualified Text.Parsec          as P
+import qualified Text.Parsec.Language as PL
+import qualified Text.Parsec.Token    as PT
+
+main :: IO ()
+main = interact $ (show .) $ (. map parseLine . lines) $ \claims ->
+   let noOverlaps c = not $ L.any ((overlaps `on` claimArea) c) (filter (/= c) claims)
+   in claimID $ head $ filter noOverlaps claims
+
+overlaps :: Rect -> Rect -> Bool
+overlaps (Rect c1 r1 w1 h1) (Rect c2 r2 w2 h2) = rowOverlaps && colOverlaps
+   where
+      check (l1, u1) (l2, u2) = sorted [l1, l2, u1]
+                             || sorted [l1, u2, u1]
+                             || sorted [l2, l1, u2]
+                             || sorted [l2, u1, u2]
+      rowOverlaps = check (r1, r1+h1-1) (r2, r2+h2-1)
+      colOverlaps = check (c1, c1+w1-1) (c2, c2+w2-1)
+
+sorted :: Ord a => [a] -> Bool
+sorted xs = L.all (uncurry (<=)) (zip xs (drop 1 xs))
+
+data Rect = Rect { rectCol    :: Int
+                 , rectRow    :: Int
+                 , rectWidth  :: Int
+                 , rectHeight :: Int
+                 } deriving (Eq, Show)
+
+data Claim = Claim { claimID   :: Int
+                   , claimArea :: Rect
+                   } deriving (Eq, Show)
+
+parseLine :: String -> Claim
+parseLine = either (error . show) id . P.runParser p () ""
+   where
+      decimal    = fromInteger <$> PT.decimal PL.haskell
+      whiteSpace = PT.whiteSpace PL.haskell
+      p = Claim <$  P.char '#' <*> decimal
+                <*  whiteSpace <* P.char '@' <* whiteSpace
+                <*> (Rect <$> decimal    <* P.char ',' <*> decimal
+                          <*  P.char ':' <* whiteSpace
+                          <*> decimal    <* P.char 'x' <*> decimal)