fused-effects-mwc-random (empty) → 0.1.0.0
raw patch · 10 files changed
+588/−0 lines, 10 filesdep +basedep +fused-effectsdep +fused-effects-mwc-random
Dependencies added: base, fused-effects, fused-effects-mwc-random, fused-effects-random, gauge, mwc-random, primitive, template-haskell, transformers, vector
Files
- CHANGELOG.md +11/−0
- LICENSE +29/−0
- README.md +12/−0
- bench/Bench.hs +24/−0
- fused-effects-mwc-random.cabal +79/−0
- src/Control/Carrier/Random/Instances.hs +66/−0
- src/Control/Carrier/Random/Lifted.hs +85/−0
- src/Control/Effect/Random.hs +251/−0
- test/Magic.hs +16/−0
- test/Test.hs +15/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog++`fused-effects-mwc-random` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++## 0.0.0.0++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/patrickt/fused-effects-mwc-random/releases
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2020, Patrick Thomson+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,12 @@+# fused-effects-mwc-random++[](https://hackage.haskell.org/package/fused-effects-mwc-random)+[](LICENSE)++High-quality uniformly-distributed pseudorandom number generation as an effect.++This library provides a `Random` effect that piggybacks atop the `mwc-random` package, which produces high-quality random numbers in efficient time. A carrier type (`Control.Carrier.Random.Lifted`) encapsulates generator state and provides a convenient API to invoke system random number generation or pass a predefined seed. The `mwc-random` package is finely tuned; as such, this package should be an industrial-strength source of random numbers, suitable for tight loops.++Please note that the [MWC-256](https://en.wikipedia.org/wiki/Multiply-with-carry_pseudorandom_number_generator) algorithm that underlies `mwc-random` is *not* cryptographically secure and should not be used for such purposes. Crypto code should use [`cryptonite`](https://hackage.haskell.org/package/cryptonite), as I'm sure you already know.++For more advanced users, there exists also a module (`Control.Carrier.Random.Instances`) that provides the orphan instances required to use most `fused-effect` stacks with the `PrimMonad` machinery that powers `mwc-random`. This module is most useful when porting monad transformer stacks that already use the `mwc-random` API, or if you need to drop into the native `mwc-random` API.
+ bench/Bench.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE PackageImports #-}++module Main (main) where++import Control.Monad+import Gauge++import qualified "fused-effects-mwc-random" Control.Carrier.Random.Lifted as MWC+import qualified "fused-effects-random" Control.Effect.Random as System++mwc :: Int -> IO [Double]+mwc n = MWC.runRandomSystem (replicateM n MWC.uniform)++system :: Int -> IO [Double]+system n = System.evalRandomIO (replicateM n System.getRandom)++main :: IO ()+main = defaultMain [ bench "System.Random (generate 1 double)" (nfAppIO system 1)+ , bench "MWC.Random (generate 1 double)" (nfAppIO mwc 1)+ , bench "System.Random (generate 10 double)" (nfAppIO system 10)+ , bench "MWC.Random (generate 10 double)" (nfAppIO mwc 10)+ , bench "System.Random (generate 100 double)" (nfAppIO system 100)+ , bench "MWC.Random (generate 100 double)" (nfAppIO mwc 100)+ ]
+ fused-effects-mwc-random.cabal view
@@ -0,0 +1,79 @@+cabal-version: 2.4+name: fused-effects-mwc-random+version: 0.1.0.0+synopsis: High-quality random number generation as an effect.+description: This package wraps the mwc-random package and provides a convenient interface to invoke its functions from an effect stack.+homepage: https://github.com/fused-effects/fused-effects-mwc-random+bug-reports: https://github.com/fused-effects/fused-effects-mwc-random/issues+license: BSD-3-Clause+license-file: LICENSE+author: Patrick Thomson+maintainer: patrickt@github.com+copyright: 2020 Patrick Thomson+category: Control+build-type: Simple+extra-doc-files: README.md+ , CHANGELOG.md+tested-with: GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.1+ , GHC == 8.10.1++common shared+ ghc-options: -Wall+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wcompat+ -Widentities+ -Wredundant-constraints+ -fhide-source-paths++ if (impl(ghc >= 8.10))+ ghc-options: -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module+++ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/fused-effects/fused-effects-mwc-random.git++library+ import: shared+ hs-source-dirs: src+ exposed-modules: Control.Carrier.Random.Lifted+ , Control.Carrier.Random.Instances+ , Control.Effect.Random+++ build-depends: base >= 4.10 && < 4.15+ , fused-effects ^>= 1.1+ , mwc-random >= 0.13.6 && < 0.15+ , vector ^>= 0.12+ , primitive >= 0.6.4 && < 0.8+ , template-haskell >= 2.12+ , transformers >= 0.5.2 && < 0.6++test-suite test+ import: shared+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Test.hs+ other-modules: Magic+ build-depends: base+ , fused-effects+ , fused-effects-mwc-random+ , mwc-random+ , vector++benchmark bench+ import: shared+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Bench.hs+ build-depends: base+ , gauge ^>= 0.2.5+ , fused-effects-random+ , fused-effects-mwc-random
+ src/Control/Carrier/Random/Instances.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | This module exists to export instances of @PrimMonad@ for the @fused-effects@+-- ecosystem. These instances are trivially derivable, since all carrier types are+-- monad transformers, but are boring to have to write by hand.+--+-- This module is most useful when porting monad transformer stacks that already use+-- @mwc-random@ to the fused-effects ecosystem, or for when you have very+-- fine-grained need to control the behavior or state of a random number generator.+-- For new code, the 'Control.Effect.Random' effect will provide a more genial interface.+module Control.Carrier.Random.Instances where++import Control.Carrier.Choose.Church (ChooseC)+import Control.Carrier.Cull.Church (CullC)+import Control.Carrier.Cut.Church (CutC)+import Control.Carrier.Empty.Maybe (EmptyC)+import Control.Carrier.Error.Either (ErrorC)+import Control.Carrier.Fail.Either (FailC)+import Control.Carrier.Fresh.Strict (FreshC)+import Control.Carrier.Lift (LiftC)+import Control.Carrier.Reader (ReaderC)+import qualified Control.Carrier.State.Lazy as Lazy+import qualified Control.Carrier.State.Strict as Strict+import Control.Carrier.Throw.Either (ThrowC)+import Control.Carrier.Writer.Strict (WriterC)+import Control.Monad+import Control.Monad.Primitive+import Control.Monad.Trans.Class+import Data.Traversable+import Language.Haskell.TH.Lib++instance PrimMonad m => PrimMonad (LiftC m) where+ type PrimState (LiftC m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}++fmap+ join+ ( for+ [''ChooseC, ''CullC, ''CutC, ''EmptyC, ''FailC, ''FreshC]+ ( \c ->+ [d|+ instance PrimMonad m => PrimMonad ($(conT c) m) where+ type PrimState ($(conT c) m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+ |]+ )+ )++fmap+ join+ ( for+ [''ReaderC, ''ErrorC, ''Strict.StateC, ''Lazy.StateC, ''ThrowC, ''WriterC]+ ( \c ->+ [d|+ instance PrimMonad m => PrimMonad ($(conT c) r m) where+ type PrimState ($(conT c) r m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+ |]+ )+ )
+ src/Control/Carrier/Random/Lifted.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}++-- | This carrier lifts the internals of its random number generation into+-- a 'LiftC' constraint, assuming the parameter to that 'LiftC' implements+-- 'PrimMonad'. In practice, this means that your effect stack must terminate+-- with @LiftC IO@ or @LiftC (ST s)@.+module Control.Carrier.Random.Lifted+ ( RandomC (..),+ runRandomSystem,+ runRandomSeeded,++ -- * Random effect+ module Control.Effect.Random,+ )+where++import Control.Algebra+import Control.Carrier.Lift+import Control.Carrier.Reader+import Control.Effect.Random+import Control.Effect.Sum+import Control.Monad.Fail+import Control.Monad.IO.Class+import Control.Monad.Primitive+import qualified System.Random.MWC as MWC+import qualified System.Random.MWC.Distributions as Dist++newtype RandomC prim m a = RandomC {runRandomC :: ReaderC (MWC.Gen (PrimState prim)) m a}+ deriving (Applicative, Functor, Monad, MonadFail, MonadIO)++instance (Algebra sig m, Member (Lift n) sig, PrimMonad n) => Algebra (Random :+: sig) (RandomC n m) where+ alg hdl sig ctx = do+ gen <- RandomC ask+ case sig of+ L (Random dist) -> do+ let act = case dist of+ Uniform -> MWC.uniform+ UniformR r -> MWC.uniformR r+ Normal m d -> Dist.normal m d+ Standard -> Dist.standard+ Exponential s -> Dist.exponential s+ TruncatedExp s r -> Dist.truncatedExp s r+ Gamma s h -> Dist.gamma s h+ ChiSquare d -> Dist.chiSquare d+ Beta a b -> Dist.beta a b+ Categorical w -> Dist.categorical w+ LogCategorical lw -> Dist.logCategorical lw+ Geometric0 p -> Dist.geometric0 p+ Geometric1 p -> Dist.geometric1 p+ Bernoulli p -> Dist.bernoulli p+ Dirichlet t -> Dist.dirichlet t+ Permutation n -> Dist.uniformPermutation n+ Shuffle v -> Dist.uniformShuffle v+ res <- sendM @n (act gen)+ pure (res <$ ctx)+ L Save -> do+ res <- sendM @n (MWC.save gen)+ pure (res <$ ctx)+ R other -> RandomC (alg (runRandomC . hdl) (R other) ctx)+ {-# INLINE alg #-}++-- | Run a computation, seeding its random values from the system random number generator.+--+-- This is the de facto standard way to use this carrier. Keep in mind that seeding the RNG+-- may be a computationally intensive process.+runRandomSystem :: MonadIO m => RandomC IO m a -> m a+runRandomSystem (RandomC act) = do+ rand <- liftIO MWC.createSystemRandom+ runReader rand act++-- | Run a computation, seeding its random values from an existing 'MWC.Seed'.+runRandomSeeded :: forall m n sig a. (Has (Lift n) sig m, PrimMonad n) => MWC.Seed -> RandomC n m a -> m a+runRandomSeeded s (RandomC act) = do+ rand <- sendM @n (MWC.restore s)+ runReader rand act
+ src/Control/Effect/Random.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-}++-- | The @Random@ effect provides access to uniformly distributed random values of+-- user-specified types or from well-known numerical distributions.+--+-- This is the “fancy” syntax that hides most details of randomness+-- behind a nice API.+module Control.Effect.Random+ ( Random (..),++ -- * Uniform distributions+ uniform,+ uniformR,++ -- * Continuous distributions+ normal,+ standard,+ exponential,+ truncatedExp,+ gamma,+ chiSquare,+ beta,++ -- * Discrete distributions+ categorical,+ logCategorical,+ geometric0,+ geometric1,+ bernoulli,+ dirichlet,++ -- * Permutations+ uniformPermutation,+ uniformShuffle,++ -- * Introspection+ save,+ Distrib (..),++ -- * Re-exports+ MWC.Variate,+ Has,+ )+where++import Control.Algebra+import Data.Kind+import Data.Vector.Generic (Vector)+import qualified System.Random.MWC as MWC++-- | GADT representing the functions provided by mwc-random.+data Distrib a where+ Uniform :: MWC.Variate a => Distrib a+ UniformR :: MWC.Variate a => (a, a) -> Distrib a+ Normal :: Double -> Double -> Distrib Double+ Standard :: Distrib Double+ Exponential :: Double -> Distrib Double+ TruncatedExp :: Double -> (Double, Double) -> Distrib Double+ Gamma :: Double -> Double -> Distrib Double+ ChiSquare :: Int -> Distrib Double+ Beta :: Double -> Double -> Distrib Double+ Categorical :: Vector v Double => v Double -> Distrib Int+ LogCategorical :: Vector v Double => v Double -> Distrib Int+ Geometric0 :: Double -> Distrib Int+ Geometric1 :: Double -> Distrib Int+ Bernoulli :: Double -> Distrib Bool+ Dirichlet :: Traversable t => t Double -> Distrib (t Double)+ Permutation :: Vector v Int => Int -> Distrib (v Int)+ Shuffle :: Vector v a => v a -> Distrib (v a)++data Random (m :: Type -> Type) k where+ Random :: Distrib a -> Random m a+ Save :: Random m MWC.Seed++-- | Generate a single uniformly distributed random variate. The+-- range of values produced varies by type:+--+-- * For fixed-width integral types, the type's entire range is+-- used.+--+-- * For floating point numbers, the range (0,1] is used. Zero is+-- explicitly excluded, to allow variates to be used in+-- statistical calculations that require non-zero values+-- (e.g. uses of the 'log' function).+--+-- To generate a 'Float' variate with a range of [0,1), subtract+-- 2**(-33). To do the same with 'Double' variates, subtract+-- 2**(-53).+uniform :: (MWC.Variate a, Has Random sig m) => m a+uniform = send (Random Uniform)+{-# INLINE uniform #-}++-- | Generate single uniformly distributed random variable in a+-- given range.+--+-- * For integral types inclusive range is used.+--+-- * For floating point numbers range (a,b] is used if one ignores+-- rounding errors.+uniformR :: (MWC.Variate a, Has Random sig m) => (a, a) -> m a+uniformR r = send (Random (UniformR r))+{-# INLINE uniformR #-}++-- | Generate a normally distributed random variate with given mean and standard deviation.+normal ::+ Has Random sig m =>+ -- | Mean+ Double ->+ -- | Standard deviation+ Double ->+ m Double+normal m d = send (Random (Normal m d))++-- | Generate a normally distributed random variate with zero mean and unit variance.+standard :: Has Random sig m => m Double+standard = send (Random Standard)++-- | Generate an exponentially distributed random variate.+exponential ::+ Has Random sig m =>+ -- | Scale parameter+ Double ->+ m Double+exponential s = send (Random (Exponential s))++-- | Generate truncated exponentially distributed random variate.+truncatedExp ::+ Has Random sig m =>+ -- | Scale parameter+ Double ->+ -- | Range to which distribution is+ -- truncated. Values may be negative.+ (Double, Double) ->+ m (Double)+truncatedExp s r = send (Random (TruncatedExp s r))++-- | Random variate generator for gamma distribution.+gamma ::+ Has Random sig m =>+ -- | Shape parameter+ Double ->+ -- | Scale parameter+ Double ->+ m Double+gamma s d = send (Random (Gamma s d))++-- | Random variate generator for the chi square distribution.+chiSquare ::+ Has Random sig m =>+ -- | Number of degrees of freedom+ Int ->+ m Double+chiSquare d = send (Random (ChiSquare d))++-- | Random variate generator for the geometric distribution,+-- computing the number of failures before success. Distribution's+-- support is [0..].+geometric0 ::+ Has Random sig m =>+ -- | /p/ success probability lies in (0,1]+ Double ->+ m Int+geometric0 p = send (Random (Geometric0 p))++-- | Random variate generator for geometric distribution for number of+-- trials. Distribution's support is [1..] (i.e. just 'geometric0'+-- shifted by 1).+geometric1 ::+ Has Random sig m =>+ -- | /p/ success probability lies in (0,1]+ Double ->+ m Int+geometric1 p = send (Random (Geometric1 p))++-- | Random variate generator for Beta distribution+beta ::+ Has Random sig m =>+ -- | alpha (>0)+ Double ->+ -- | beta (>0)+ Double ->+ m Double+beta a b = send (Random (Beta a b))+{-# INLINE beta #-}++-- | Random variate generator for Dirichlet distribution+dirichlet ::+ (Has Random sig m, Traversable t) =>+ -- | container of parameters+ t Double ->+ m (t Double)+{-# INLINE dirichlet #-}+dirichlet t = send (Random (Dirichlet t))++-- | Random variate generator for Bernoulli distribution+bernoulli ::+ Has Random sig m =>+ -- | Probability of success (returning True)+ Double ->+ m Bool+{-# INLINE bernoulli #-}+bernoulli p = send (Random (Bernoulli p))++-- | Random variate generator for categorical distribution.+categorical ::+ (Has Random sig m, Vector v Double) =>+ -- | List of weights [>0]+ v Double ->+ m Int+{-# INLINE categorical #-}+categorical v = send (Random (Categorical v))++-- | Random variate generator for categorical distribution where the+-- weights are in the log domain. It's implemented in terms of+-- 'categorical'.+logCategorical ::+ (Has Random sig m, Vector v Double) =>+ -- | List of logarithms of weights+ v Double ->+ m Int+logCategorical v = send (Random (LogCategorical v))++-- | Save the state of the random number generator to be used by subsequent+-- carrier invocations.+save :: Has Random sig m => m MWC.Seed+save = send Save++-- | Random variate generator for uniformly distributed permutations. It returns random permutation of vector [0 .. n-1]. This is the Fisher-Yates shuffle.+uniformPermutation ::+ (Has Random sig m, Vector v Int) =>+ Int ->+ m (v Int)+uniformPermutation n = send (Random (Permutation n))++-- | Random variate generator for a uniformly distributed shuffle (all+-- shuffles are equiprobable) of a vector. It uses Fisher-Yates+-- shuffle algorithm.+--+-- Implementation details prevent a native implementation of the 'MWC.uniformShuffleM'+-- function. Use the native API if this is required.+uniformShuffle ::+ (Has Random sig m, Vector v a) =>+ v a ->+ m (v a)+uniformShuffle n = send (Random (Shuffle n))
+ test/Magic.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedLists, ScopedTypeVariables #-}++module Magic (doit) where++import Control.Carrier.Lift+import Control.Carrier.Random.Instances ()+import Control.Carrier.Reader+import Control.Monad.IO.Class+import qualified Data.Vector as Vector+import qualified System.Random.MWC as MWC++doit :: IO ()+doit = runM $ runReader 'a' $ do+ x <- MWC.initialize (Vector.fromList [1, 2,3])+ (y :: Double) <- MWC.uniform x+ liftIO $ print y
+ test/Test.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE TypeApplications #-}++module Main where++import Control.Carrier.Lift+import Control.Carrier.Random.Lifted+import Control.Monad.IO.Class+import Data.Foldable+import Magic++main :: IO ()+main = do+ doit+ runM . runRandomSystem $+ for_ [(1 :: Int)..4] $ \_ -> uniform @Double >>= liftIO . print