1 files changed, 102 insertions, 0 deletions
diff --git a/2017/20.hs b/2017/20.hs
new file mode 100644
index 0000000..497ff58
--- /dev/null
+++ b/2017/20.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE TupleSections #-}
+import Control.Monad
+import Data.Function
+import Data.List
+import Data.Maybe
+import Debug.Trace
+
+
+uniqOn :: Eq b => (a -> b) -> [a] -> [a]
+uniqOn f (a:b:cs) | f a == f b = uniqOn f (b:cs)
+                  | otherwise = a : uniqOn f (b:cs)
+uniqOn _ l = l
+
+cartprod3 :: [a] -> [b] -> [c] -> [(a, b, c)]
+cartprod3 as bs cs = [(a, b, c) | a <- as, b <- bs, c <- cs]
+
+type Vec = (Int, Int, Int)
+
+data Particle = Particle {pP :: Vec, pV :: Vec, pA :: Vec}
+  deriving (Show, Eq)
+
+add :: Vec -> Vec -> Vec
+add (a, b, c) (d, e, f) = (a + d, b + e, c + f)
+
+sub :: Vec -> Vec -> Vec
+sub (a, b, c) (d, e, f) = (a - d, b - e, c - f)
+
+mul :: Int -> Vec -> Vec
+mul n (a, b, c) = (n * a, n * b, n * c)
+
+parse :: String -> Particle
+parse str =
+    let [p, v, a] = map (parseVec . init . init . drop 3) (words (str ++ ","))
+    in Particle p v a
+
+parseVec :: String -> Vec
+parseVec str =
+    let [x, y, z] = map read (words [if c == ',' then ' ' else c | c <- str])
+    in (x, y, z)
+
+man :: Vec -> Int
+man (x, y, z) = abs x + abs y + abs z
+
+vecmax :: Vec -> Int
+vecmax (x, y, z) = maximum [abs x, abs y, abs y]
+
+distance :: Particle -> Int
+distance = man . pP
+
+simulate :: Int -> Particle -> Particle
+simulate t (Particle pos vel acc) =
+    let p = add pos $ add (mul t vel) $ mul (t * (t + 1) `div` 2) acc
+        v = add vel (mul t acc)
+    in Particle p v acc
+
+collide' :: Int -> Int -> Int -> [Int]
+collide' dp' dv' da' =
+    let (dp, dv, da) = (fromIntegral dp', fromIntegral dv', fromIntegral da') :: (Double, Double, Double)
+        discr = (dv + da/2) ^ 2 - 2 * da * dp
+        s = sqrt discr
+        t1 = (-dv - da/2 + s) / da
+        t2 = (-dv - da/2 - s) / da
+        rt1 = round t1
+        rt2 = round t2
+    in if discr < 0 || s * s /= discr then []
+       else (if t1 >= 0 && fromIntegral rt1 == t1 then [rt1] else []) ++
+            (if t2 >= 0 && fromIntegral rt2 == t2 then [rt2] else [])
+
+collide :: Particle -> Particle -> Maybe Int
+collide part1@(Particle p1 v1 a1) part2@(Particle p2 v2 a2) =
+    let (dpx, dpy, dpz) = sub p1 p2
+        (dvx, dvy, dvz) = sub v1 v2
+        (dax, day, daz) = sub a1 a2
+        ts = [a
+             | (a, b, c) <- cartprod3 (collide' dpx dvx dax) (collide' dpy dvy day) (collide' dpz dvz daz),
+               a == b && b == c]
+        [] = [pP (simulate t part1) /= pP (simulate t part2) | t <- ts]
+    in if null ts then Nothing else Just (minimum ts)
+
+prune :: [Particle] -> [Particle]
+prune parts = case traceShowId $ groupBy ((==) `on` snd) $ sortOn snd $
+                       catMaybes [fmap ((pi, qi),) (collide p q)
+                                 | (p, pi) <- zip parts [0..], (q, qi) <- zip parts [0..], pi /= qi]
+              of
+    [] -> parts
+    (colls : _) ->
+        let indices = concatMap (\((a, b), _) -> [a, b]) colls
+            parts' = [p | (p, i) <- zip parts [0..], not (i `elem` indices)]
+        in prune parts'
+
+main :: IO ()
+main = do
+    input <- liftM (map parse . lines) (readFile "20.in")
+    let bigt = maximum (map (vecmax . pP) input)
+        parts = map (simulate bigt) input
+        sorted = sortOn (man.pA.fst) $ sortOn (man.pV.fst) $ sortOn (man.pP.fst) $ zip parts [0..]
+    print $ head (map snd sorted)
+
+    print $ length $ iterate (map head . filter ((== 1) . length) . groupBy ((==) `on` pP) . sortOn pP . map (simulate 1)) (sortOn pP input) !! 100
+    -- mapM_ print $ groupBy ((==) `on` snd) $ sortOn snd $ catMaybes [fmap ((pi, qi),) (collide p q) | (p, pi) <- zip input [0..], (q, qi) <- zip input [0..]]
+
+    -- print $ length (prune input)