Skip to content

Instantly share code, notes, and snippets.

@jneira
Forked from josejuan/simple_floyd.hs
Last active Dec 11, 2015
Embed
What would you like to do?
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)
--}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment