[Haskell] Matrix multiplication
Tillmann Vogt
Tillmann.Vogt at rwth-aachen.de
Wed Apr 23 12:01:50 EDT 2008
Hi,
I am currently experimenting with parallelizing C-programs. I have
therefore written a matrix vector multiplication example that needs 13
seconds to run (5 seconds with OpenMP). Because I like Haskell I did the
same in this language, but it takes about 134 seconds. Why is it so
slow? Does someone have an idea?
module Main where
main = do putStrLn (show (stupid_mul 100))
putStrLn "100 multiplications done"
stupid_mul 0 = []
stupid_mul it = (s_mul it) : stupid_mul (it-1) -- without "it" after
s_mul only one multiplication is executed
s_mul it = mul (replicate 4000 [0..3999]) (replicate 4000 2)
mul :: [[Double]] -> [Double] -> [Double]
mul [] _ = []
mul (b:bs) c | sp==0 = sp : (mul bs c) -- always false, force evaluation
| otherwise = (mul bs c)
where sp = (scalar b c)
scalar :: [Double] -> [Double] -> Double
scalar _ [] = 0
scalar [] _ = 0
scalar (v:vs) (w:ws) = (v*w) + (skalar vs ws)
and here the C-program
#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#define M 4000
#define N 4000
#define IT 100
double a[M], b[M][N], c[N];
int main(int argc, char *argv[])
{
double d;
int i, j, l;
time_t start,end;
printf("Initializing matrix B and vector C\n");
for(j=0; j<N; j++) c[j] = 2.0;
for(i=0; i<M; i++) for(j=0; j<N; j++) b[i][j] = j;
printf("Executing %d matrix mult. for M = %d N = %d\n",IT,M,N);
time (&start);
for(l=0; l<IT; l++)
#pragma omp parallel for default(none) \
shared(a,b,c) private(i,j,l)
for(i=0; i<M; i++)
{
a[i] = 0.0;
for (j=0; j<N; j++) a[i] += b[i][j]*c[j];
}
time (&end);
d = difftime (end,start);
printf ("calculation time: %.2lf seconds\n", d );
return 0;
}
More information about the Haskell
mailing list