[Haskell-beginners] Calling a foreign function: superlinear comlexity

Edward Z. Yang ezyang at MIT.EDU
Sun Apr 17 01:05:36 CEST 2011


I suspect you want something a little more clever.  In particular, because
replicateM uses sequence under the hood, which is quite strict: it requires
all of the IO actions to be evaluated before evaluation continues, so you
end up with a big list built up in memory before it gets summed by 'sum'.
I suspect if you run it manually with something like this you might do better:

    let loop 0 s = return s
        loop n s = do
            x <- c'gsl_rng_uniform rng
            loop (n-1) (s+x)
    print =<< loop n 0

With an actually pure function, you can do it more nicely, but it's a bit
more fragile that way.  Lazy IO would be another mechanism, although some
people regard that to be a bit evil (and you'd still need to write the
lazy IO equivalent of sequence).

Edward

Excerpts from Serguei Son's message of Sun Apr 10 19:26:16 -0400 2011:
> I call GSL's gsl_ran_ugaussian function in the following way (using
> bindings-gsl):
> 
> module Main where
> 
> import Bindings.Gsl.RandomNumberGeneration
> import Bindings.Gsl.RandomNumberDistributions
> import Foreign
> import Control.Monad
> import Data.List
> 
> main = do
>         let n = 100000
>     p <- peek p'gsl_rng_mt19937
>     rng <- c'gsl_rng_alloc p
>     lst <- replicateM n $ c'gsl_rng_uniform rng
>     print $ sum lst    
> 
> As I increase n from 10^4 to 10^5 to 10^6 execution time grows superlinearly.
> 
> To forestall the answer that the reason is the overhead of List, 
> this code scales approximately linearly:
> 
> module Main where
> 
> 
> import Foreign
> import Control.Monad
> import Data.List
> 
> main = do
>         let n = 100000
>     let lst = map sin [1..n]
>     print $ sum lst    
> 
> Another interesting observation: when I wrap the sin function 
> of math.h with signature CDouble -> IO CDouble calling it 
> repeatedly scales superlinearly, whereas when I wrap it as a pure 
> function calling it repeatedly scales linearly.
> 
> What is the reason for this performance and how can 
> I make the first code scale linearly in execution time?
> 



More information about the Beginners mailing list