# Data Parallel Bellman-Ford

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.

- mrd's blog
- Login to post comments