# 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.