[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 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
More information about the Haskell-Cafe
mailing list