[Haskell-cafe] Re: haskell blas bindings: does iomatrix gemv transposing of matrix a?

Anatoly Yakovenko aeyakovenko at gmail.com
Wed Sep 24 04:30:32 EDT 2008


>> is there anyway the modifyWith functions could work on uboxed types?
>
> If they're inlined, the modify functions on boxed types may well end up
> unboxed.
>
> What's the particular problem you're having?

well, after inspecting a little further its not so bad actually.  i
was comparing

module Main where

import qualified Data.Vector.Dense.IO as Vector
import Control.Monad

e = exp 1.0
sigmoid xx = 1.0 / (1 + (e ** (1.0 * xx)))

type Vec = Vector.IOVector Int Double
main = do
   let size = 100000
   ff::Vec <- Vector.newListVector size $ repeat 0.5
   replicateM_ 1000 $ Vector.modifyWith (sigmoid) ff
   putStrLn $ "done"

to this:

#include "math.h"
#include "stdlib.h"
#include "stdio.h"

double sigmoid(double xx) {
   return 1.0 / (1.0 + (pow(M_E, (1.0 * xx))));
}

int main() {
   int size = 100000;
   int times = 1000;
   int ii,jj;
   double* array = malloc(sizeof(double)*size);
   for(jj = 0; jj < size; ++jj) {
      array[jj] = 0.5;
   }
   for(ii = 0; ii < times; ++ii) {
      for(jj = 0; jj < size; ++jj) {
         array[jj] = sigmoid(array[jj]);
      }
   }
   printf("done\n");
}

the haskell version does ok, or 0m37.937s vs 0m23.492s in C.  I am
compiling with these options: -O2 -fexcess-precision
-funbox-strict-fields -fglasgow-exts -fbang-patterns -prof -auto-all,
and O2 for gcc.


More information about the Haskell-Cafe mailing list