Haskell 中奇怪的执行时间

Question

I defined a memorized version of the factorial function. I observed that the second time I ran with the same parameter again, the execution time got greatly improved. But what confuses me is that both of them are much slower than the factorial function itself. For example, one run of the following program

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

-- test function
fact :: Int -> Int
fact n = product [1..n]

mem :: (Int -> Int) -> Int -> Int
mem f = (map f [0..] !!)

mem_fact = mem fact

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 $ fact 3000000 `seq` return ()
    time $ mem_fact 3000000 `seq` return ()
    time $ mem_fact 3000000 `seq` return ()
    putStrLn "Done."

produces the following output:

Starting...
Computation time: 0.008 sec
Computation time: 0.621 sec
Computation time: 0.047 sec
Done.

Why is calling fact so much faster than mem_fact ? Any explanations?

Answer 1

I agree with Daniel, much as I hate to (/s), that looking up the nth element in a linked list is slow and thus not the right way to memoize. One solution is to use a map or trie, but since this has already been done we can just leverage one of the many trie memoization packages on hackage.

Cutting to the chase:

• fact takes ~ 300 us
• Your list memoization takes ~ 1000 to 2000 us
• Using MemoTrie results in runtimes of ~ 0.4 us

This was determined by using your code and memotrie with Criterion:

import Data.MemoTrie
import Criterion.Main

end :: Int
end = 300000

tmdMemo :: Int -> Int
tmdMemo x = memo2 go 1 x
 where
   go :: Int -> Int -> Int
   go acc 1 = acc
   go acc n = let new = n*acc in new `seq` memo2 go new (n-1)


-- test function
fact :: Int -> Int
fact n = product [1..n]

mem :: (Int -> Int) -> Int -> Int
mem f = (map f [0..] !!)

gaoMemo :: Int -> Int
gaoMemo = mem fact

main :: IO ()
main = defaultMain [ bench "Normal"   $ nf fact end
                   , bench "TMD-Memo" $ nf tmdMemo end
                   , bench "Gao-Memo" $ nf gaoMemo end
                   ]

With the results of:

benchmarking Normal
time                 270.7 μs   (268.8 μs .. 272.7 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 271.7 μs   (270.4 μs .. 273.6 μs)
std dev              4.997 μs   (3.971 μs .. 6.812 μs)
variance introduced by outliers: 11% (moderately inflated)

benchmarking TMD-Memo
time                 379.3 ns   (376.2 ns .. 382.3 ns)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 381.5 ns   (378.0 ns .. 386.3 ns)
std dev              13.66 ns   (10.74 ns .. 17.59 ns)
variance introduced by outliers: 52% (severely inflated)

benchmarking Gao-Memo
time                 1.439 ms   (1.408 ms .. 1.469 ms)
                     0.996 R²   (0.994 R² .. 0.998 R²)
mean                 1.446 ms   (1.430 ms .. 1.467 ms)
std dev              63.31 μs   (53.75 μs .. 74.26 μs)
variance introduced by outliers: 31% (moderately inflated)