complexity (empty) → 0.1
raw patch · 9 files changed
+769/−0 lines, 9 filesdep +Chartdep +basedep +coloursetup-changed
Dependencies added: Chart, base, colour, data-accessor, hstats, parallel, pretty, time, transformers
Files
- LICENSE +32/−0
- Setup.hs +3/−0
- Test/Complexity.hs +119/−0
- Test/Complexity/Base.hs +287/−0
- Test/Complexity/Chart.hs +100/−0
- Test/Complexity/Pretty.hs +29/−0
- Test/Complexity/Utils.hs +35/−0
- complexity.cabal +38/−0
- example.hs +126/−0
+ LICENSE view
@@ -0,0 +1,32 @@+Copyright (c) 2009 Roel van Dijk, Bas van Dijk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The names of Roel van Dijk and Bas van Dijk and the names of+ contributors may NOT be used to endorse or promote products+ derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ Test/Complexity.hs view
@@ -0,0 +1,119 @@+{-|+This module provides a collection of functions that enable you to+measure the algorithmic complexity of arbitrary functions.++Let's say you want to measure the time complexity of 'qsort':++@+ qsort :: Ord a => [a] -> [a]+ qsort [] = []+ qsort (x:xs) = qsort (filter (\< x) xs) ++ [x] ++ qsort (filter (>= x) xs)+@++We want to now the time complexity of 'qsort' in terms of the size of+its 'InputSize' \'n\'. First we have to express what \'n\' is. We do this by+writing an 'InputGen':++@+ -- Very simple pseudo random number generator.+ pseudoRnd :: Int -> Int -> Int -> Int -> [Int]+ pseudoRnd p1 p2 n d = iterate (\x -> (p1 * x + p2) `mod` n) d+@++@+ genIntList :: 'InputGen' [Int]+ genIntList n = take (fromInteger n) $ pseudoRnd 16807 0 (2 ^ 31 - 1) 79+@++The function 'genIntList' now generates a pseudo random list of Ints+of length \'n\'.++Next we have to specify what aspect of 'qsort' we want to+measure. Since we are interested in the time complexity we use a CPU+time sensor:++@+ mySensor = 'cpuTimeSensor' 10+@++The 'cpuTimeSensor' is a 'Sensor' which measures CPU time. It takes+one argument which is a time in milliseconds. This is the minimum+execution time for an 'Action' which is measured. If the action doesn't+take more than 10 ms to execute it will be repeated until it+does. This allows us to measure actions which execute much faster than+the minimum measurable CPU time difference.++Now we can create an 'Experiment':++@+ expQSort = 'pureExperiment' \"quicksort\" mySensor genIntList qsort+@++This is an experiment which measures the CPU time it takes to apply+the function 'qsort' on an input generate by 'genIntList'.++Before you can perform the experiment you need to decide which input+sizes you want to measure and when to stop. These ideas are contained+in a 'Strategy'. We'll use the 'simpleLinearHeuristic':++@+ myStrategy = 'simpleLinearHeuristic' 1.1 10^5+@++This strategy looks at the last two points to decide which input size+to measure next. It picks a point where it thinks the measured value+will be 1.1 times the last measured value. It will stop if the input+size exceeds 10^5 to prevent running out of memory.++Now we can finally perform the experiment:++@+ stats <- 'performExperiment' myStrategy 10 15 expQSort+@++The experiment will take 10 samples per input size and it will run for+15 seconds. The result is a bunch of 'MeasurementStats'. You can now+print these statistics to stdout or show them in a nice graph:++@+ 'printStats' [stats]+ 'showStatsChart' [stats]+@++Looking at the type signatures of these function you'll notice that+they accept a list of 'MeasurementStats'. This means you can compare+multiple experiments.++Let's compare 'qsort' to the build in 'Data.List.sort'. This time+we'll use some convenient utility functions to more easily setup and+perform an experiment.++@+ expSorts = [ 'pureExperiment' \"qsort\" mySensor genIntList qsort+ , 'pureExperiment' \"Data.List.sort\" mySensor genIntList 'sort'+ ]+ 'simpleSmartMeasure' 1.1 10^5 10 20 expSorts+@++The utility function 'simpleSmartMeasure' uses the+'simpleLinearHeuristic' strategy by default. The first to arguments+are passed to the heuristic. We again choose to take 10 samples per+input size. The total measurement time is increased to 20 seconds, but+it is now used to measure two functions instead of one. The time is+divided evenly and each function gets 10 seconds. The last argument is+a list of experiments. After 20 seconds you'll get a nice graph+comparing the complexity of the two sorting algorithms.++-}++module Test.Complexity+ ( module Test.Complexity.Base+ , module Test.Complexity.Chart+ , module Test.Complexity.Pretty+ , module Test.Complexity.Utils+ ) where++import Test.Complexity.Base+import Test.Complexity.Chart+import Test.Complexity.Pretty+import Test.Complexity.Utils
+ Test/Complexity/Base.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE LiberalTypeSynonyms #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Complexity.Base+ ( -- *Measurement subject+ Action+ , InputGen+ , InputSize++ -- *Experiments+ , Description+ , Experiment+ , experiment+ , pureExperiment+ , performExperiment++ -- *Measurement strategy+ , Strategy(..)+ , inputSizeFromList+ , simpleLinearHeuristic++ -- *Sensors+ , Sensor+ , timeSensor+ , cpuTimeSensor+ , wallClockTimeSensor++ -- *Measurement results+ , MeasurementStats(..)+ , Sample+ , Stats(..)+ ) where++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++-- Package-qualified import because of Chart, which exports stuff from mtl.+import "transformers" Control.Monad.Trans (MonadIO, liftIO)++import Control.Monad (liftM)+import Control.Monad.Trans.State.Lazy (StateT, evalStateT, get, put)+import Control.Parallel.Strategies (NFData)+import Data.List (genericReplicate, sortBy)+import Data.Function (on)+import Data.Time.Clock (getCurrentTime, diffUTCTime)+import Math.Statistics (stddev, mean)+import System.CPUTime (getCPUTime)+import System.Timeout (timeout)+import Test.Complexity.Misc++-------------------------------------------------------------------------------+-- Measurement subject+-------------------------------------------------------------------------------++-- |An Action is a function of which aspects of its execution can be measured.+type Action a b = a -> IO b++-- |A input generator produces a value of a certain size.+type InputGen a = InputSize -> a++-- |The size of an input on which an action is applied.+type InputSize = Integer++-------------------------------------------------------------------------------+-- Experiments+-------------------------------------------------------------------------------++-- |A description of an experiment.+type Description = String++-- |A method of investigating the causal relationship between the size+-- of the input of an action and some aspect of the execution of the action.+data Experiment = forall a b. NFData a =>+ Experiment Description (Sensor a b) (InputGen (IO a)) (Action a b)++-- |Smart constructor for experiments.+experiment :: NFData a => Description -> (Sensor a b) -> InputGen (IO a) -> (Action a b) -> Experiment+experiment = Experiment++-- |Smart constructor for experiments on pure functions.+pureExperiment :: NFData a => Description -> (Sensor a b) -> InputGen a -> (a -> b) -> Experiment+pureExperiment desc sensor gen f = experiment desc sensor (return . gen) (return . f)++-------------------------------------------------------------------------------++-- |Performs an experiment using a given strategy.+performExperiment :: Strategy [Sample]+ -> Integer -- ^Number of samples per input size.+ -> Double -- ^Maximum measure time in seconds (wall clock time).+ -> Experiment+ -> IO MeasurementStats+performExperiment (Strategy {..}) numSamples maxMeasureTime (Experiment desc sensor gen action) =+ do startTime <- getCurrentTime++ let measureLoop xs = do curTime <- liftIO getCurrentTime+ let elapsedTime = diffUTCTime curTime startTime+ let remTime = maxMeasureTime - realToFrac elapsedTime++ n' <- nextInputSize xs remTime+ case n' of+ Just n | remTime > 0 -> liftIO (timeout (round $ remTime * 1e6) $ measureSample n)+ >>= maybe (return xs) (\x -> measureLoop (x:xs))+ _ -> return xs++ liftM (MeasurementStats desc . sortBy (compare `on` fst)) $ runStrategy $ measureLoop []+ where+ measureSample :: InputSize -> IO Sample+ measureSample = measureAction gen action sensor numSamples++-- |Measure the time needed to evaluate an action when applied to an input of+-- size \'n\'.+measureAction :: NFData a+ => InputGen (IO a) -> Action a b -> Sensor a b -> Integer -> InputSize -> IO Sample+measureAction gen action sensor numSamples inputSize = fmap (\ys -> (inputSize, calculateStats ys))+ measure+ where+ measure :: IO [Double]+ measure = gen inputSize >>=| \x -> mapM (sensor action) $ genericReplicate numSamples x++-------------------------------------------------------------------------------+-- Measurement strategy+-------------------------------------------------------------------------------++-- |A measurement 'Strategy' describes how an 'Experiment' should be executed.+--+-- Its main responsibility is to provide the next 'InputSize' which+-- should be measured based on the data that is already gathered and+-- the remaining time. This is the role of the 'nextInputSize'+-- function. It lives in an arbitrary 'MonadIO' and you have to+-- provide a function which transforms this monad to an 'IO'+-- action. If a value of Nothing is produced this means that it can't+-- generate any more input sizes and measuring will stop.+data Strategy a = forall m. MonadIO m =>+ Strategy { nextInputSize :: ([Sample] -> Double -> m (Maybe InputSize))+ -- ^Function which calculates the next 'InputSize' to measure.+ , runStrategy :: (m a -> IO a)+ -- ^Run function which lifts the strategy monad to IO.+ }++-- |A strategy which produces input sizes from a given list.+--+-- When the list is consumed it will produce 'Nothing'.+inputSizeFromList :: [InputSize] -> Strategy a+inputSizeFromList ns = Strategy (\_ _ -> m) (\s -> evalStateT s ns)+ where+ m :: StateT [InputSize] IO (Maybe InputSize)+ m = do xs <- get+ case xs of+ [] -> return Nothing+ (x:xs') -> do put xs'+ return $ Just x++-- |Very simple heuristic which estimates the next input size based on+-- a linear extrapolation of the previous two samples.+--+-- The last two samples determine a line. Given this line the strategy+-- finds the input size for which the value is \'step * last+-- value\'. This is ofcourse very sensitive to noise. Therefore there+-- are a number of safeguards against too high or low sizes. The next+-- size will never be more than twice the previous size. If the next+-- input size exceeds the 'maxSize' then the result will be Nothing.+--+-- The maximum size is a safeguard against too much memory usage.+simpleLinearHeuristic :: Double -- ^Step size.+ -> InputSize -- ^Maximum input size.+ -> Strategy a+simpleLinearHeuristic step maxSize = Strategy (\xs _ -> return $ f xs) id+ where+ f :: [Sample] -> Maybe InputSize+ f xs | n < maxSize = Just n+ | otherwise = Nothing+ where+ n = simple step xs++ simple _ [] = 0+ simple _ [_] = 1+ simple step ((x2,y2):(x1,y1):_) | x3 <= x2 = x2 + dx+ | x3 > 2 * x2 = 2 * x2+ | otherwise = x3+ where+ t2 = statsMean2 $ y2+ t1 = statsMean2 $ y1+ dx = x2 - x1+ dt = t2 - t1+ x3 = ceiling $ (fromInteger dx / dt) * (step * t2)++-------------------------------------------------------------------------------+-- Sensors+-------------------------------------------------------------------------------++-- |Function that measures some aspect of the execution of an action.+type Sensor a b = (Action a b) -> a -> IO Double++-- |Measures the execution time of an action.+--+-- Actions will be executed repeatedly until the cumulative time exceeds+-- minSampleTime milliseconds. The final result will be the cumulative time+-- divided by the number of iterations. In order to get sufficient precision+-- the minSampleTime should be set to at least a few times the time source's+-- precision. If you want to know only the execution time of the supplied+-- action and not the evaluation time of its input value you should ensure+-- that the input value is in head normal form.+timeSensor :: NFData b+ => IO t -- ^Current time.+ -> (t -> t -> Double) -- ^Time difference.+ -> Double -- ^Minimum run time (in milliseconds).+ -> Sensor a b+timeSensor t d minSampleTime action x = go 1 0 0+ where+ go n totIter totCpuT =+ do -- Time n iterations of action applied on x.+ curCpuT <- timeIO t d n action x+ -- Calculate new cumulative values.+ let totCpuT' = totCpuT + curCpuT+ totIter' = totIter + n+ if totCpuT' >= minSampleTime+ then let numIter = fromIntegral totIter'+ in return $ totCpuT' / numIter+ else go (2 * n) totIter' totCpuT'++-- |Time the evaluation of an IO action.+timeIO :: NFData b+ => IO t -- ^Measure current time.+ -> (t -> t -> Double) -- ^Difference between measured times.+ -> Int -- ^Number of times the action is repeated.+ -> Sensor a b+timeIO t d n f x = do tStart <- t+ strictReplicateM_ n $ f x+ tEnd <- t+ return $ d tEnd tStart++-- |Measures the CPU time that passes while executing an action.+cpuTimeSensor :: NFData b => Double -> Sensor a b+cpuTimeSensor = timeSensor getCPUTime (\x y -> picoToMilli $ x - y)++-- |Measures the wall clock time that passes while executing an action.+wallClockTimeSensor :: NFData b => Double -> Sensor a b+wallClockTimeSensor = timeSensor getCurrentTime (\x y -> 1000 * (realToFrac $ diffUTCTime x y))++-------------------------------------------------------------------------------+-- Measurement results+-------------------------------------------------------------------------------++-- |Statistics about a measurement performed on many inputs.+data MeasurementStats = MeasurementStats { msDesc :: Description+ , msSamples :: [Sample]+ } deriving Show++-- |Statistics about the sampling of a single input value.+type Sample = (InputSize, Stats)++-- |Statistics about a collection of values.+data Stats = Stats { statsMin :: Double -- ^Minimum value.+ , statsMax :: Double -- ^Maximum value.+ , statsStdDev :: Double -- ^Standard deviation+ , statsMean :: Double -- ^Arithmetic mean.+ , statsMean2 :: Double+ -- ^Mean of all samples that lie within one+ -- standard deviation from the mean.+ , statsSamples :: [Double] -- ^Samples from which these statistics are derived.+ } deriving Show++-------------------------------------------------------------------------------+-- Misc+-------------------------------------------------------------------------------++-- |Calculate statistics about a collection of values.+--+-- Precondition: not $ null xs+calculateStats :: [Double] -> Stats+calculateStats xs = Stats { statsMin = minimum xs+ , statsMax = maximum xs+ , statsStdDev = stddev_xs+ , statsMean = mean_xs+ , statsMean2 = mean2_xs+ , statsSamples = xs+ }+ where stddev_xs = stddev xs+ mean_xs = mean xs+ mean2_xs | null inStddev = mean_xs+ | otherwise = mean inStddev+ inStddev = filter (\x -> diff mean_xs x < stddev_xs) xs
+ Test/Complexity/Chart.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns #-}++module Test.Complexity.Chart ( statsToChart+ , quickStatsToChart+ , showStatsChart+ ) where++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Gtk+import Data.Accessor+import Data.List (intercalate)++import Data.Colour+import qualified Data.Colour.Names as CN+import Data.Colour.SRGB++import Test.Complexity.Base ( MeasurementStats(..)+ , Stats(..)+ )+++convertColour :: Double -> Colour Double -> Color+convertColour alpha c = let rgb = toSRGB c+ in Color { c_r = channelRed rgb+ , c_g = channelGreen rgb+ , c_b = channelBlue rgb+ , c_a = alpha+ }++statsToChart :: [(MeasurementStats, Colour Double)] -> Layout1 Double Double+statsToChart [] = defaultLayout1+statsToChart xs = layout1_title ^= intercalate ", " [msDesc | (MeasurementStats {msDesc}, _) <- xs]+ $ layout1_plots ^= concat [map Left $ statsToPlots colour stats | (stats, colour) <- xs]+ $ layout1_left_axis .> laxis_title ^= "time (ms)"+ $ layout1_bottom_axis .> laxis_title ^= "input size (n)"+ $ defaultLayout1++quickStatsToChart :: [MeasurementStats] -> Layout1 Double Double+quickStatsToChart xs = statsToChart $ zip xs $ cycle colours+ where colours = [ CN.blue+ , CN.red+ , CN.green+ , CN.darkgoldenrod+ , CN.orchid+ , CN.sienna+ , CN.darkcyan+ , CN.olivedrab+ , CN.silver+ ]++statsToPlots :: Colour Double -> MeasurementStats -> [Plot Double Double]+statsToPlots c stats = [ plot_legend ^= [] $ toPlot cpuMinMax+ , plot_legend ^= [] $ toPlot cpuMin+ , plot_legend ^= [] $ toPlot cpuMax+ , toPlot cpuMean+ , plot_legend ^= [] $ toPlot cpuErr+ , plot_legend ^= [] $ toPlot cpuMeanPts+ ]+ where colour_normal = convertColour 1.00c+ colour_dark = convertColour 1.00 $ blend 0.5 c CN.black+ colour_light = convertColour 0.70 c+ colour_lighter = convertColour 0.15 c+ colour_lightest = convertColour 0.07 c++ cpuMean = plot_lines_values ^= [zip xs ys_cpuMean2]+ $ plot_lines_style .> line_color ^= colour_normal+ $ plot_lines_title ^= msDesc stats+ $ defaultPlotLines++ cpuMin = plot_lines_values ^= [zip xs ys_cpuMin]+ $ plot_lines_style .> line_color ^= colour_lighter+ $ defaultPlotLines++ cpuMax = plot_lines_values ^= [zip xs ys_cpuMax]+ $ plot_lines_style .> line_color ^= colour_lighter+ $ defaultPlotLines++ cpuMeanPts = plot_points_values ^= zip xs ys_cpuMean2+ $ plot_points_style ^= filledCircles 2 colour_dark+ $ defaultPlotPoints++ cpuMinMax = plot_fillbetween_values ^= zip xs (zip ys_cpuMin ys_cpuMax)+ $ plot_fillbetween_style ^= solidFillStyle colour_lightest+ $ defaultPlotFillBetween++ cpuErr = plot_errbars_values ^= [symErrPoint x y 0 e | (x, y, e) <- zip3 xs ys_cpuMean vs_cpuStdDev]+ $ plot_errbars_line_style .> line_color ^= colour_light+ $ defaultPlotErrBars++ ps = msSamples stats+ xs = map (fromIntegral . fst) ps+ ys_cpuMean = map (statsMean . snd) ps+ ys_cpuMean2 = map (statsMean2 . snd) ps+ ys_cpuMin = map (statsMin . snd) ps+ ys_cpuMax = map (statsMax . snd) ps+ vs_cpuStdDev = map (statsStdDev . snd) ps++showStatsChart :: [MeasurementStats] -> IO ()+showStatsChart xs = renderableToWindow (toRenderable $ quickStatsToChart xs) 640 480
+ Test/Complexity/Pretty.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE RecordWildCards #-}++module Test.Complexity.Pretty ( prettyStats+ , printStats+ ) where++import Text.PrettyPrint+import Text.Printf (printf)++import Test.Complexity.Base ( MeasurementStats(..)+ , Sample+ , Stats(..)+ )++prettyStats :: MeasurementStats -> Doc+prettyStats (MeasurementStats {..}) = text "desc:" <+> text msDesc+ $+$ text ""+ $+$ vcat (map ppSample msSamples)+ where ppSample :: Sample -> Doc+ ppSample (x, y) = (text . printf "%3i") x <+> char '|' <+> ppStats y+ ppStats (Stats {..}) = int (length statsSamples)+ <+> hsep (map (text . printf "%7.3f")+ [statsMin, statsMean2, statsMax, statsStdDev]+ )++printStats :: [MeasurementStats] -> IO ()+printStats = mapM_ (\s -> do putStrLn . render . prettyStats $ s+ putStrLn ""+ )
+ Test/Complexity/Utils.hs view
@@ -0,0 +1,35 @@+{-|+Some utilities to quickly perform experiments.+-}++module Test.Complexity.Utils+ ( quickPerformExps+ , simpleMeasureNs+ , simpleSmartMeasure+ ) where++import Test.Complexity.Base ( MeasurementStats+ , Experiment+ , InputSize+ , performExperiment+ , inputSizeFromList+ , simpleLinearHeuristic+ )+import Test.Complexity.Chart (showStatsChart)+import Test.Complexity.Pretty (printStats)+++quickPerformExps :: (a -> IO MeasurementStats) -> [a] -> IO ()+quickPerformExps f xs = do stats <- mapM f xs+ printStats stats+ showStatsChart stats++simpleMeasureNs :: [InputSize] -> Integer -> Double -> [Experiment] -> IO ()+simpleMeasureNs ns numSamples maxTime =+ quickPerformExps (performExperiment (inputSizeFromList ns) numSamples maxTime)+++simpleSmartMeasure :: Double -> InputSize -> Integer -> Double -> [Experiment] -> IO ()+simpleSmartMeasure step maxN numSamples maxTime xs =+ let tMax = maxTime / (fromIntegral $ length xs)+ in quickPerformExps (performExperiment (simpleLinearHeuristic step maxN) numSamples tMax) xs
+ complexity.cabal view
@@ -0,0 +1,38 @@+name: complexity+version: 0.1+cabal-version: >= 1.6+build-type: Simple+stability: experimental+author: Roel van Dijk+maintainer: vandijk.roel@gmail.com+copyright: (c) 2009 Roel van Dijk+license: BSD3+license-file: LICENSE+category: Testing+synopsis: Empirical algorithmic complexity+description:+ Determine the complexity of functions by testing them on inputs of various sizes.++Extra-Source-Files: example.hs++library+ GHC-Options: -O2 -Wall -fno-warn-name-shadowing+ build-depends: base >= 2+ , time >= 1.1.2+ , parallel == 1.*+ , transformers >= 0.1.4+ , data-accessor >= 0.2+ , pretty >= 1+ , colour >= 2+ , Chart >= 0.1 && <= 10.0.3+ , hstats >= 0.1 && <= 0.3+ exposed-modules: Test.Complexity+ , Test.Complexity.Base+ , Test.Complexity.Chart+ , Test.Complexity.Pretty+ , Test.Complexity.Utils++-- executable example+-- GHC-Options: -O2 -Wall -fno-warn-name-shadowing+-- build-depends: mersenne-random, containers+-- main-is: example.hs
+ example.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE RankNTypes #-}++module Main where++import Data.Function (fix)+import Data.List (sort, unfoldr)+import System.Environment (getArgs)+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.IntMap as IM++import Test.Complexity++-------------------------------------------------------------------------------+-- Some input generators for lists of Int++genIntList :: InputGen [Int]+genIntList n = let n' = fromInteger n+ in [n', n' - 1 .. 0]++-- Very simple pseudo random number generator.+pseudoRnd :: Int -> Int -> Int -> Int -> [Int]+pseudoRnd p1 p2 n d = iterate (\x -> (p1 * x + p2) `mod` n) d++genIntList2 :: InputGen [Int]+genIntList2 n = take (fromInteger n) $ pseudoRnd 16807 0 (2 ^ 31 - 1) 79++-------------------------------------------------------------------------------+-- Bunch of fibonacci functions++fib0 :: Integer -> Integer+fib0 0 = 0+fib0 1 = 1+fib0 n = fib0 (n - 1) + fib0 (n - 2)++fib1 :: Integer -> Integer+fib1 0 = 0+fib1 1 = 1+fib1 n | even n = f1 * (f1 + 2 * f2)+ | n `mod` 4 == 1 = (2 * f1 + f2) * (2 * f1 - f2) + 2+ | otherwise = (2 * f1 + f2) * (2 * f1 - f2) - 2+ where k = n `div` 2+ f1 = fib1 k+ f2 = fib1 (k-1)++fib2 :: Integer -> Integer+fib2 n = fibs !! fromInteger n+ where fibs = 0 : 1 : zipWith (+) fibs (tail fibs)++fib3 :: Integer -> Integer+fib3 n = fibs !! fromInteger n+ where fibs = scanl (+) 0 (1:fibs)++fib4 :: Integer -> Integer+fib4 n = fibs !! fromInteger n+ where fibs = fix (scanl (+) 0 . (1:))++fib5 :: Integer -> Integer+fib5 n = fibs !! fromInteger n+ where fibs = unfoldr (\(a,b) -> Just (a,(b, a+b))) (0,1)++fib6 :: Integer -> Integer+fib6 n = fibs !! fromInteger n+ where fibs = map fst $ iterate (\(a,b) -> (b, a+b)) (0,1)++expFibs :: [Experiment]+expFibs = --[ pureExperiment "fib0" (cpuTimeSensor 10) id fib0+ --, pureExperiment "fib1" (cpuTimeSensor 10) id fib1+ --] +++ [ pureExperiment "fib2" (cpuTimeSensor 10) id fib2+ , pureExperiment "fib3" (cpuTimeSensor 10) id fib3+ , pureExperiment "fib4" (cpuTimeSensor 10) id fib4+ , pureExperiment "fib5" (cpuTimeSensor 10) id fib5+ , pureExperiment "fib6" (cpuTimeSensor 10) id fib6+ ]++-------------------------------------------------------------------------------+-- Sorting algorithms++bsort :: Ord a => [a] -> [a]+bsort [] = []+bsort xs = iterate swapPass xs !! (length xs - 1)+ where swapPass (x:y:zs) | x > y = y : swapPass (x:zs)+ | otherwise = x : swapPass (y:zs)+ swapPass xs = xs++qsort :: Ord a => [a] -> [a]+qsort [] = []+qsort (x:xs) = qsort (filter (< x) xs) ++ [x] ++ qsort (filter (>= x) xs)++expBSort, expQSort, expSort, expSorts :: [Experiment]+expBSort = [pureExperiment "bubble sort" (cpuTimeSensor 10) genIntList2 bsort]+expQSort = [pureExperiment "quick sort" (cpuTimeSensor 10) genIntList2 qsort]+expSort = [pureExperiment "Data.List.sort" (cpuTimeSensor 10) genIntList2 sort]+expSorts = expBSort ++ expQSort ++ expSort++-------------------------------------------------------------------------------+-- Map lookups++mkMap :: InputSize -> (Int, M.Map Int Int)+mkMap n = let n' = fromInteger n+ in (n' `div` 2, M.fromList [(k, k) | k <- [0 .. n']])++mkIntMap :: InputSize -> (Int, IM.IntMap Int)+mkIntMap n = let n' = fromInteger n+ in (n' `div` 2, IM.fromList [(k, k) | k <- [0 .. n']])++expMaps :: [Experiment]+expMaps = [ pureExperiment "Data.Map pure" (cpuTimeSensor 10) mkMap (uncurry M.lookup)+ , pureExperiment "Data.IntMap" (cpuTimeSensor 10) mkIntMap (uncurry IM.lookup)+ ]++-------------------------------------------------------------------------------++cmdLine :: [Experiment] -> IO ()+cmdLine xs = do args <- getArgs+ if length args == 2+ then let (a1:a2:_) = take 2 args+ maxTime = (read a1) :: Double+ maxN = (read a2) :: InputSize+ in simpleSmartMeasure 1.1 maxN 10 maxTime xs+-- in simpleMeasureNs [1..20] 10 120 xs+ else putStrLn "Error: I need 2 arguments (max time and max input size)"++main :: IO ()+main = cmdLine expSorts