tasty-bench-fit-0.1: Determine time complexity of a given function
Safe HaskellSafe-Inferred
LanguageHaskell2010

Test.Tasty.Bench.Fit

Description

Guess complexity of the function.

Synopsis

Fit benchmarks

fit :: FitConfig -> IO Complexity Source #

Determine time complexity of the function:

>>> fit $ mkFitConfig (\x -> sum [1..x]) (10, 10000)
1.2153e-8 * x
>>> fit $ mkFitConfig (\x -> Data.List.nub [1..x]) (10, 10000)
2.8369e-9 * x ^ 2
>>> fit $ mkFitConfig (\x -> Data.List.sort $ take (fromIntegral x) $ iterate (\n -> n * 6364136223846793005 + 1) (1 :: Int)) (10, 100000)
5.2990e-8 * x * log x

One can usually get reliable results for functions, which do not allocate much: like in-place vector sort or fused list operations like sum [1..x].

Unfortunately, fitting functions, which allocate a lot, is likely to be disappointing: GC kicks in irregularly depending on nursery and heap sizes and often skews observations beyond any recognition. Consider running such measurements with -O0 or in ghci prompt. This is how the usage example above was generated. Without optimizations your program allocates much more and triggers GC regularly, somewhat evening out its effect.

fits :: FitConfig -> IO (NonEmpty Complexity) Source #

Same as fit, but interactively emits a list of complexities, gradually converging to the final result.

If fit takes too long, you might wish to implement your own criterion of convergence atop of fits directly.

mkFitConfig Source #

Arguments

:: NFData a 
=> (Word -> a)

Raw function to measure, without nf.

-> (Word, Word)

The smallest and the largest sizes of the input.

-> FitConfig 

Generate a default fit configuration.

data FitConfig Source #

Configuration for fit.

Constructors

FitConfig 

Fields

Complexity

data Complexity Source #

Complexity a b k represents a time complexity \( k \, x^a \log^b x \), where \( x \) is problem's size.

Instances

Instances details
Generic Complexity Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

Associated Types

type Rep Complexity :: Type -> Type #

Show Complexity Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

NFData Complexity Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

Methods

rnf :: Complexity -> () #

Eq Complexity Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

Ord Complexity Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

type Rep Complexity Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

type Rep Complexity = D1 ('MetaData "Complexity" "Test.Tasty.Bench.Fit.Complexity" "tasty-bench-fit-0.1-L7SrCZwdZKQEzajEB21Hdb" 'False) (C1 ('MetaCons "Complexity" 'PrefixI 'True) (S1 ('MetaSel ('Just "cmplVarPower") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Double) :*: (S1 ('MetaSel ('Just "cmplLogPower") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Word) :*: S1 ('MetaSel ('Just "cmplMultiplier") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Double))))

data Measurement Source #

Represents a time measurement for a given problem's size.

Constructors

Measurement 

Fields

Instances

Instances details
Generic Measurement Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

Associated Types

type Rep Measurement :: Type -> Type #

Show Measurement Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

NFData Measurement Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

Methods

rnf :: Measurement -> () #

Eq Measurement Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

Ord Measurement Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

type Rep Measurement Source # 
Instance details

Defined in Test.Tasty.Bench.Fit.Complexity

type Rep Measurement = D1 ('MetaData "Measurement" "Test.Tasty.Bench.Fit.Complexity" "tasty-bench-fit-0.1-L7SrCZwdZKQEzajEB21Hdb" 'False) (C1 ('MetaCons "Measurement" 'PrefixI 'True) (S1 ('MetaSel ('Just "measTime") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Double) :*: S1 ('MetaSel ('Just "measStDev") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Double)))

guessComplexity :: Map Word Measurement -> Complexity Source #

Guess time complexity from a map where keys are problem's sizes and values are time measurements (or instruction counts).

>>> :set -XNumDecimals
>>> guessComplexity $ Data.Map.fromList $ map (\(x, t) -> (x, Measurement t 1)) [(2, 4), (3, 10), (4, 15), (5, 25)]
0.993 * x ^ 2
>>> guessComplexity $ Data.Map.fromList $ map (\(x, t) -> (x, Measurement t 1)) [(1e2, 2.1), (1e3, 2.9), (1e4, 4.1), (1e5, 4.9)]
0.433 * log x

This function uses following simplifying assumptions:

  • All coefficients are non-negative.
  • The power of \( \log x \) (cmplLogPower) is unlikely to be \( > 1 \).
  • The power of \( x \) (cmplVarPower) is unlikely to be fractional.

This function is unsuitable to guess superpolynomial and higher classes of complexity.

evalComplexity :: Complexity -> Word -> Double Source #

Evaluate time complexity for a given size of the problem.

Predicates

isConstant :: Complexity -> Bool Source #

Is the complexity \( f(x) = k \)?

isLogarithmic :: Complexity -> Bool Source #

Is the complexity \( f(x) = k \log x \)?

isLinear :: Complexity -> Bool Source #

Is the complexity \( f(x) = k \, x \)?

isLinearithmic :: Complexity -> Bool Source #

Is the complexity \( f(x) = k \, x \log x \)?

isQuadratic :: Complexity -> Bool Source #

Is the complexity \( f(x) = k \, x^2 \)?

isCubic :: Complexity -> Bool Source #

Is the complexity \( f(x) = k \, x^3 \)?