[Haskell-cafe] slow code

brian briand at aracnet.com
Mon Jun 15 23:39:42 EDT 2009


I have included a new and improved version.

Just to make the comparison a little more reasonable I re-wrote the  
program using ML and ran it with SMLNJ

eal	0m3.175s
user	0m0.935s
sys	0m0.319s

Here's the compiled haskell (ghc -O2 foo.hs -o foo):

real	0m16.855s
user	0m9.724s
sys	0m0.495s

OUCH.

I verified to make sure they were both writing valid data files.

I'm trying to learn how to fish, so I'm truly interested in finding  
out _how_ to optimize using profiling and other such tools.

Here's the header of the foo.prof file:

	total time  =        9.44 secs   (472 ticks @ 20 ms)
	total alloc = 2,171,923,916 bytes  (excludes profiling overheads)

2GB of allocation ??? with a base size of 131k.  that seems excessive,  
which gets me back to the ,  I don't
think I'm interpreting profiling stuff correctly.

This line is a little more interesting:

COST CENTRE               
MODULE                                               no.    entries   
%time %alloc   %time %alloc
  main                     
Main                                                 178           1   
98.7   99.1    98.7   99.1

So even though getData should be doing all of the allocation, main's  
using a lot of time and effort.  I figured it
was the show's that were slowing things up (how do I get profiling to  
show that detail ?), so I had it output just "\n".
Well that finishes in no time at all.

And yea, verily, the output of the .prof file.

	total time  =        0.14 secs   (7 ticks @ 20 ms)
	total alloc =  65,562,824 bytes  (excludes profiling overheads)

So I guess it's the show's, but I can't seem to find more efficient  
float output.
FFI to sprintf ? yuch.



Brian


foo.hs

import Numeric
import Complex
import IO

genData :: Double -> Int -> (Double -> Complex Double) -> ([Double],  
[Complex Double])
genData tstop n f =
     let deltat = tstop / (fromIntegral n)
         t = [ fromIntegral(i) * deltat | i <- [0..n-1]]
     in
       (t, map f t)

main =
     do let (t, y) = genData 100.0E-6 (2 ^ 17) (\x -> x :+ 0.0)
        h <- openFile "/dev/null" WriteMode
        mapM_ (\(x, y) ->
                   do hPutStr h ((showEFloat (Just 6) x) " ")
                      hPutStr h (showEFloat (Just 6)  (realPart y)  
"\n"))
                  (zip t y)
        hClose h
        print "Done"


foo.sml

let fun genData tstop n f =
         let val deltat = tstop / (Real.fromInt n)
             val t = List.tabulate(n, fn i => Real.fromInt(i) * deltat)
         in
             (t, map f t)
         end
     val (t, y) = genData 100.0E~6 131072 (fn x => (x, 0.0))
     val h = TextIO.openOut("data.txt")
in
     List.app
         (fn (x, (a,b)) =>
             (TextIO.output(h, Real.fmt (StringCvt.SCI(SOME 6)) x);
              TextIO.output(h, Real.fmt (StringCvt.SCI(SOME 6))  a ^  
"\n")))
         (ListPair.zip (t, y));
         TextIO.closeOut(h);
         print "Done";
         ()
end

On Jun 15, 2009, at 12:15 AM, Thomas ten Cate wrote:

> How much output does this generate? Does it matter if you send the
> output to /dev/null? This looks as if the bottleneck might well be in
> I/O operations, not in the code itself. To find this out, you could
> rewrite the code in C and see if that makes a difference?
>
> Thomas
>
> On Sun, Jun 14, 2009 at 20:44, brian<briand at aracnet.com> wrote:
>> Haskell Gurus,
>>
>> I have tried to use profiling to tell me what's going on here, but  
>> it hasn't
>> helped much, probably because I'm not interpreting the results  
>> correctly.
>>
>> Empirically I have determined that the show's are pretty slow, so an
>> alternative to them would be helpful.  I replaced the show's with  
>> "", and
>> compiled with -O2 and not much improvement.
>>
>> I need to write _a lot_ of code in this style.  A few words about  
>> how best
>> to do this would be helpful.  Laziness, infinite lists, uvector ??
>>
>> Help...
>>
>> Thanks,
>>
>> Brian
>>
>>
>> import Complex
>> import System.IO
>>
>> genData :: Double -> Int -> (Double -> Complex Double) -> ([Double],
>> [Complex Double])
>> genData tstop n f =
>>    let deltat = tstop / (fromIntegral n)
>>        t = [ fromIntegral(i) * deltat | i <- [0..n-1]]
>>    in
>>      (t, map f t)
>>
>> main =
>>    do let (t, y) = genData 100.0E-6 (2 ^ 15) (\x -> x :+ 0.0)
>>       h <- openFile "data.txt" WriteMode
>>       mapM_ (\(x, y) ->
>>                  do hPutStr h (show t)
>>                     hPutStr h " "
>>                     hPutStrLn h (show (realPart y)))
>>                 (zip t y)
>>       hClose h
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list