src/advent10/advent10-iterate-zip.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.Set as S
  16
  17 type Coord = (Integer, Integer) -- x, y
  18 type Bounds = (Integer, Integer, Integer, Integer) -- minX, maxX, minY, maxY
  19 data Particle = Particle {_position :: Coord, _velocity :: Coord} deriving (Eq, Show)
  20 type Swarm = [Particle]
  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         let (final, time) = part0 particles
  28         putStrLn $ showParticles final
  29         print time
  30
  31 part0 :: Swarm -> (Swarm, Int)
  32 part0 particles = (snd $ last $ gridPairs, length gridPairs)
  33     where gridPairs = findEnd particles
  34
  35 runParticles :: Swarm -> [Swarm]
  36 runParticles = iterate updateAll
  37
  38 findEnd :: Swarm -> [(Swarm, Swarm)]
  39 findEnd particles = takeWhile firstLarger gridPairs
  40     where grids = runParticles particles
  41           gridPairs = zip grids (drop 1 grids)
  42           firstLarger (g1, g2) = (boundsArea g1) > (boundsArea g2)
  43
  44
  45
  46 boundsArea :: Swarm -> Integer
  47 boundsArea particles = (maxX - minX) * (maxY - minY)
  48     where (minX, maxX, minY, maxY) = findBounds particles
  49
  50 findBounds :: Swarm -> Bounds
  51 findBounds particles =
  52         ( minX -- small x edge
  53         , maxX -- large x edge
  54         , minY -- small x edge
  55         , maxY -- large y edge
  56         )
  57     where maxX = maximum $ map (fst . _position) particles
  58           minX = minimum $ map (fst . _position) particles
  59           maxY = maximum $ map (snd . _position) particles
  60           minY = minimum $ map (snd . _position) particles
  61
  62
  63 update :: Particle -> Particle
  64 update particle = particle {_position = (x + vx, y + vy)}
  65     where (x, y) = _position particle
  66           (vx, vy) = _velocity particle
  67
  68
  69 updateAll :: Swarm -> Swarm
  70 updateAll = map update
  71
  72 showParticles :: Swarm -> String
  73 showParticles particles = intercalate "\n" rows
  74     where (minX, maxX, minY, maxY) = findBounds particles
  75           grid = S.fromList $ map _position particles
  76           rows = [showRow y minX maxX grid | y <- [minY..maxY] ]
  77
  78 showCell :: Integer -> Integer -> Grid -> Char
  79 showCell x y grid
  80     | (x, y) `S.member` grid = '*'
  81     | otherwise = ' '
  82
  83 showRow :: Integer -> Integer -> Integer -> Grid -> String
  84 showRow y minX maxX grid = [showCell x y grid | x <- [minX..maxX] ]
  85
  86 -- Parse the input file
  87
  88 type Parser = Parsec Void Text
  89
  90 sc :: Parser ()
  91 sc = L.space (skipSome spaceChar) CA.empty CA.empty
  92
  93 lexeme  = L.lexeme sc
  94 integer = lexeme L.decimal
  95 symb = L.symbol sc
  96 signedInteger = L.signed sc integer
  97
  98 posPrefix = symb "position=<"
  99 velPrefix = symb "velocity=<"
 100 suffix = symb ">"
 101 commaP = symb ","
 102
 103 particleFileP = many particleP
 104
 105 particleP = particlify <$> positionP <*> velocityP
 106     where particlify x v = Particle x v
 107
 108 positionP = posPrefix *> pairP <* suffix
 109 velocityP = velPrefix *> pairP <* suffix
 110
 111 pairP = (,) <$> signedInteger <* commaP <*> signedInteger
 112
 113 successfulParse :: Text -> Swarm
 114 successfulParse input =
 115         case parse particleFileP "input" input of
 116                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 117                 Right particles -> particles