Commit cf40ee6d authored by Simon Marlow's avatar Simon Marlow

add warshall benchmark

parent ea0de670
# -----------------------------------------------------------------------------
#
# (c) 2009 The University of Glasgow
#
# This file is part of the GHC build system.
#
# To understand how the build system works and how to modify it, see
# http://hackage.haskell.org/trac/ghc/wiki/Building/Architecture
# http://hackage.haskell.org/trac/ghc/wiki/Building/Modifying
#
# -----------------------------------------------------------------------------
TOP = ../..
include $(TOP)/mk/boilerplate.mk
SRC_RUNTEST_OPTS += 400 400
SRC_HC_OPTS += -package parallel
include $(TOP)/mk/target.mk
{-# OPTIONS -cpp #-}
{-
warshall*.hs
Finding Shortest Paths in a Graph using the
Warshall algorithm and a ring topology.
author: Rita Loogen, Jost Berthold
Philipps-Universität Marburg
based on a concurrent Clean program in \cite{CleanBook}
Version for recursive ring skeleton and GpH-style ring,
to use in IFL08 paper on Parallel-Haskell-on-multicore.
------------------------------------------------- -}
module Main(main) where
import List
import System
import Data.List
-- import Eden
-- import EdenRing(badRing',ring,ringRec)
-- import EdiRing(edirings,ediringnames)
-- import PipeRings
#ifdef EAGER
import StrategiesEager(parList)
#else
import Control.Parallel.Strategies
#endif
--rings = {- [seqring,badRing',ring,ringRec] ++ edirings ++ piperings
-- ++ -} [gphRing] -- ring size parameter == total no. of sparks
-- ringnames = {- ["seq. ring","Eden badRing'","Eden ring","Eden ringRec"]
-- ++ ediringnames ++ piperingNames ++ -} ["GpH ring"]
-- gph ring, simply by sparking all ring process outputs
-- (granularity control by ring size)
gphRing np splitIn combOut ringF input
= combOut (outs `using` parList rnf )
where ringIns = splitIn np input
(outs,rComm) = foldl' fld ([],rComm) ringIns
-- fld :: ([o],[r]) -> i -> ([o],[r])
fld (outs,rIn) inp = let (out,rOut) = ringF (inp,rIn)
in (out:outs, rOut)
-- reference: sequential version
seqring np splitIn combOut ringF input
= combOut outs
where ringIns = splitIn np input
(outs,rComm) = foldl' fld ([],rComm) ringIns
-- fld :: ([o],[r]) -> i -> ([o],[r])
fld (outs,rIn) inp = let (out,rOut) = ringF (inp,rIn)
in (out:outs, rOut)
type Matrix a = [[a]]
dim :: Matrix a -> Int
dim = length
-- warshallRing' :: Int -> Matrix Int -> Matrix Int
-- warshallRing' _ mat = warshallRing (mat, dim mat)
--
-- -- ring size = matrix dimension
-- warshallRing :: (Matrix Int,Int) -> Matrix Int
-- warshallRing (mat,n) = ring (length mat) split concat rf (mat,n)
-- where
-- split n (mat,_) = zip (splitIntoN n mat) [1..n]
-- rf (([row],k), inpleft) = ([sol],outp)
-- where (sol,outp) = ring_iterate (length row) k 1 row inpleft
-- ring size = parameter np
wr2 :: Int -> Matrix Int -> Matrix Int
--wr2 v _ mat | (v == length ringnames - 1)
-- -- treat as a special case, want many more sparks!
-- = wr_ gphRing (length mat) mat
wr2 np mat = wr_ gphRing np mat
-- wr_ :: ring skel type -> Int -> Matrix Int -> Matrix Int
wr_ ring np mat = ring np split concat ringf (mat,0) -- ring type issue, 0 is dummy parameter
where split :: Int -> (Matrix Int, Int) -> [ (Matrix Int, Int )]
-- ring size all input [ (some rows ,no. of 1st row)]
split n (mat,_) = let inputrows = splitIntoN n mat -- [[r1..rk],[r(k+1)..r(2k)]..[r(i*k)..r(dim mat)]]
in zip inputrows (scanl (+) 1 (map length inputrows)) -- should be "(init (scanl (+)...)"
ringf :: ((Matrix Int, Int), [[Int]] ) -> ( Matrix Int , [[Int]])
-- ((some rows,start),more rows) -> ( result rows , rows for ring)
ringf ((rows,startrow), fromLeft) = create_procs (length $ head rows) startrow rows fromLeft --
-- sequential version from Clean book
warshall :: Int -> Matrix Int -> Matrix Int
warshall _ mat = solution
where (solution, output) = create_procs (length mat) 1 mat output
create_procs :: Int -> Int -> Matrix Int -> [[Int]] -> ([[Int]],[[Int]])
create_procs size k [rowN] inputleft = ([rowNsolution], output)
where (rowNsolution, output) = ring_iterate size k 1 rowN inputleft
create_procs size k (rowk:restmat) inputleft = (rowksolution:restsolutions, outputN)
where (rowksolution, outputk) = ring_iterate size k 1 rowk inputleft
(restsolutions, outputN) = create_procs size (k+1) restmat outputk
ring_iterate :: Int -> Int -> Int -> [Int] -> [[Int]] -> ([Int],[[Int]])
ring_iterate size k i rowk rows
| i > size = (rowk, []) --iterations_finished
| i == k = (solution, rowk:restoutput) -- start_sending_this_row
| otherwise = (solution, rowi:restoutput)
where rowi:xs = rows
(solution, restoutput) = rnf nextrowk `seq`
ring_iterate size k (i+1) nextrowk xs
nextrowk | i == k = rowk -- no update for own row
| otherwise = updaterow rowk rowi distki
distki = rowk!!(i-1)
--updaterow ::
updaterow [] rowi distij = []
updaterow (distjk:restrowj) (distik:restrowi) distji
= min distjk (distji + distik):updaterow restrowj restrowi distji
-------------------------------------------------------------------------------
usage :: String
usage = "Usage:\n" ++
"\t #> warshall <size> <ring size: default noPe> <..rest is ignored..>\n"
main = do [size,noPe] <- fmap (map read) getArgs
let res = wr2 noPe (m1 size)
-- print res
rnf res `seq` putStrLn "done"
test6 :: Matrix Int
test6 = [[ 0, 100, 100, 13, 100, 100], [100, 0, 100, 100, 4,9],
[11, 100, 0, 100, 100, 100], [100, 3, 100, 0, 100, 7],
[15, 5, 100, 1, 0, 100], [11, 100, 100, 14, 100, 0]]
{-
Adjacency Matrix Shortest Paths:
- - To - -
[[ 0 , 100, 100, 13, 100, 100], [[ 0,16,100,13,20,20],
F [100 , 0, 100, 100, 4, 9], [19, 0,100, 5, 4, 9],
r [ 11 , 100, 0, 100, 100, 100], [11,27, 0,24,31,31],
o [100 , 3, 100, 0, 100, 7], [18, 3,100, 0, 7, 7],
m [ 15 , 5, 100, 1, 0, 100], [15, 4,100, 1, 0, 8],
[ 11 , 100, 100, 14, 100, 0]] [11,17,100,14,21, 0]]
-}
test3 :: [[Int]]
test3 = [[0,1,100],[1,0,1],[100,1,0]]
m1 size = replicate size [1..size]
m2 size = listToListList size [1..size*size]
mA size = if size <= 4000 then m1 size else listToListList size (concat (take 20 (repeat [1..(size*size `div` 20)])))
mB size = if size <= 4000 then m1 size else listToListList size (concat (take 20 (repeat [0,2.. ((size*size) `div` 20)-2])))
listToListList c m
| length m <= c = [m]
| otherwise = c1 : listToListList c resto
where (c1,resto) = splitAt c m
---------------------
splitIntoN :: Int -> [a] -> [[a]]
splitIntoN n xs = takeIter parts xs
where l = length xs
parts = zipWith (+) ((replicate (l `mod` n) 1) ++ repeat 0)
(replicate n (l `div` n))
takeIter :: [Int] -> [a] -> [[a]]
takeIter [] [] = []
takeIter [] _ = error "elements left over"
takeIter (t:ts) xs = hs : takeIter ts rest
where (hs,rest) = splitAt t xs
unshuffle :: Int -> [a] -> [[a]]
unshuffle n xs = [takeEach n (drop i xs) | i <- [0..n-1]]
where takeEach n [] = []
takeEach n (x:xs) = x : takeEach n (drop (n-1) xs)
-- inverse to unshuffle
shuffle :: [[a]] -> [a]
shuffle = concat . transpose
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment