Data Parallel Bellman-Ford

Submitted by mrd on Thu, 11/29/2007 - 7:48pm.

Graph representation is as an edge-list.


bmf :: Int -> UArr (Int :*: Int :*: Double) -> Int -> UArr Double
bmf n es src = iterate rnd dm0 !! (n - 1)
where
dm0 = toU [ if i == src then 0 else inf | i <- [0 .. n - 1] ]
rnd dm =
updateU dm
(mapU (\ e ->
if distOf dm (destin e) > distOf dm (source e) + weight e
then (destin e) :*: (distOf dm (source e) + weight e)
else (destin e) :*: (distOf dm (destin e)))
es)


source = fstS . fstS
destin = sndS . fstS
weight = sndS
distOf dm u = dm !: u


inf :: Double
inf = 1 / 0

The above code uses NDP but only the sequential portions. In order to get parallelism I need to invoke the Distributed operations. However, there are also Unlifted.Parallel operations which hide the usage of the distributed ops.


bmf :: Int -> UArr (Int :*: Int :*: Double) -> Int -> UArr Double
bmf n es src = iterate (rnd es) dm0 !! (n - 1)
where
dm0 = toU [ if i == src then 0 else inf | i <- [0 .. n - 1] ]


{-# INLINE rnd #-}
rnd :: UArr (Int :*: Int :*: Double) -> UArr Double -> UArr Double
rnd es dm = updateU dm
. mapUP sndS
. filterUP fstS
. mapUP (\ e ->
let d = distOf dm (destin e)
d' = distOf dm (source e) + weight e
in if d > d'
then True :*: (destin e :*: d')
else False :*: (0 :*: 0))
$ es

mapUP is the unlifted parallelized version of mapU. However there's no updateUP. Looking into the code I spotted out a commented out version of updateUP. There are problems when figuring out what to do about multiple concurrent writes to one location. NESL specifies "arbitrary" resolution of conflicting concurrent writes. Unfortunately the commented code has bit-rotted and I haven't successfully managed to fix it.

I also added some filtering to prevent it from getting stuck writing Infinity over a real distance constantly, due to "arbitrary" resolution of conflicting writes in updateU. The iterative function is now factored out into its own toplevel definition, for clarity.