Sequence.hs

{-# LANGUAGE UndecidableInstances #-}
module Main (

    main

) where

-- Control

import Control.DeepSeq

-- Data

import           Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import           Data.Incremental
import           Data.Incremental.Sequence as IncSeq

-- Test

import Test.QuickCheck

-- Benchmark

import Benchmark

main :: IO ()
main = do
    performSortBenchmark 10000 10
    performSortBenchmark 100000 10
    performSortBenchmark 1000000 10

-- * Benchmarking

performSortBenchmark :: Int -> Int -> IO ()
performSortBenchmark = performBenchmark (Seq.sort :: Seq Int -> Seq Int)
                                        IncSeq.sort

performBenchmark :: (Arbitrary a, NFData a, Changeable a,
                     DefaultChange a ~ PrimitiveChange a,
                     Arbitrary b, NFData b, Changeable b)
                 => (Seq a -> Seq b)
                 -> (Seq a ->> Seq b)
                 -> Int
                 -> Int
                 -> IO ()
performBenchmark fun trans initLen changeCount = do
    putStrLn $ "Length of initial sequence: " ++ show initLen
    putStrLn $ "Number of changes:          " ++ show changeCount
    src <- generate $ srcGen initLen changeCount
    runBenchmark fun trans src

-- * Benchmark data generation

srcGen :: (Arbitrary a, Changeable a, DefaultChange a ~ PrimitiveChange a)
       => Int
       -> Int
       -> Gen (Seq a, [DefaultChange (Seq a)])
srcGen initLen changeCount = do
    seq <- seqGen initLen
    changes <- changesGen initLen changeCount
    return (seq, changes) where

    changesGen len changeCount
        | changeCount == 0 = return []
        | otherwise        = do
            (change, lenDiff) <- changeAndLengthDiffGen len
            changes <- changesGen (len + lenDiff) (pred changeCount)
            return (change : changes)

-- | Generates a sequence of the given length.
seqGen :: Arbitrary a => Int -> Gen (Seq a)
seqGen len = do
    elems <- vectorOf len arbitrary
    return (Seq.fromList elems)

{-|
    Generates a sequence change that deals with only a single element and stays
    within the bounds of the sequence, along with the change in length that this
    change causes.
-}
changeAndLengthDiffGen :: (Arbitrary a,
                           Changeable a,
                           DefaultChange a ~ PrimitiveChange a)
                       => Int
                       -> Gen (DefaultChange (Seq a), Int)
changeAndLengthDiffGen len
    | len == 0  = insertGen
    | otherwise = oneof [insertGen, deleteGen, shiftGen, changeAtGen] where

    insertGen = do
        ix <- choose (0, len)
        elem <- arbitrary
        return (insert ix (Seq.singleton elem), 1)

    deleteGen = do
        ix <- choose (0, pred len)
        return (delete ix 1, -1)

    shiftGen = do
        src <- choose (0, pred len)
        tgt <- choose (0, pred len)
        return (shift src 1 tgt, 0)

    changeAtGen = do
        ix <- choose (0, pred len)
        newElem <- arbitrary
        return (changeAt ix (ReplaceBy newElem), 0)

-- * Evaluation of changes

instance (NFData a, NFData (DefaultChange a)) => NFData (AtomicChange a) where

    rnf (Insert ix seq)      = ix `deepseq` seq `deepseq` ()
    rnf (Delete ix len)      = ix `deepseq` len `deepseq` ()
    rnf (Shift src len tgt)  = src `deepseq` len `deepseq` tgt `deepseq` ()
    rnf (ChangeAt ix change) = ix `deepseq` change `deepseq` ()