Bad performance for parallel N-Body in Haskell - haskell

Question

I wrote an N-body implementation in Haskell and tried to parallelize the updating of position of the particles (outer loop) using parList. However, the performance improvement from 1 to 3 cores is small, and it actually becomes worse for 4 cores. Here is the code, using 5 particles:
import Numeric.LinearAlgebra
import Data.List (zipWith4)
import Data.List.Split
import Control.DeepSeq
import System.Environment
import Control.Parallel.Strategies
type Vec = Vector Double
data Particle = Particle
{ tag :: Int
, position :: !Vec
, velocity :: !Vec
, mass :: Double
}
instance Eq Particle where
p1 == p2 = (tag p1) == (tag p2)
instance Show Particle where
show p = show $ position p
instance NFData Particle where
rnf p = t `seq` ps `seq` vel `seq` m `seq` ()
where
t = tag p
ps = position p
vel = velocity p
m = mass p
data System = System
{ number :: Int
, particles :: [Particle]
}
instance Show System where
show sys = show (particles sys)
instance NFData System where
rnf sys = rnf $ particles sys
g :: Double
g = 6.674e-11
-- | Construct a vector from a list of elements
mkVector :: [Double] -> Vec
mkVector = vector
-- | Construct a system from a given list of
-- position vectors, velocity vectors, and masses
mkSystem :: [(Vec, Vec, Double)] -> System
mkSystem xs = System
{ number = length xs
, particles = map (apply Particle) $ zipWith cons [0..] xs
}
where
cons y (a, b, c) = (y, a, b, c)
apply f (y, a, b, c) = f y a b c
-- | Calculate the gravitational force vector acted on p1 by p2
getForce :: Particle -> Particle -> Vec
getForce p1 p2
| p1 == p2 = scalar 0.0
| otherwise = scalar (g * (m1 * m2 / r^2)) * unit
where
m1 = mass p1
m2 = mass p2
r1 = position p1
r2 = position p2
dr = r2 - r1
r = norm_2 dr
unit = normalize dr
-- | Calculate the net gravitational force acted on the particle by
-- all the other particles
netForce :: Particle -> [Particle] -> Vec
netForce p ps = sum (map (getForce p) ps)
-- | Update the position and velocity of a particle in the system
-- through a given timestep
move :: Double -> System -> Particle -> Particle
move h sys p = let
(pos, vel) = (position p, velocity p)
acc = (netForce p $ particles sys) / (scalar $ mass p)
in
p { position = pos + scalar h * vel
, velocity = vel + scalar h * acc
}
stepSize = 1000
-- | Update the system through one timestep
evolve :: System -> System
evolve sys = sys { particles = ps' }
where
ps' = map (move stepSize sys) (particles sys) `using` parList rdeepseq
-- | Stream of system at different timesteps
evolution :: System -> [System]
evolution = iterate evolve
sys1 :: System
sys1 = mkSystem
[ (mkVector [1.496e11, 0], mkVector [0, 2.98e4], 5.974e24)
, (mkVector [2.279e11, 0], mkVector [0, 2.41e4], 6.42e23)
, (mkVector [5.79e10, 0], mkVector [0, 4.8e4], 3.3e23)
, (mkVector [0, 0], mkVector [0, 0], 1.98e30)
, (mkVector [ 1.08e11, 0], mkVector [0, 3.5e4], 4.87e24)
]
main :: IO ()
main = do
[n] <- fmap (map read) getArgs :: IO [Int]
let states = evolution sys1
finalState = states !! n
finalState `deepseq` (return ())
What is limiting the parallelism?

Answer 1

Two thoughts:
I don't recommend HMatrix. It's a “Matlab in a box” library, which not only goes strongly against Haskell's grain in terms of semantics (dynamical dimension checking† etc.) but also subverts Haskell's better sides in performance. The idea of HMatrix/Matlab is to work with large, monolithic, heap-allocated arrays and do as much as possible with linear algebra primitives (which are implemented in C). This approach makes sense in a slow language like Matlab or Python (you delegate the inner loops to another, faster language), but not really in Haskell: the external calls can't properly be inlined, unlike native Haskell functions, and they add some overhead which though it may be negligible when crunching large vectors, can definitely add up for small ones. Pointer indirection harms cache performance.
The most popular static, native LA library is linear, which takes a much more Haskell-oriented approach (functors everywhere), and has proper tight memory layout. (I'm actually not such a fan of the interface itself, but the data types can also be used with the very nice vector-space operators.)
Switching to the types from linear improves the performance (single-threaded) by a factor 10 for me.
import Data.VectorSpace
import Data.VectorSpace.Free
import Linear.V2
import Data.List (zipWith4)
import Data.List.Split
import Control.DeepSeq
import System.Environment
import Control.Parallel.Strategies
type Vec = V2 Double -- In case you're wondering: you don't need to
-- hard-code the dimension, you can also make your
-- functions _polymorphic_ on the vector space.
data Particle = Particle
{ tag :: !Int
, position :: !Vec
, velocity :: !Vec
, mass :: !Double
}
instance Eq Particle where
p1 == p2 = (tag p1) == (tag p2)
instance Show Particle where
show p = show $ position p
instance NFData Particle where
rnf p = t `seq` ps `seq` vel `seq` m `seq` ()
where
t = tag p
ps = position p
vel = velocity p
m = mass p
data System = System
{ number :: Int
, particles :: [Particle]
}
instance Show System where
show sys = show (particles sys)
instance NFData System where
rnf sys = rnf $ particles sys
g :: Double
g = 6.674e-11
-- | Construct a vector from a list of elements
mkVector :: [Double] -> Vec
mkVector [x,y] = V2 x y
-- | Construct a system from a given list of
-- position vectors, velocity vectors, and masses
mkSystem :: [(Vec, Vec, Double)] -> System
mkSystem xs = System
{ number = length xs
, particles = map (apply Particle) $ zipWith cons [0..] xs
}
where
cons y (a, b, c) = (y, a, b, c)
apply f (y, a, b, c) = f y a b c
-- | Calculate the gravitational force vector acted on p1 by p2
getForce :: Particle -> Particle -> Vec
getForce p1 p2
| p1 == p2 = zeroV
| otherwise = (g * (m1 * m2 / r^2)) *^ unit
where
m1 = mass p1
m2 = mass p2
r1 = position p1
r2 = position p2
dr = r2 - r1
r = magnitude dr
unit = dr ^/ r
-- | Calculate the net gravitational force acted on the particle by
-- all the other particles
netForce :: Particle -> [Particle] -> Vec
netForce p ps = sum (map (getForce p) ps)
-- | Update the position and velocity of a particle in the system
-- through a given timestep
move :: Double -> System -> Particle -> Particle
move h sys p = let
(pos, vel) = (position p, velocity p)
acc = (netForce p $ particles sys) ^/ mass p
in
p { position = pos ^+^ h *^ vel
, velocity = vel ^+^ h *^ acc
}
stepSize = 1000
-- | Update the system through one timestep
evolve :: System -> System
evolve sys = sys { particles = ps' }
where
ps' = map (move stepSize sys) (particles sys) `using` parList rdeepseq
-- | Stream of system at different timesteps
evolution :: System -> [System]
evolution = iterate evolve
sys1 :: System
sys1 = mkSystem
[ (mkVector [1.496e11, 0], mkVector [0, 2.98e4], 5.974e24)
, (mkVector [2.279e11, 0], mkVector [0, 2.41e4], 6.42e23)
, (mkVector [5.79e10, 0], mkVector [0, 4.8e4], 3.3e23)
, (mkVector [0, 0], mkVector [0, 0], 1.98e30)
, (mkVector [ 1.08e11, 0], mkVector [0, 3.5e4], 4.87e24)
]
main :: IO ()
main = do
[n] <- fmap (map read) getArgs :: IO [Int]
let states = evolution sys1
finalState = states !! n
finalState `deepseq` (return ())
I wouldn't expect too gain much from parallelisation for only five particles anyhow. Each thread has very little it can do before giving back control, and everything interacts. You therefore quickly notice the overhead even of Haskell's light green threads.
To benefit properly from parallelisation, you'll need to either set up the threads as a thread pool (like you would in traditional number-crunching languages) and thus avoid the sparking overhead, or make sure each thread has a lot to do. This works best if you mostly decouple the threads' domains; in really-many body applications this is done with something like a Barnes-Hut simulation.
Another thing: you're right now using a simple Euler solver for solving the equations of motion. That's a very bad scheme. Switching to a higher-order Runge Kutta solver, ideally with adaptive step size, would allow you to save so much in terms of number of steps that the parallelisation aspect largely pales in impact by comparison.
†Actually, HMatrix also has had a statically checked module for quite some time now.