src/advent10/advent10.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 import Data.List
   4
   5 import Data.Text (Text)
   6 import qualified Data.Text.IO as TIO
   7
   8 import Data.Void (Void)
   9
  10 import Text.Megaparsec
  11 import Text.Megaparsec.Char
  12 import qualified Text.Megaparsec.Char.Lexer as L
  13 import qualified Control.Applicative as CA
  14
  15 import qualified Data.Map.Strict as M
  16 import qualified Data.Set as S
  17
  18 type Coord = (Integer, Integer) -- x, y
  19 type Bounds = (Integer, Integer, Integer, Integer) -- minX, maxX, minY, maxY
  20 data Particle = Particle {_position :: Coord, _velocity :: Coord} deriving (Eq, Show)
  21 type Grid = S.Set Coord
  22
  23 main :: IO ()
  24 main = do
  25         text <- TIO.readFile "data/advent10.txt"
  26         let particles = successfulParse text
  27         -- putStrLn $ part1 particles
  28         let (time, view) = part2 0 particles
  29         putStrLn view
  30         print time
  31
  32
  33 part1 particles
  34     | area' > area = showParticles particles
  35     | otherwise = part1 particles'
  36     where particles' = updateAll particles
  37           area = boundsArea particles
  38           area' = boundsArea particles'
  39
  40 part2 time particles
  41     | area' > area = (time, showParticles particles)
  42     | otherwise = part2 (time+1) particles'
  43     where particles' = updateAll particles
  44           area = boundsArea particles
  45           area' = boundsArea particles'
  46
  47 boundsArea :: [Particle] -> Integer
  48 boundsArea particles = (maxX - minX) * (maxY - minY)
  49     where (minX, maxX, minY, maxY) = findBounds particles
  50
  51 findBounds :: [Particle] -> Bounds
  52 findBounds particles =
  53         ( minX -- small x edge
  54         , maxX -- large x edge
  55         , minY -- small x edge
  56         , maxY -- large y edge
  57         )
  58     where maxX = maximum $ map (fst . _position) particles
  59           minX = minimum $ map (fst . _position) particles
  60           maxY = maximum $ map (snd . _position) particles
  61           minY = minimum $ map (snd . _position) particles
  62
  63
  64 update :: Particle -> Particle
  65 update particle = particle {_position = (x + vx, y + vy)}
  66     where (x, y) = _position particle
  67           (vx, vy) = _velocity particle
  68
  69
  70 updateAll :: [Particle] -> [Particle]
  71 updateAll = map update
  72
  73 showParticles :: [Particle] -> String
  74 showParticles particles = intercalate "\n" rows
  75     where (minX, maxX, minY, maxY) = findBounds particles
  76           grid = S.fromList $ map _position particles
  77           rows = [showRow y minX maxX grid | y <- [minY..maxY] ]
  78
  79 showCell :: Integer -> Integer -> Grid -> Char
  80 showCell x y grid
  81     | (x, y) `S.member` grid = '*'
  82     | otherwise = ' '
  83
  84 showRow :: Integer -> Integer -> Integer -> Grid -> String
  85 showRow y minX maxX grid = [showCell x y grid | x <- [minX..maxX] ]
  86
  87 -- Parse the input file
  88
  89 type Parser = Parsec Void Text
  90
  91 sc :: Parser ()
  92 sc = L.space (skipSome spaceChar) CA.empty CA.empty
  93
  94 lexeme  = L.lexeme sc
  95 integer = lexeme L.decimal
  96 symb = L.symbol sc
  97 signedInteger = L.signed sc integer
  98
  99 posPrefix = symb "position=<"
 100 velPrefix = symb "velocity=<"
 101 suffix = symb ">"
 102 commaP = symb ","
 103
 104 particleFileP = many particleP
 105
 106 particleP = particlify <$> positionP <*> velocityP
 107     where particlify x v = Particle x v
 108
 109 positionP = posPrefix *> pairP <* suffix
 110 velocityP = velPrefix *> pairP <* suffix
 111
 112 pairP = (,) <$> signedInteger <* commaP <*> signedInteger
 113
 114 successfulParse :: Text -> [Particle]
 115 successfulParse input =
 116         case parse particleFileP "input" input of
 117                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 118                 Right particles -> particles