simple_floyd.hs

module JJFW where
import Data.Map hiding (map)
import Data.Array.IO
import Control.Monad (forM_)
import System.Time
import System.IO

type Edge = (Int,Int)
type EdgeCost = (Edge,Int)
type IOAcc = IOUArray (Int,Int) Int

-- slow but simple load (better avoiding intermediate list)
readWords :: Read a => String -> [a]
readWords s= ws
 where ws=map read $ words s

readItem :: String -> EdgeCost
readItem str=((i,j),c)
 where [i,j,c]=readWords str

readData :: FilePath -> IO (Int,[EdgeCost])
readData file= do
 (h:s) <-lines `fmap` readFile file
 let [n,_]=readWords h
     items=map readItem s
 return (n,items)

infinite=50000

initFWIO :: Int -> [EdgeCost] -> IO IOAcc
initFWIO n ec= do
  let ec'=fromList ec
      f i j | i==j = 0
        | otherwise=findWithDefault infinite (i,j) ec'
      items= [f i j|i<-[1..n],j<-[1..n]]
  newListArray ((1,1),(n,n)) items

sol file = do
  (n,items)<-readData file
  
  w <- initFWIO n items

  putStrLn "Computing distances..."  
  t0 <- getClockTime
  
  ((lb, _), (ub, _)) <- getBounds w
  let r = [lb..ub]
  -- can be parallelized!!!
  forM_ [1..2] $ \k -> do
    forM_ r $ \x -> do
      forM_ r $ \y -> do
        xk <- readArray w (x, k)
        ky <- readArray w (k, y)
        xy <- readArray w (x, y)
        writeArray w (x, y) $ min xy (xk + ky)
  
  t1 <- getClockTime
  putStrLn "End..."  

  if ub < 40
  then  
    forM_ [lb..ub] $ \x -> do
      forM_ [lb..ub] $ \y -> do
        readArray w (x, y) >>= putStr . (++ ", ") . show
      putStrLn "|"
  else
    return ()

  putStrLn ("Time: " ++ show (diffClockTimes t1 t0))

{--
Computing distances...
End...
Time: TimeDiff {tdYear = 0, tdMonth = 0, tdDay = 0, tdHour = 0, tdMin = 0, tdSec = 32, tdPicosec = -77000000000}
(31.28 secs, 4702380308 bytes)
--}