From 9033932bc84539b495074f809a134881bc00b92c Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Thu, 12 Dec 2019 13:42:27 +0100
Subject: Day 12

---
 2019/12.hs | 84 ++++++++++++++++++++++++++++++--------------------------------
 1 file changed, 40 insertions(+), 44 deletions(-)

(limited to '2019/12.hs')

diff --git a/2019/12.hs b/2019/12.hs
index b5e8274..81d20ae 100644
--- a/2019/12.hs
+++ b/2019/12.hs
@@ -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
-- 
cgit v1.2.3-54-g00ecf