git.haldean.org aoc-2018 / master 03 / Aoc03.hs
master

Tree @master (Download .tar.gz)

Aoc03.hs @master

eb676ad
 
d1cda62
f06fdea
 
 
d1cda62
f06fdea
d1cda62
eb676ad
d1cda62
eb676ad
 
d1cda62
 
 
 
 
 
eb676ad
 
 
 
 
 
 
 
 
 
d1cda62
 
 
 
 
 
f06fdea
 
 
 
 
 
 
 
 
 
 
 
 
d1cda62
 
 
 
 
 
eb676ad
d1cda62
 
 
 
 
 
 
 
eb676ad
d1cda62
eb676ad
 
 
d1cda62
 
 
 
 
eb676ad
 
 
 
 
 
f06fdea
 
d1cda62
 
 
eb676ad
 
 
d1cda62
import qualified Data.List as L
import qualified Data.Maybe as M
import qualified Data.Set as S
import Text.Parsec
import Text.Parsec.String

data Rect = Rect Int Int Int Int deriving Show

contains :: Rect -> Int -> Int -> Bool
contains (Rect rx ry rw rh) x y = rx <= x && x < rx + rw && ry <= y && y < ry + rh

union :: Rect -> Rect -> Rect
union (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) =
  let xmin = min x1 x2
      xmax = max (x1 + w1) (x2 + w2)
      ymin = min y1 y2
      ymax = max (y1 + h1) (y2 + h2)
      in Rect xmin ymin (xmax - xmin) (ymax - ymin)

intersection :: Rect -> Rect -> Maybe Rect
intersection (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) =
  let xmin = max x1 x2
      xmax = min (x1 + w1) (x2 + w2)
      ymin = max y1 y2
      ymax = min (y1 + h1) (y2 + h2)
      in if xmin < xmax && ymin < ymax
         then Just $ Rect xmin ymin (xmax - xmin) (ymax - ymin)
         else Nothing

data Claim = Claim Int Rect deriving Show
claimRect :: Claim -> Rect
claimRect (Claim _ rect) = rect

parseInt :: Parser Int
parseInt = fmap (read :: String -> Int) $ many1 digit

parseClaim :: Parser Claim
parseClaim = do
  _ <- char '#'
  rid <- parseInt
  _ <- many $ oneOf " @"
  rx <- parseInt
  _ <- char ','
  ry <- parseInt
  _ <- many $ oneOf " :"
  rw <- parseInt
  _ <- char 'x'
  rh <- parseInt
  return $ Claim rid (Rect rx ry rw rh)

readClaims :: String -> Either ParseError [Claim]
readClaims = parse (sepEndBy parseClaim (char '\n')) "input.txt"

findBounds :: [Claim] -> Rect
findBounds = (foldl1 union) . (map (\(Claim _ r) -> r))

allPointsInside :: Rect -> [(Int, Int)]
allPointsInside (Rect x y w h) =
  let xs = enumFromTo x (x + w - 1)
      ys = enumFromTo y (y + h - 1)
  in concat $ map (\xx -> zip (repeat xx) ys) xs

allRelevantPoints :: [Claim] -> [(Int, Int)]
allRelevantPoints = S.toList . S.unions . map (S.fromList . allPointsInside . claimRect)

getCounts :: [Claim] -> [Int]
getCounts cs =
  map (\(x, y) -> length $ filter (\(Claim _ cr) -> contains cr x y) cs) $ allRelevantPoints cs

getMultiCounted :: [Int] -> Int
getMultiCounted = length . (filter ((<) 1))

runMultiCounted :: [Claim] -> Int
runMultiCounted = getMultiCounted . getCounts

hasNoOverlaps :: [Claim] -> Claim -> Bool
hasNoOverlaps cs c = all (ok c) cs where
  ok (Claim id1 r1) (Claim id2 r2) =
    if id1 == id2 then True else M.isNothing $ intersection r1 r2

main :: IO ()
main = do
  claims <- fmap readClaims (readFile "input.txt")
  case claims of
    Right cs -> do
      print $ runMultiCounted cs
      print $ filter (hasNoOverlaps cs) cs
    Left err -> print err