src/infi/infi.hs

   1 import Data.Text (Text)
   2 import qualified Data.Text as T
   3 import qualified Data.Text.IO as TIO
   4
   5 import Text.Megaparsec hiding (State)
   6 import qualified Text.Megaparsec.Lexer as L
   7 import Text.Megaparsec.Text (Parser)
   8 import qualified Control.Applicative as CA
   9
  10 import Data.List (nub)
  11
  12 type Position = (Integer, Integer)
  13
  14 (+:) (a, b) (c, d) = (a + c, b + d)
  15
  16
  17
  18 main :: IO ()
  19 main = do
  20         text <- TIO.readFile "data/infi.txt"
  21         let (starts, unchunkedSteps) = successfulParse text
  22         let steps = chunks (length starts) unchunkedSteps
  23         let points = visited starts steps
  24         print $ part1 points
  25         putStrLn $ part2 points
  26
  27
  28 visited :: [Position] -> [[Position]] -> [[Position]]
  29 visited = scanl (zipWith (+:))
  30
  31 intersections :: [[Position]] -> [[Position]]
  32 intersections = filter ((== 1) . length . nub)
  33
  34 part1 :: [[Position]] -> Int
  35 part1 = length . intersections
  36
  37 part2 :: [[Position]] -> String
  38 part2 points = showPoints bds $ nub $ concat $ intersections points
  39     where bds = bounds $ nub $ concat points
  40
  41 chunks :: Int -> [b] -> [[b]]
  42 chunks n xs = (take n xs) : if null xs' then [] else chunks n xs'
  43     where xs' = drop n xs
  44
  45 bounds :: [Position] -> (Integer, Integer, Integer, Integer)
  46 bounds ps = ( minimum $ map fst ps
  47             , maximum $ map fst ps
  48             , minimum $ map snd ps
  49             , maximum $ map snd ps
  50             )
  51
  52
  53 showPoints :: (Integer, Integer, Integer, Integer) -> [Position] -> String
  54 showPoints (minr, maxr, minc, maxc) ps = unlines [ [ if (r, c) `elem` ps then '*' else ' ' | r <- [minr..maxr] ] | c <- [minc..maxc] ]
  55
  56
  57 sc :: Parser ()
  58 sc = L.space (skipSome spaceChar) CA.empty CA.empty
  59
  60 lexeme = L.lexeme sc
  61 integer = lexeme L.integer
  62 signedInteger = L.signed sc integer
  63 symbol = L.symbol sc
  64 comma = symbol ","
  65
  66 pointP :: Parser Position
  67 pointP = (,) <$> signedInteger <* comma <*> signedInteger
  68
  69 startPosP = between (symbol "[") (symbol "]") pointP
  70 stepP = between (symbol "(") (symbol ")") pointP
  71
  72 descriptionP = (,) <$> (some startPosP) <*> (some stepP)
  73
  74 successfulParse :: Text -> ([Position], [Position])
  75 successfulParse input =
  76         case parse descriptionP "input" input of
  77                 Left  _error -> ([], [])
  78                 Right description -> description