blob: efcbe8ace18ad452e27b9647aa1b4b24fd4d675a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
-- $ runhaskell parallel.hs 2000
import System(getArgs)
import Numeric.LinearAlgebra
import Control.Parallel.Strategies
import System.Time
inParallel = parMap rwhnf id
-- rdeepseq (or older rnf) not needed in this case
-- matrix product decomposed into p parallel subtasks
parMul p x y = fromBlocks [ inParallel ( map (x <>) ys ) ]
where ys = splitColumns p y
main = do
n <- (read . head) `fmap` getArgs
let m = ident n :: Matrix Double
time $ print $ vectorMax $ takeDiag $ m <> m
time $ print $ vectorMax $ takeDiag $ parMul 2 m m
time $ print $ vectorMax $ takeDiag $ parMul 4 m m
time $ print $ vectorMax $ takeDiag $ parMul 8 m m
time act = do
t0 <- getClockTime
act
t1 <- getClockTime
print $ tdSec $ normalizeTimeDiff $ diffClockTimes t1 t0
splitColumns n m = splitColumns' (f n (cols m)) m
where
splitColumns' [] m = []
splitColumns' ((a,b):rest) m = subMatrix (0,a) (rows m, b-a+1) m : splitColumns' rest m
f :: Int -> Int -> [(Int,Int)]
f n c = zip ks (map pred $ tail ks)
where ks = map round $ toList $ linspace (fromIntegral n+1) (0,fromIntegral c)
splitRowsAt p m = (takeRows p m, dropRows p m)
splitColumnsAt p m = (takeColumns p m, dropColumns p m)
|
