{-# LANGUAGE DeriveDataTypeable #-} import Control.Monad import Data.Data import Data.Foldable import Data.List import Test.QuickCheck import Data.Random.Generics data T = N T T | L deriving (Eq, Ord, Show, Data) -- size s :: T -> Int s (N l r) = 1 + s l + s r s L = 0 main = for_ [ 4 ^ e | e <- [2 .. 4] ] $ \n -> for_ [ ("reject ", generatorSR) , ("rejectSimple ", generatorR') , ("point ", generatorP') , ("pointReject ", generatorPR') ] $ \(name, g) -> stats (name ++ show n) s (g n) stats :: String -> (a -> Int) -> Gen a -> IO () stats s f g = do putStrLn s xs <- replicateM 1000 (fmap f (generate g)) putStrLn $ "Mean: " ++ show (mean xs) pp (histogram xs) putStrLn "" histogram xs' = (bounds, bins) where (xs, ys) = splitAt (95 * length xs' `div` 100) (sort xs') xMin = minimum xs xMax = maximum xs bounds | xMax - xMin < 20 = [xMin .. xMax] | otherwise = [xMin, xMin + (xMax - xMin) `div` 10 .. xMax] bins = f bounds xs f (_ : b1 : bs) xs = let (a, ys) = span (< b1) xs in length a : f (b1 : bs) ys f _ xs = [length xs + length ys] pp :: ([Int], [Int]) -> IO () pp (vs, bs) = do putStrLn $ vs >>= \v -> three v ++ " - " putStrLn $ bs >>= \b -> " | " ++ three b three x = replicate (3 - length s) ' ' ++ s where s = show x mean :: Foldable v => v Int -> Double mean xs = fromIntegral (sum xs) / fromIntegral (length xs)