Timing computations: Difference between revisions

From HaskellWiki
(categeorise)
No edit summary
 
(2 intermediate revisions by the same user not shown)
Line 1: Line 1:
Timing an IO computation.
Timing an IO computation -- very basic approach. For a full featured, statistically sound benchmarking system, see the [http://hackage.haskell.org/package/criterion criterion] package.


<haskell>
<haskell>
Line 30: Line 30:
</haskell>
</haskell>


See also [[Timing out computations]].
See also [[Timing out computations]] and [[Timing computation in cycles]].
 
Timing a pure computation:
 
<haskell>
import Text.Printf
import Control.Exception
import System.CPUTime
import Control.Parallel.Strategies
import Control.Monad
import System.Environment
 
lim :: Int
lim = 10^6
 
time :: (Num t, NFData t) => t -> IO ()
time y = do
    start <- getCPUTime
    replicateM_ lim $ do
        x <- evaluate $ 1 + y
        rnf x `seq` return ()
    end  <- getCPUTime
    let diff = (fromIntegral (end - start)) / (10^12)
    printf "Computation time: %0.9f sec\n" (diff :: Double)
    printf "Individual time: %0.9f sec\n" (diff / fromIntegral lim :: Double)
    return ()
 
main = do
    [n] <- getArgs
    let y = read n
    putStrLn "Starting..."
    time (y :: Int)
    putStrLn "Done."
</haskell>


[[Category:Code]]
[[Category:Code]]
[[Category:Idioms]]
[[Category:Idioms]]
[[Category:How to]]
[[Category:How to]]

Latest revision as of 03:14, 27 January 2010

Timing an IO computation -- very basic approach. For a full featured, statistically sound benchmarking system, see the criterion package.

import Text.Printf
import Control.Exception
import System.CPUTime

time :: IO t -> IO t
time a = do
    start <- getCPUTime
    v <- a
    end   <- getCPUTime
    let diff = (fromIntegral (end - start)) / (10^12)
    printf "Computation time: %0.3f sec\n" (diff :: Double)
    return v

main = do
    putStrLn "Starting..."
    time $ product [1..10000] `seq` return ()
    putStrLn "Done."

And running this.

$ runhaskell A.hs
Starting...
Computation time: 1.141 sec
Done.

See also Timing out computations and Timing computation in cycles.

Timing a pure computation:

import Text.Printf
import Control.Exception
import System.CPUTime
import Control.Parallel.Strategies
import Control.Monad
import System.Environment

lim :: Int
lim = 10^6

time :: (Num t, NFData t) => t -> IO ()
time y = do
    start <- getCPUTime
    replicateM_ lim $ do
        x <- evaluate $ 1 + y
        rnf x `seq` return ()
    end   <- getCPUTime
    let diff = (fromIntegral (end - start)) / (10^12)
    printf "Computation time: %0.9f sec\n" (diff :: Double)
    printf "Individual time: %0.9f sec\n" (diff / fromIntegral lim :: Double)
    return ()

main = do
    [n] <- getArgs
    let y = read n
    putStrLn "Starting..."
    time (y :: Int)
    putStrLn "Done."