lazy vs ST

lazy_vs_st.hs

{-# LANGUAGE BangPatterns #-}
module Main (fib1, fib2, fib3, fib4, main) where
import Control.Monad
import Control.Monad.ST
import Data.STRef
import Data.List (transpose)
import Criterion.Main

fib1 :: Int -> Integer
fib1 n = fst $ fib' n
  where fib' 0 = (1, 1)
        fib' n = sum $ fib' (n-1)
        sum (!a, !b) = (b, a + b)

fib2 :: Int -> Integer
fib2 n = fib' (1,1) (n-1)
  where fib' (_, b) 0 = b
        fib' (a, b) n = fib' (b, a+b) (n-1)

fib3 :: Int -> Integer
fib3 n = runST $ do
    a <- newSTRef 1
    b <- newSTRef 1
    replicateM_ (n-1) $ do
        !a' <- readSTRef a
        !b' <- readSTRef b
        writeSTRef a b'
        writeSTRef b $! a'+b'
    readSTRef b

fib4 :: Int -> Integer
fib4 n = runST $ do
    a <- newSTRef 1
    b <- newSTRef 1
    replicateM_ (n-1) $ do
        !a' <- readSTRef a
        !b' <- readSTRef b
        if a' > b'
          then writeSTRef b $! a'+b'
          else writeSTRef a $! a'+b'
    a'' <- readSTRef a
    b'' <- readSTRef b
    if a'' > b''
      then return a''
      else return b''

fib5 :: Int -> Integer
fib5 n = head (apply (Matrix [[0,1], [1,1]] ^ n) [0,1])

apply :: Num a => Matrix a -> [a] -> [a]
apply (Matrix as) b = [sum (zipWith (*) a b) | a <- as]

newtype Matrix a = Matrix [[a]] deriving (Eq, Show)

instance Num a => Num (Matrix a) where
    Matrix as + Matrix bs = Matrix (zipWith (zipWith (+)) as bs)
    Matrix as - Matrix bs = Matrix (zipWith (zipWith (-)) as bs)
    Matrix as * Matrix bs =
       Matrix [[sum $ zipWith (*) a b | b <- transpose bs] | a <- as]
    negate (Matrix as) = Matrix (map (map negate) as)
    fromInteger x = Matrix (iterate (0:) (fromInteger x : repeat 0))
    abs m = m
    signum _ = 1

main = do
    let n = 20000
    defaultMain
      [ bgroup (show n)
          [ bench "normal"      $ whnf fib1 n
          , bench "tail recur"  $ whnf fib2 n
          , bench "st"          $ whnf fib3 n
          , bench "st'"         $ whnf fib4 n
          , bench "matrix"      $ whnf fib5 (n+1) -- fib5 从0开始
          ]
      ]
{-
$ ./fib
warming up
estimating clock resolution...
mean is 2.430830 us (320001 iterations)
found 1334 outliers among 319999 samples (0.4%)
  1041 (0.3%) high severe
estimating cost of a clock call...
mean is 151.1331 ns (21 iterations)
found 1 outliers among 21 samples (4.8%)
  1 (4.8%) high mild

benchmarking 20000/normal
mean: 6.115641 ms, lb 6.100790 ms, ub 6.162087 ms, ci 0.950
std dev: 122.1963 us, lb 47.71677 us, ub 268.5316 us, ci 0.950
found 4 outliers among 100 samples (4.0%)
  4 (4.0%) high severe
variance introduced by outliers: 13.233%
variance is moderately inflated by outliers

benchmarking 20000/tail recur
mean: 4.835402 ms, lb 4.833678 ms, ub 4.837395 ms, ci 0.950
std dev: 9.469107 us, lb 7.906513 us, ub 11.77748 us, ci 0.950

benchmarking 20000/st
mean: 5.073608 ms, lb 5.071842 ms, ub 5.075466 ms, ci 0.950
std dev: 9.284321 us, lb 8.119454 us, ub 10.78107 us, ci 0.950

benchmarking 20000/st'
mean: 5.384010 ms, lb 5.381876 ms, ub 5.386099 ms, ci 0.950
std dev: 10.85245 us, lb 9.510215 us, ub 12.65554 us, ci 0.950

benchmarking 20000/matrix
mean: 402.5543 us, lb 402.2955 us, ub 402.8452 us, ci 0.950
std dev: 1.407163 us, lb 1.250089 us, ub 1.613417 us, ci 0.950
-}