From 533bb1d8f65ed38b9525770a7147c570bb2a88cc Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Fri, 13 Dec 2019 08:57:17 +0000 Subject: [PATCH] Polymorphism working --- advent12/src/advent12.hs | 100 +++++++++++++++++++++++++++++++++------ 1 file changed, 85 insertions(+), 15 deletions(-) diff --git a/advent12/src/advent12.hs b/advent12/src/advent12.hs index b847d28..e99008d 100644 --- a/advent12/src/advent12.hs +++ b/advent12/src/advent12.hs @@ -8,9 +8,10 @@ import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L import qualified Control.Applicative as CA -import Linear (V3(..), (^+^), (^-^)) +import Linear (V3(..), V1(..), (^+^), (^-^)) import qualified Data.Set as S +import qualified Data.Vector as V -- import Data.List (foldl') -- import Data.Set ((\\)) @@ -18,52 +19,120 @@ import qualified Data.Set as S -- import Data.Map.Strict ((!)) -type Vec = V3 Integer -data Planet = Planet { _pos :: Vec, _vel :: Vec} deriving (Show, Eq, Ord) -type Planets = S.Set Planet +-- data Vec3 = Vec3 (V3 Integer) deriving (Show, Eq, Ord) +-- data Vec1 = Vec1 (V1 Integer) deriving (Show, Eq, Ord) +class (Ord a) => NVec a where + (^+^^) :: a -> a -> a + (^-^^) :: a -> a -> a + nvZero :: a + nvSignum :: a -> a + nvAbsSum :: a -> Integer +instance NVec (V1 Integer) where + x ^+^^ y = x ^+^ y + x ^-^^ y = x ^-^ y + nvZero = V1 0 + nvSignum (V1 x) = V1 (signum x) + nvAbsSum (V1 x) = abs x +instance NVec (V3 Integer) where + x ^+^^ y = x ^+^ y + x ^-^^ y = x ^-^ y + nvZero = V3 0 0 0 + nvSignum (V3 x y z) = V3 (signum x) (signum y) (signum z) + nvAbsSum (V3 x y z) = (abs x) + (abs y) + (abs z) + + +-- data Vec = Vec1 (V1 Integer) | Vec3 (V3 Integer) +-- deriving (Show, Eq, Ord) +-- data Planet1 = Planet { _pos :: (V1 Integer), _vel :: (V1 Integer)} deriving (Show, Eq, Ord) +data Planet a = Planet { _pos :: a , _vel :: a} deriving (Show, Eq, Ord) +-- type Planets1 = S.Set Planet1 +type Planets a = S.Set (Planet a) main :: IO () main = do - text <- TIO.readFile "data/advent12a.txt" + text <- TIO.readFile "data/advent12.txt" let planetsT = successfulParse text let planets = enplanet planetsT print planets print $ part1 planets + print $ part2 planets +part1 :: Planets (V3 Integer) -> Integer +part1 planets = systemEnergy $ head $ drop 1000 $ simulate planets -part1 planets = take 12 $ simulate planets +-- part2 :: Planets (V3 Integer) -> [Planet (V1 Integer)] +part2 planets = take 10 $ simulate $ head planetDimensions -- take 10 $ simulate (head planetDimensions) + where planetDimensions = unzipPlanets planets -enplanet = S.fromList . map (\p -> Planet {_pos = p, _vel = (V3 0 0 0)} ) +enplanet :: (NVec a) => [a] -> S.Set (Planet a) +enplanet = S.fromList . map (\p -> Planet {_pos = p, _vel = nvZero} ) +-- enplanet (Vec3 p) = S.fromList . map (\p -> Planet {_pos = (Vec3 p), _vel = Vec3 (V3 0 0 0)} ) -_x (V3 x _ _) = x -_y (V3 _ y _) = y -_z (V3 _ _ z) = z +-- _x (V3 x _ _) = x +-- _y (V3 _ y _) = y +-- _z (V3 _ _ z) = z +unzipPlanets :: S.Set (Planet (V3 Integer)) -> [S.Set (Planet (V1 Integer))] +unzipPlanets planets = dimensionSlice $ S.map unzipPlanet planets -gravity (V3 x y z) = V3 (signum x) (signum y) (signum z) +unzipPlanet :: Planet (V3 Integer) -> [Planet (V1 Integer)] +unzipPlanet planet = map mkPlanet posVecs + where posVecs = unzipVec $ _pos planet + mkPlanet p = Planet {_pos = p, _vel = nvZero} +unzipVec :: V3 Integer -> [V1 Integer] +unzipVec (V3 x y z) = [V1 x, V1 y, V1 z] +dimensionSlice :: (NVec a) => S.Set [Planet a] -> [S.Set (Planet a)] +dimensionSlice slicedPlanets = [sliceDim d | d <- [0..2]] + where sliceDim d = S.map (!!d) slicedPlanets + + + +simulate :: (NVec a) => Planets a -> [Planets a] simulate = iterate simulationStep +countSimulate + +simulationStep :: (NVec a) => Planets a -> Planets a simulationStep planets = planets'' where planets' = applyGravity planets planets'' = applyVelocity planets' +gravity :: (NVec a) => a -> a +gravity v = nvSignum v + +applyGravity :: (NVec a) => Planets a -> Planets a applyGravity planets = S.map (applyGravityHere planets) planets +applyGravityHere :: (NVec a) => Planets a -> Planet a -> Planet a applyGravityHere planets here = S.foldl' updateGravity here planets +updateGravity :: (NVec a) => Planet a -> Planet a -> Planet a updateGravity here there = here { _vel = vel'} where vel = _vel here - vel' = vel ^+^ gravity ((_pos there) ^-^ (_pos here)) - + vel' = vel ^+^^ gravity ((_pos there) ^-^^ (_pos here)) +applyVelocity :: (NVec a) => Planets a -> Planets a applyVelocity = S.map applyVelocityHere -applyVelocityHere here = here {_pos = (_pos here) ^+^ (_vel here)} +applyVelocityHere :: (NVec a) => Planet a -> Planet a +applyVelocityHere here = here {_pos = (_pos here) ^+^^ (_vel here)} + + + + +-- absSum (Vec1 (V1 x)) = (abs x) +-- absSum (Vec3 (V3 x y z)) = (abs x) + (abs y) + (abs z) + +potentalEnergy planet = nvAbsSum $ _pos planet +kineticEnergy planet = nvAbsSum $ _vel planet +totalEnergy planet = (potentalEnergy planet) * (kineticEnergy planet) + +systemEnergy = (S.foldl' (+) 0) . (S.map totalEnergy) @@ -93,7 +162,8 @@ coordsP = envector <$> (coordP `sepBy` commaP) coordP = identifierP *> equalP *> signedInteger -successfulParse :: Text -> [Vec] +-- successfulParse :: Text -> [Vec] +successfulParse :: Text -> [V3 Integer] successfulParse input = case parse planetsP "input" input of Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err -- 2.34.1