diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/Test/Complexity.hs b/Test/Complexity.hs new file mode 100644 --- /dev/null +++ b/Test/Complexity.hs @@ -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 diff --git a/Test/Complexity/Base.hs b/Test/Complexity/Base.hs new file mode 100644 --- /dev/null +++ b/Test/Complexity/Base.hs @@ -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 diff --git a/Test/Complexity/Chart.hs b/Test/Complexity/Chart.hs new file mode 100644 --- /dev/null +++ b/Test/Complexity/Chart.hs @@ -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 diff --git a/Test/Complexity/Pretty.hs b/Test/Complexity/Pretty.hs new file mode 100644 --- /dev/null +++ b/Test/Complexity/Pretty.hs @@ -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 "" + ) diff --git a/Test/Complexity/Utils.hs b/Test/Complexity/Utils.hs new file mode 100644 --- /dev/null +++ b/Test/Complexity/Utils.hs @@ -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 diff --git a/complexity.cabal b/complexity.cabal new file mode 100644 --- /dev/null +++ b/complexity.cabal @@ -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 diff --git a/example.hs b/example.hs new file mode 100644 --- /dev/null +++ b/example.hs @@ -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