never executed always true always false

    1 {-|
    2 Module:      Y2018.D03
    3 Description: Advent of Code Day 03 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the day 01 set of problems for <adventofcode.com>.
    8 -}
    9 module Y2018.D03
   10   ( intactInches
   11   , overlappedInches
   12   ) where
   13 
   14 import Y2015.Util (regularParse, intParser)
   15 
   16 import Data.List          (foldl')
   17 import Text.Parsec.String (Parser)
   18 import Text.Parsec.Char   (endOfLine)
   19 import Text.Parsec
   20     ( ParseError
   21     , many
   22     , optional
   23     , space
   24     , string
   25     )
   26 
   27 import qualified Data.Map.Strict as Map
   28 import qualified Data.Set as Set
   29 
   30 data Claim = Claim
   31   { iD       :: Int
   32   , leftEdge :: Int
   33   , topEdge  :: Int
   34   , width    :: Int
   35   , height   :: Int
   36   } deriving (Eq, Show)
   37 
   38 type Point = (Int, Int)
   39 
   40 intactInches :: String -> Either ParseError [Int]
   41 intactInches input =
   42   case parseClaims input of
   43     Left e -> Left e
   44     Right claims ->
   45       Right $ map iD $ singleClaims claims $ toClothMap claims
   46 
   47 singleClaims :: [Claim] -> Map.Map Point (Set.Set Int) -> [Claim]
   48 singleClaims claims cloth = filter noOtherClaims claims
   49   where noOtherClaims claim =
   50           Map.null
   51           $ Map.filter (not . (==) 1 . Set.size)
   52           $ Map.filter (Set.member (iD claim)) cloth
   53 
   54 overlappedInches :: String -> Either ParseError Int
   55 overlappedInches input =
   56   case parseClaims input of
   57     Left e -> Left e
   58     Right claims ->
   59       Right
   60         $ Map.size
   61         $ Map.filter multipleClaims
   62         $ toClothMap claims
   63   where multipleClaims = flip (>) 1 . Set.size
   64 
   65 toClothMap :: [Claim] -> Map.Map Point (Set.Set Int)
   66 toClothMap claims =
   67   foldl' (Map.unionWith (Set.union)) (Map.empty :: Map.Map Point (Set.Set Int))
   68   $ map ((\x -> Map.fromSet (\_ -> Set.singleton $ fst x) $ snd x))
   69   $ map toPoints claims
   70 
   71 toPoints :: Claim -> (Int, Set.Set Point)
   72 toPoints Claim { iD = i, leftEdge = l, topEdge = t, width = w, height = h } =
   73   (i, Set.fromList $ concatMap (\x -> map (\y -> (x, y)) [t .. (t+h-1)]) [l .. (l+w-1)])
   74 
   75 -- Parsing utilities
   76 
   77 parseClaims :: String
   78            -> Either ParseError [Claim]
   79 parseClaims = regularParse claimParser
   80 
   81 claimParser :: Parser [Claim]
   82 claimParser = many (parseClaim <* optional endOfLine)
   83 
   84 parseClaim :: Parser Claim
   85 parseClaim = Claim <$ string "#" <*> intParser <* space <* string "@" <* space
   86                                  <*> intParser <* string ","
   87                                  <*> intParser <* string ":" <* space
   88                                  <*> intParser <* string "x"
   89                                  <*> intParser