I wrote a naive and stupid package, which tries to guess asymptotic complexity from benchmarks:
Here is an example of output:
> 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 x $ iterate (\n -> n * 6364136223846793005 + 1) (1 :: Int)) (10, 10000)
5.2990e-8 * x * log x
I tested some toy examples, but curious how tasty-bench-fit behaves on data it was not “trained” on. Could someone please give it a try and share results (ideally with debug flag on)?
Can you give an example of an algorithm --as it would be implemented in Haskell-- that would have an asymptotic complexity of O(X loglog n) time for some appropriate X? (and clearly I don’t mean picking e.g. X = n/loglog n). Since almost everything is pointer/comparison based, I don’t think there are all that many algorithms for which that would be the right answer.
Aside from that. Indeed a cool idea. I would very much like to know what it is actually computing though. I.e. if the benchmark suite claims the running time is 5f(n), then what does that actually mean? I presume 5f(n) was the best fit over functions g selected from some particular set F? It would be nice to document that; otherwise it is hard to interpret the results. [1]
[1] I guess this should mostly be regarded as a general community TODO somewhere; I may just read the source at some point and write s.t. if it doesn’t exist by then :).
As experiments by @ChShersh and @jaror demonstrate (thanks, guys, I’ll get back to your results soon!), it is challenging to catch even log n factor right. Determining log (log n) is likely impossible for statistical methods, and I know a single algorithm with expected log (log n) term: Schönhage–Strassen algorithm - Wikipedia.
I presume 5*f(n) was the best fit over functions g selected from some particular set F?
See the definition of Complexity, it is ax^b log^cx.
@ChShersh thanks for a neat reproducible example! I’ve updated tasty-bench-fit to cope with certain situations better, so if anyone wants to provide another data point, please bump tag to the latest commit.
I’m getting more or less reliable results for the following derived program:
{-# OPTIONS_GHC -O0 #-}
module Main where
import Data.Hashable (Hashable)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List (nub)
import Data.Containers.ListUtils (nubOrd)
import Test.Tasty.Bench.Fit (fit, mkFitConfig)
nubHash :: (Eq a, Hashable a) => [a] -> [a]
nubHash = go mempty
where
go acc [] = []
go acc (x:xs)
| HashSet.member x acc = go acc xs
| otherwise = x : go (HashSet.insert x acc) xs
main :: IO ()
main = do
-- Nub (Eq)
putStrLn "Ordinary nub (unique)"
complexity <- fit $ mkFitConfig (\x -> nub [1..x]) (100, 10000)
print complexity
putStrLn "Ordinary nub (dups)"
complexity <- fit $ mkFitConfig (\x -> nub ([1..x] ++ [1..x])) (100, 10000)
print complexity
-- Nub (Ord)
putStrLn "Efficient nubOrd (unique)"
complexity <- fit $ mkFitConfig (\x -> nubOrd [1..x]) (10000, 100000)
print complexity
putStrLn "Efficient nubOrd (dups)"
complexity <- fit $ mkFitConfig (\x -> nubOrd ([1..x] ++ [1..x])) (10000, 100000)
print complexity
Ordinary nub (unique)
2.4935e-9 * x ^ 2
Ordinary nub (dups)
6.6628e-9 * x ^ 2
Efficient nubOrd (unique)
3.8730e-8 * x * log x
Efficient nubOrd (dups)
5.0239e-8 * x * log x
As for nubHash, fit indeed produces very surprising results like x log ^ 3 x. The thing is that feeding continuous Ints into a HashSet hits a very peculiar spot: instance Hashable Int where hash = id, so there is no hashing happening at all, we just pack small arrays element by element. There are sharp changes in performance when another level of small arrays needed, altogether making asymptotics difficult to predict from observations.
This is fun to play with! I know it’s not a real benchmark but still, it’s interesting to implement various algorithms and then check whether you guessed the complexity right.
This time, I wanted to test various sorting implementations:
Data.List.sort: should be O(n log n) with small constant because it uses several optimizations
Naive QuickSort: should be O(n log n) on a random list
Top-down mergeSort with the split in the middle: should be O(n log n) with big constant
Top-down mergeSort with split by even-odd: should be O(n log n) with smaller constant
Bottom-up mergeSort: should be O(n log n)
Sort based on IntMap: should be close to O(n)
Suprisingly, the results are not deterministic, and different runs produce different asymptotics. So I run every algorithm twice from GHCi:
-- Data.List.sort
ghci> fit $ mkFitConfig (Data.List.sort . mkList) (10, 10000)
7.0969e-9 * x * log ^ 2 x
ghci> fit $ mkFitConfig (Data.List.sort . mkList) (10, 10000)
1.0800e-7 * x ^ 1.1837
-- Quick Sort
ghci> fit $ mkFitConfig (quickSort . mkList) (10, 10000)
2.8411e-7 * x * log x
ghci> fit $ mkFitConfig (quickSort . mkList) (10, 10000)
2.8529e-7 * x * log x
-- Merge Sort (with split in the middle)
ghci> fit $ mkFitConfig (mergeSortWithLength . mkList) (10, 10000)
4.7956e-7 * x * log x
ghci> fit $ mkFitConfig (mergeSortWithLength . mkList) (10, 10000)
5.6328e-8 * x * log ^ 2 x
-- Merge Sort (with the split by even-odd)
ghci> fit $ mkFitConfig (mergeSortEvenOdd . mkList) (10, 10000)
5.2711e-7 * x * log x
ghci> fit $ mkFitConfig (mergeSortEvenOdd . mkList) (10, 10000)
6.1624e-8 * x * log ^ 2 x
-- Merge Sort (bottom up)
ghci> fit $ mkFitConfig (mergeSortBottomUp . mkList) (10, 10000)
4.1648e-7 * x * log x
ghci> fit $ mkFitConfig (mergeSortBottomUp . mkList) (10, 10000)
8.2759e-7 * x ^ 1.1684
-- Int Sort
ghci> fit $ mkFitConfig (intSort . mkList) (10, 10000)
6.3846e-8 * x * log x
ghci> fit $ mkFitConfig (intSort . mkList) (10, 10000)
2.3924e-7 * x ^ 1.0959
And here’s full code:
{-# OPTIONS_GHC -O0 #-}
module Main where
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.List (sort, partition, foldl')
import Test.Tasty.Bench.Fit (fit, mkFitConfig)
quickSort :: Ord a => [a] -> [a]
quickSort [] = []
quickSort (x : xs) =
let (less, greater) = partition (< x) xs
in quickSort less ++ (x : quickSort greater)
merge :: Ord a => [a] -> [a] -> [a]
merge xs [] = xs
merge [] ys = ys
merge (x : xs) (y : ys) = case compare x y of
EQ -> x : y : merge xs ys
LT -> x : merge xs (y : ys)
GT -> y : merge (x : xs) ys
mergeSortWithLength :: Ord a => [a] -> [a]
mergeSortWithLength [] = []
mergeSortWithLength [x] = [x]
mergeSortWithLength xs =
let (l, r) = splitAt (length xs `div` 2) xs
in merge (mergeSortWithLength l) (mergeSortWithLength r)
mergeSortEvenOdd :: Ord a => [a] -> [a]
mergeSortEvenOdd [] = []
mergeSortEvenOdd [x] = [x]
mergeSortEvenOdd xs =
let (l, r) = splitEvenOdd id id xs
in merge (mergeSortWithLength l) (mergeSortWithLength r)
where
splitEvenOdd :: ([a] -> [a]) -> ([a] -> [a]) -> [a] -> ([a], [a])
splitEvenOdd mkL mkR [] = (mkL [], mkR [])
splitEvenOdd mkL mkR [x] = (mkL [x], mkR [])
splitEvenOdd mkL mkR (x : y : xs) = splitEvenOdd (mkL . (x :)) (mkR . (y :)) xs
mergeSortBottomUp :: Ord a => [a] -> [a]
mergeSortBottomUp = mergeLists . map (:[])
where
mergeLists :: Ord a => [[a]] -> [a]
mergeLists [] = []
mergeLists [x] = x
mergeLists xs = mergeLists $ mergePairs xs
mergePairs :: Ord a => [[a]] -> [[a]]
mergePairs [] = []
mergePairs [x] = [x]
mergePairs (x : y : ys) = merge x y : mergePairs ys
intSort :: [Int] -> [Int]
intSort = unfold . compress
where
compress :: [Int] -> IntMap Int
compress = foldl' (\acc x -> IntMap.insertWith (+) x 1 acc) mempty
unfold :: IntMap Int -> [Int]
unfold = concatMap (\(x, frequency) -> replicate frequency x) . IntMap.toAscList
mkList :: Int -> [Int]
mkList n = take n $ iterate (\n -> n * 6364136223846793005 + 1) n
I just used this to determine my extremely naive CFG parser is probably around O(n^4) (for a specific very simple grammar)
The only catch is that it has a huge constant factor compared to less naive parsers. On my machine an input of 201 characters for a very simple grammar already takes almost 10 seconds.
No, there is a proof that CFG parsing is reducible to binary matrix multiplication, for which the best practical algorithms are around O(n^2.7). But most CFG parsers are O(n^3) and I think O(n^4) is pretty close to that for a very naive approach, especially considering pretty much all parser combinator libraries are exponential in the worst case (and they don’t terminate at all on left-recursive grammars).
But the biggest caveat isthat I’ve only tested my implementation for a specific and quite simple grammar which should be parseable in O(n), so then O(n^4) is not so impressive.