ttrie-0.1: benchmarks/BenchGen.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module BenchGen where

import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Primitive
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict
import Data.Bifunctor
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Vector as V
import System.Random.MWC
import System.Random.MWC.CondensedTable

------------------------------------------------------------------------------

newtype Generator m k a = Generator { unG :: StateT (Gen (PrimState m), Set k) m a }
  deriving (Functor, Applicative, Monad)

instance MonadIO m => MonadIO (Generator m k) where
    liftIO = Generator . liftIO

runGenerator :: PrimMonad m => Gen (PrimState m) -> Generator m k a -> m a
runGenerator gen (Generator m) = evalStateT m (gen, Set.empty)

liftGen :: PrimMonad m => (Gen (PrimState m) -> m a) -> Generator m k a
liftGen f = Generator $ lift . f =<< gets fst

reuse :: (PrimMonad m, Ord k) => Generator m k k -> Generator m k k
reuse keygen = Generator $ do
    (gen,ks) <- get
    if Set.null ks
        then unG keygen
        else do
            i <- lift $ uniformR (0, Set.size ks - 1) gen
            return $ Set.elemAt i ks

remember :: (PrimMonad m, Ord k) => Generator m k k -> Generator m k k
remember keygen = Generator $ do
    k <- unG keygen
    modify (second $ Set.insert k)
    return k

forget :: (PrimMonad m, Ord k) => Generator m k k -> Generator m k k
forget keygen = Generator $ do
    k <- unG keygen
    modify (second $ Set.delete k)
    return k

------------------------------------------------------------------------------

data Config m op k = Config { operations :: CondensedTableV op
                            , keys :: op -> CondensedTableV (Generator m k k)
                            }

generateOperations :: (PrimMonad m, Ord k)
                   => Config m op k
                   -> Int
                   -> Generator m k [(op,k)]
generateOperations config n =
    replicateM n $ do
        op <- liftGen $ genFromTable (operations config)
        k <- join $ liftGen $ genFromTable $ (keys config) op
        return (op,k)

------------------------------------------------------------------------------

mkTable :: [(a,Double)] -> CondensedTableV a
mkTable = tableFromWeights . V.fromList