1 import Data.Text (Text)
2 import qualified Data.Text.IO as TIO
4 import Data.Void (Void)
6 import Text.Megaparsec hiding (State)
7 import Text.Megaparsec.Char
8 import qualified Text.Megaparsec.Char.Lexer as L
9 import qualified Control.Applicative as CA
11 import Linear (V3(..), V1(..), (^+^), (^-^))
13 import qualified Data.Vector as V
15 class (Ord a) => NVec a where
20 nvAbsSum :: a -> Integer
21 instance NVec (V1 Integer) where
25 nvSignum (V1 x) = V1 (signum x)
26 nvAbsSum (V1 x) = abs x
27 instance NVec (V3 Integer) where
31 nvSignum (V3 x y z) = V3 (signum x) (signum y) (signum z)
32 nvAbsSum (V3 x y z) = (abs x) + (abs y) + (abs z)
35 data Planet a = Planet { _pos :: a , _vel :: a} deriving (Show, Eq, Ord)
36 type Planets a = V.Vector (Planet a)
41 text <- TIO.readFile "data/advent12.txt"
42 let planetsT = successfulParse text
43 let planets = enplanet planetsT
48 part1 :: Planets (V3 Integer) -> Integer
49 part1 planets = systemEnergy $ head $ drop 1000 $ simulate planets
51 part2 :: Planets (V3 Integer) -> Integer
52 part2 planets = period
53 where planetDimensions = unzipPlanets planets
54 simCounts = map countSimulate planetDimensions
55 period = foldl lcm 1 simCounts
58 enplanet :: (NVec a) => [a] -> Planets a
59 enplanet = V.fromList . map (\p -> Planet {_pos = p, _vel = nvZero} )
62 unzipPlanets :: V.Vector (Planet (V3 Integer)) -> [V.Vector (Planet (V1 Integer))]
63 unzipPlanets planets = dimensionSlice $ V.map unzipPlanet planets
65 unzipPlanet :: Planet (V3 Integer) -> [Planet (V1 Integer)]
66 unzipPlanet planet = map mkPlanet posVecs
67 where posVecs = unzipVec $ _pos planet
68 mkPlanet p = Planet {_pos = p, _vel = nvZero}
70 unzipVec :: V3 Integer -> [V1 Integer]
71 unzipVec (V3 x y z) = [V1 x, V1 y, V1 z]
73 dimensionSlice :: (NVec a) => V.Vector [Planet a] -> [Planets a]
74 dimensionSlice slicedPlanets = [sliceDim d | d <- [0..2]]
75 where sliceDim d = V.map (!!d) slicedPlanets
79 simulate :: (NVec a) => Planets a -> [Planets a]
80 simulate = iterate simulationStep
82 countSimulate :: (NVec a) => Planets a -> Integer
83 countSimulate planets0 = go (simulationStep planets0) 1
85 | planets0 == planets = n
86 | otherwise = go (simulationStep planets) (n + 1)
89 simulationStep :: (NVec a) => Planets a -> Planets a
90 simulationStep planets = planets''
91 where planets' = applyGravity planets
92 planets'' = applyVelocity planets'
95 gravity :: (NVec a) => a -> a
96 gravity v = nvSignum v
98 applyGravity :: (NVec a) => Planets a -> Planets a
99 applyGravity planets = V.map (applyGravityHere planets) planets
101 applyGravityHere :: (NVec a) => Planets a -> Planet a -> Planet a
102 applyGravityHere planets here = V.foldl' updateGravity here planets
104 updateGravity :: (NVec a) => Planet a -> Planet a -> Planet a
105 updateGravity here there = here { _vel = vel'}
106 where vel = _vel here
107 vel' = vel ^+^^ gravity ((_pos there) ^-^^ (_pos here))
109 applyVelocity :: (NVec a) => Planets a -> Planets a
110 applyVelocity = V.map applyVelocityHere
112 applyVelocityHere :: (NVec a) => Planet a -> Planet a
113 applyVelocityHere here = here {_pos = (_pos here) ^+^^ (_vel here)}
118 -- absSum (Vec1 (V1 x)) = (abs x)
119 -- absSum (Vec3 (V3 x y z)) = (abs x) + (abs y) + (abs z)
121 potentalEnergy planet = nvAbsSum $ _pos planet
122 kineticEnergy planet = nvAbsSum $ _vel planet
123 totalEnergy planet = (potentalEnergy planet) * (kineticEnergy planet)
125 systemEnergy = (V.foldl' (+) 0) . (V.map totalEnergy)
129 -- Parse the input file
130 type Parser = Parsec Void Text
133 sc = L.space (skipSome spaceChar) CA.empty CA.empty
134 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
137 integer = lexeme L.decimal
138 signedInteger = L.signed sc integer
142 identifierP = some alphaNumChar <* sc
143 openBracketP = symb "<"
144 closeBracketP = symb ">"
146 planetsP = many planetP
148 planetP = (between openBracketP closeBracketP) coordsP
150 coordsP = envector <$> (coordP `sepBy` commaP)
151 where envector [x, y, z] = V3 x y z
152 coordP = identifierP *> equalP *> signedInteger
155 -- successfulParse :: Text -> [Vec]
156 successfulParse :: Text -> [V3 Integer]
157 successfulParse input =
158 case parse planetsP "input" input of
159 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
160 Right planets -> planets