# [Haskell-cafe] Implementation of the Floyd-Warshall algorithm

frederic at ka-ge-ro.org frederic at ka-ge-ro.org
Fri Jul 28 02:44:51 EDT 2006

```Hi,

I'm new to Haskell (yet I am very familiar with Lisp and OCaml), and
I am trying to implement the Floyd-Warshall algorithm (finding the
minimal distance between two nodes in a weighted graph).  For an input
graph with 101 nodes, the obvious C version takes 0.01 s on my machine.
My first totally functional implementation in Haskell took 6s... for
a graph with 10 edges.  (This version considered that a graph is given
as its adjacency matrix, which is represented as a 2-uple in
([k], k -> k -> Double)).  [I do not show my code, as I am ashamed of it :-S]
My first question is: what would an (efficient?) version of the algorithm
using this representation would look like ?  Is it possible to do without
ressorting to the ST monad ?

Now, I have been trying to implement it in a more imperative way,
to understand how the ST monad works.  It runs in 0.6s for a 101-noded
graph, which is much, much faster than the original version but still
much slower than the C version.  I would be very grateful if someone
cared to explain why this is unefficient and how to make it faster
(Without using the FFI :-|)
Thanks by advance.  (BTW, I'm using the ghc-6.42 compiler with -O2 flag).

--
Frederic Beal

-- Code begins here
module FW (bench)
where

import Data.Array.ST

update :: STUArray s (Int, Int) Double -> Int -> Int -> Int -> ST s ()
update arr i j k = do aij <- readArray arr (i, j)
ajk <- readArray arr (j, k)
aik <- readArray arr (i, k)
if aij + ajk < aik
then do writeArray arr (i, k) (aij + ajk)
else return ()

updateLine arr i j n = do mapM_ (update arr i j) [0..n]
updateRow arr i n    = do mapM_ (\x -> updateLine arr i x n) [0..n]
updateStep arr n     = do mapM_ (\x -> updateRow arr x n) [0..n]

-- The actual FW invocation

-- From here on, the "testing" suite
count = 100

-- A test array: M[i, j] = 1 + ((x+y) mod count)
orgArray :: ST s (STUArray s (Int, Int) Double)
orgArray = do v <- newArray ((0, 0), (count, count)) 0.0
mapM_ (\x -> mapM_
(\y -> writeArray
v (x, y)
((1+) \$ fromIntegral (mod (x+y) count)))
[0..count])
[0..count]
return v

sumDiag :: STUArray s (Int, Int) Double -> Int -> ST s Double
sumDiag arr n = do foldM (\y x -> do a <- readArray arr (x, x)
return \$ a + y) 0.0 [0..n]

orgDiag = do arr <- orgArray
v <- sumDiag arr count
return v

cptDiag = do arr <- orgArray
canonicalize arr count
v <- sumDiag arr count
return v

bench = do val <- stToIO cptDiag
diag <- stToIO orgDiag
print val
print diag

```