diff options
Diffstat (limited to '2019')
| -rw-r--r-- | 2019/12.hs | 84 |
1 files changed, 40 insertions, 44 deletions
@@ -2,62 +2,58 @@ module Main where import Data.Char import Data.List +import Data.Maybe import Input -data Vec = Vec Int Int Int deriving (Show) - -instance Num Vec where -- elementwise - Vec a b c + Vec x y z = Vec (a + x) (b + y) (c + z) - Vec a b c * Vec x y z = Vec (a * x) (b * y) (c * z) - abs (Vec a b c) = Vec (abs a) (abs b) (abs c) - signum (Vec a b c) = Vec (signum a) (signum b) (signum c) - negate (Vec a b c) = Vec (negate a) (negate b) (negate c) - fromInteger n = let n' = fromInteger n in Vec n' n' n' - -coordinates :: Vec -> [Int] -coordinates (Vec a b c) = [a, b, c] - -fromCoordinates :: [Int] -> Vec -fromCoordinates [a, b, c] = Vec a b c -fromCoordinates _ = error "Invalid length of list in fromCoordinates" - -parseVec :: String -> Vec -parseVec = fromCoordinates . map read . tokens (3 :: Int) +parseVec :: String -> [Int] +parseVec = map read . tokens (3 :: Int) where tokenf c = isDigit c || c == '-' token str = span tokenf (snd (break tokenf str)) tokens 0 _ = [] tokens n str = uncurry (:) (fmap (tokens (n - 1)) (token str)) -data Moon = Moon { mPos :: Vec, mVel :: Vec } deriving (Show) -data System = System [Moon] deriving (Show) +data Moon1D = Moon1D { mPos :: {-# UNPACK #-} !Int, mVel :: {-# UNPACK #-} !Int } deriving (Show, Eq) +newtype System1D = System1D [Moon1D] deriving (Show, Eq) gravity1D :: [Int] -> [Int] -gravity1D inCoords = - let (coords, backIndices) = unzip (sortOn fst (zip inCoords [0::Int ..])) - cumBeforeOf cds = map fst (scanl (\(nb, ct) (a, b) -> - if a < b then (nb + ct, 1) else (nb, ct + 1)) - (0, 1) (zip cds (tail cds))) - cumBefore = cumBeforeOf coords - cumAfter = reverse (cumBeforeOf (map negate (reverse coords))) - grav = zipWith (-) cumAfter cumBefore - in map snd (sortOn fst (zip backIndices grav)) - -physics :: System -> System -physics (System moons) = - let gravity = map fromCoordinates . transpose . map gravity1D . transpose . map (coordinates . mPos) $ moons - moons1 = zipWith (\(Moon p v) g -> Moon p (v + g)) moons gravity - moons2 = [Moon (p + v) v | Moon p v <- moons1] - in System moons2 - -class Energy a where energy :: a -> Int -instance Energy Vec where energy = sum . coordinates . abs -instance Energy Moon where energy (Moon p v) = energy p * energy v -instance Energy System where energy (System moons) = sum (map energy moons) +gravity1D coords = [length (filter (> x) coords) - length (filter (< x) coords) | x <- coords] + +-- -- If there are MANY moons, the below will be faster (n log n instead of n^2) +-- gravity1D :: [Int] -> [Int] +-- gravity1D inCoords = +-- let (coords, backIndices) = unzip (sortOn fst (zip inCoords [0::Int ..])) +-- cumBeforeOf cds = map fst (scanl (\(nb, ct) (a, b) -> +-- if a < b then (nb + ct, 1) else (nb, ct + 1)) +-- (0, 1) (zip cds (tail cds))) +-- cumBefore = cumBeforeOf coords +-- cumAfter = reverse (cumBeforeOf (map negate (reverse coords))) +-- grav = zipWith (-) cumAfter cumBefore +-- in map snd (sortOn fst (zip backIndices grav)) + +physics1D :: System1D -> System1D +physics1D (System1D moons) = + let gravity = gravity1D (map mPos moons) + moons1 = zipWith (\(Moon1D p v) g -> Moon1D p (v + g)) moons gravity + moons2 = [Moon1D (p + v) v | Moon1D p v <- moons1] + in System1D moons2 + +energy :: [System1D] -> Int +energy systems = + let moons = transpose [moons1d | System1D moons1d <- systems] + moonEnergy moon1ds = sum (map (abs . mPos) moon1ds) * sum (map (abs . mVel) moon1ds) + in sum (map moonEnergy moons) main :: IO () main = do - initSys <- System . map (\line -> Moon (parseVec line) 0) <$> getInput 12 - print $ energy ((iterate physics initSys) !! 1000) + initSystems <- map System1D . transpose . map (map (\p -> Moon1D p 0) . parseVec) <$> getInput 12 + + print $ energy [iterate physics1D s !! 1000 | s <- initSystems] + + -- Note: any cycle must contain the starting position, because the + -- simulation step is uniquely reversible. -- Credits Bert + let reps = [1 + fromJust (findIndex (== initSystem) (tail (iterate physics1D initSystem))) + | initSystem <- initSystems] + print $ foldl1 lcm reps |