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

[frederic at ka-ge-ro.org]

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 Control.Monad
import Control.Monad.ST
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
canonicalize = updateStep



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