48 lines
1.8 KiB
Haskell
Executable File
48 lines
1.8 KiB
Haskell
Executable File
#! /usr/bin/env stack
|
|
-- stack --resolver lts-12.20 --install-ghc script
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
module Main where
|
|
|
|
import Control.Applicative
|
|
|
|
import qualified Data.List as L
|
|
import qualified Data.Set as S
|
|
import qualified Text.Parsec as P
|
|
import qualified Text.Parsec.Language as PL
|
|
import qualified Text.Parsec.Token as PT
|
|
|
|
data Point = Point { ptPosition :: (Int, Int)
|
|
, ptVelocity :: (Int, Int) } deriving Show
|
|
|
|
main :: IO ()
|
|
main = interact $ L.concatMap renderPoints
|
|
. zip [0..]
|
|
. L.iterate simulate
|
|
. parsePoints
|
|
|
|
renderPoints (n, S.fromList . map ptPosition -> ps)
|
|
| maxX > minX + 200 || maxY > minY + 10 = ""
|
|
| otherwise = unlines (show n : [ renderLine y | y <- [minY..maxY] ])
|
|
where
|
|
minX = S.findMin $ S.map fst ps
|
|
maxX = S.findMax $ S.map fst ps
|
|
minY = S.findMin $ S.map snd ps
|
|
maxY = S.findMax $ S.map snd ps
|
|
renderLine :: Int -> String
|
|
renderLine y = [ if S.member (x, y) ps then '#' else '.' | x <- [minX..maxX] ]
|
|
|
|
simulate :: [Point] -> [Point]
|
|
simulate = map move where
|
|
move (Point (x, y) (dx, dy)) = Point (x+dx, y+dy) (dx, dy)
|
|
|
|
parsePoints :: String -> [Point]
|
|
parsePoints = either (error . show) id . P.runParser (many point <* P.eof) () "input"
|
|
where
|
|
integer = fromInteger <$> PT.integer PL.haskell
|
|
whiteSpace = PT.whiteSpace PL.haskell
|
|
point = Point <$> position <* whiteSpace <*> velocity <* P.endOfLine
|
|
position = (,) <$ P.string "position=<" <* whiteSpace <*> integer
|
|
<* P.char ',' <* whiteSpace <*> integer <* P.char '>'
|
|
velocity = (,) <$ P.string "velocity=<" <* whiteSpace <*> integer
|
|
<* P.char ',' <* whiteSpace <*> integer <* P.char '>'
|