Are new sequences really O(1)?

24 May 2005

      Hello,

Just been trying a few simple benchmarks to compare
the new sequences with AVL trees for simple deque
operations and I'm getting some strange results.

Code for both is attached at the end of this post,
but basically the test in each case is: 

1- Build a sequence of sz elements by pushing them one
   by one on the right.
2- Rotate the sequence right sz times, each rotation
   pops the rightmost element and pushes it on the left.
3- Empty the sequence by popping the leftmost element
   sz times.

With ghc-6.4, results are (time in no particular units)
  sz    AVL   Sequence
----------------------
 2^10  0.278   0.177   
 2^11  0.666   0.425
 2^12  1.464   0.958
 2^13  3.112   2.214 
 2^14  6.664   5.525
 2^15 14.18   12.18
 2^16 30.16   27.31
 2^17 62.14   60.6
 2^18 130.4  142.6
 2^19 269.3  365.1
 2^20 564.4  *****

The AVL figures seem to show roughly the kind of
n*(log n) growth I would expect. The Sequence figures
start out promisingly enough, but seem to get progressively
worse until it's actually slower than AVL. This isn't what
I'd expect from an algorithm advertised as having O(1)
asymptotic complexity for pushing/popping. It seems more
like O(log n) or worse?

Also there are no figures for 2^20 for Sequence
because I get a stack overflow at this point.

So any idea whether this is a bug in my understanding?,
or a bug in the theory?, or a bug in the code perhaps?
Maybe it's being excessively lazy somewhere (often
the cause of stack overflows IME).

Regards
--
Adrian Hey

Code follows:

{-# OPTIONS -fno-cse -fno-full-laziness #-}
module Main (main) where

import Data.Sequence

import System.CPUTime(getCPUTime,cpuTimePrecision)
import System.Mem(performGC)

result :: Int -> Seq ()
result sz = rep pop $ rep rot $ rep push empty
 where rep        = rep' sz
       rep' 0 f x = x
       rep' n f x = let x' = f x in x' `seq` rep' (n-1) f x'
       push sq = sq |> ()
       rot  sq = case viewR sq of sq' :> x -> x <| sq'
                                  EmptyR   -> empty
       pop  sq = case viewL sq of _ :< sq' -> sq'
                                  EmptyL   -> undefined

test :: (Int,Int) -> IO ()
test (n,sz) = do performGC
                 t0 <- getCPUTime
                 rep n
                 t1 <- getCPUTime
                 putStr   $ show sz ++ " : "
                 putStrLn $ show $ (fromIntegral ((t1-t0) `div` 
cpuTimePrecision)) / (fromIntegral n)
            where rep 0 = return ()
                  rep m = (result sz) `seq` rep (m-1) 

main :: IO ()
main = mapM_ test [(10*2^(maxP-p), 2^p) | p <- [10..maxP]]
 where maxP = 20
----------------------------------------------------------------

{-# OPTIONS -fno-cse -fno-full-laziness #-}
module Main (main) where

import Data.Tree.AVL

import System.CPUTime(getCPUTime,cpuTimePrecision)
import System.Mem(performGC)

result :: Int -> AVL ()
result sz = rep pop $ rep rot $ rep push empty
 where rep        = rep' sz
       rep' 0 f x = x
       rep' n f x = let x' = f x in x' `seq` rep' (n-1) f x'
       push sq = pushR sq ()
       rot  sq = case popR sq of (sq', x  ) -> pushL x sq'
       pop  sq = case popL sq of (_  , sq') -> sq'

test :: (Int,Int) -> IO ()
test (n,sz) = do performGC
                 t0 <- getCPUTime
                 rep n
                 t1 <- getCPUTime
                 putStr   $ show sz ++ " : "
                 putStrLn $ show $ (fromIntegral ((t1-t0) `div` 
cpuTimePrecision)) / (fromIntegral n)
            where rep 0 = return ()
                  rep m = (result sz) `seq` rep (m-1) 

main :: IO ()
main = mapM_ test [(10*2^(maxP-p), 2^p) | p <- [10..maxP]]
 where maxP = 20