1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
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)
|
