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

[Chris Kuklewicz]

Every readArray and writeArray checks that the index tuple is in range.

You could try an use Data.Array.Base (in GHC) and unsafeWrite and unsafeRead. 
They do not do bounds checking like readArray and writeArray.

Oleg has a good interface to unchecked array usage here:
http://okmij.org/ftp/Haskell/types.html#branding

-- 
Chris


frederic at ka-ge-ro.org wrote:
> 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
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe