{-# LANGUAGE BangPatterns #-}
module Main where
import qualified BinaryTree as T
import qualified BreadthFirstSearch as BFS
import qualified Data.Char as Char
import Data.List
import Data.Bits
import System.CPUTime
import System.Environment
stats = foldl' (\(!s0,!s1,!s2) x -> (s0+1,s1+x,s2+x*x)) (0,0,0)
stddev (s0,s1,s2) = sqrt (s0 * s2 - s1 * s1) / s0
avg (s0,s1,s2) = s1 / s0
fib :: Int -> Int
fib n = snd . foldl' fib' (1, 0) $ dropWhile not $
[testBit n k | k <- let s = bitSize n in [s-1,s-2..0]]
where
fib' (f, g) p
| p = (f*(f+2*g), ss)
| otherwise = (ss, g*(2*f-g))
where ss = f*f+g*g
test string val = do
start <- getCPUTime
if val then return () else error ("Failed test: " ++ string)
end <- getCPUTime
return $! (end - start) `div` cpuTimePrecision
test' string f i n = do
ts <- mapM (test string . f) (replicate n i)
putStr string
putStr "\nTimings: "
print ts
putStr "Sum: "
print (sum ts)
putStr "Minimum: "
print (minimum ts)
putStr "Maximum: "
print (maximum ts)
let s = stats (map fromIntegral ts)
putStr "Mean: "
print (avg s)
putStr "Stddev: "
print (stddev s)
fromQueue f n = length (f (T.fib n)) == fib n - 1
fromUnit f n = (f (T.fib n)) == ()
main = do
xs <- getArgs
case xs of
(a1:a2:a3:_)
| all Char.isDigit a2 && all Char.isDigit a3
-> do_test a1 (read a2) (read a3)
_ -> help_message
do_test a1 i n
= case a1 of
"direct" -> test' a1 (fromQueue BFS.direct ) i n
"allison" -> test' a1 (fromQueue BFS.allison ) i n
"allison2" -> test' a1 (fromQueue BFS.allison2 ) i n
"corec1" -> test' a1 (fromQueue BFS.corec1 ) i n
"corec2" -> test' a1 (fromQueue BFS.corec2 ) i n
"st" -> test' a1 (fromUnit BFS.stq ) i n
"sidechan1" -> test' a1 (fromQueue BFS.sidechan1 ) i n
"sidechan2" -> test' a1 (fromQueue BFS.sidechan2 ) i n
"twostack" -> test' a1 (fromUnit BFS.twostack ) i n
"two_cpst" -> test' a1 (fromUnit BFS.twostack_cpst ) i n
"two_list" -> test' a1 (fromQueue BFS.twostack_list ) i n
"okasaki" -> test' a1 (fromUnit BFS.okasaki ) i n
"okasaki_list" -> test' a1 (fromQueue BFS.okasaki_list ) i n
"sequence" -> test' a1 (fromUnit BFS.sequence ) i n
"sequence_list" -> test' a1 (fromQueue BFS.sequence_list ) i n
"sequence2" -> test' a1 (fromUnit BFS.sequence2 ) i n
_ -> help_message
help_message = do
putStr "Usage: Time <test> <input> <number_of_trials>"
putStr "\n<test> is one of:"
putStr "\n direct for a corecursive traversal without using a monad"
putStr "\n allison Control.Monad.Queue.Allison"
putStr "\n allison2 as above, but uses deQ_break instead of deQ"
putStr "\n corec1 Control.Monad.Queue.Corec, does not demand result of ()"
putStr "\n corec2 as above, but demands ()"
putStr "\n sidechan1 SideChannelQ, like corec1"
putStr "\n sidechan2 like corec2"
putStr "\n twostack Two-Stack queues without a monad"
putStr "\n two_cpst uses Two-Stack queues inside a CpSt monad"
putStr "\n two_list produces a list of elements enqueued"
putStr "\n okasaki Data.Queue.Okasaki"
putStr "\n okasaki_list"
putStr "\n sequence Data.Sequence"
putStr "\n sequence_list"
putStr "\n sequence2 The wrong way to use sequence as a queue"
putStr "\n"
putStr "\ne.g. Test direct 30 10"
putStr "\n runs direct on the 30th fibbonacci tree 10 times"
putStr "\n Test direct 30 10 +RTS -H500M -sstderr"
putStr "\n as above, but uses a 500MB heap, and prints runtime stats"
putStr "\n"