mirror of
https://github.com/maciej-bendkowski/generic-boltzmann-brain.git
synced 2024-08-17 08:30:30 +03:00
Rename BuffonMachine to BitOracle and move it into Data.Boltzmann
This commit is contained in:
parent
e85e894f41
commit
7adf382942
@ -26,12 +26,12 @@ source-repository head
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
Data.Boltzmann.BitOracle
|
||||
Data.Boltzmann.Distribution
|
||||
Data.Boltzmann.Sampler
|
||||
Data.Boltzmann.Sampler.TH
|
||||
Data.Boltzmann.System
|
||||
Data.Boltzmann.System.TH
|
||||
Data.BuffonMachine
|
||||
other-modules:
|
||||
Paths_generic_boltzmann_brain
|
||||
hs-source-dirs:
|
||||
|
@ -6,7 +6,7 @@ import Control.Monad (replicateM)
|
||||
import Data.Boltzmann.Sampler (BoltzmannSampler (..), rejectionSampler')
|
||||
import Data.Boltzmann.System (System (..))
|
||||
import Data.Boltzmann.System.TH (mkBoltzmannSampler)
|
||||
import Data.BuffonMachine (evalIO)
|
||||
import Data.Boltzmann.BitOracle (evalIO)
|
||||
import System.Random.SplitMix (SMGen)
|
||||
|
||||
data BinTree
|
||||
|
@ -7,7 +7,7 @@ import Data.Boltzmann.Sampler (BoltzmannSampler (..), rejectionSampler')
|
||||
import Data.Boltzmann.System (System (..))
|
||||
|
||||
import Data.Boltzmann.System.TH (mkBoltzmannSampler)
|
||||
import Data.BuffonMachine (evalIO)
|
||||
import Data.Boltzmann.BitOracle (evalIO)
|
||||
import System.Random.SplitMix (SMGen)
|
||||
|
||||
data DeBruijn
|
||||
|
@ -6,7 +6,7 @@ import Control.Monad (replicateM)
|
||||
import Data.Boltzmann.Sampler (BoltzmannSampler (..), rejectionSampler')
|
||||
import Data.Boltzmann.System (System (..))
|
||||
import Data.Boltzmann.System.TH (mkBoltzmannSampler)
|
||||
import Data.BuffonMachine (evalIO)
|
||||
import Data.Boltzmann.BitOracle (evalIO)
|
||||
import System.Random.SplitMix (SMGen)
|
||||
|
||||
data Tree = T [Tree]
|
||||
|
@ -1,16 +1,12 @@
|
||||
-- |
|
||||
-- Module : Data.BuffonMachine
|
||||
-- Description : Buffon machines providing random variates for discrete
|
||||
-- probability distributions.
|
||||
-- Module : Data.Boltzmann.BitOracle
|
||||
-- Description :
|
||||
-- Copyright : (c) Maciej Bendkowski, 2022
|
||||
-- License : BSD3
|
||||
-- Maintainer : maciej.bendkowski@gmail.com
|
||||
-- Stability : experimental
|
||||
--
|
||||
-- Monad for computations consuming random bits provided by a buffered random
|
||||
-- bit oracle.
|
||||
module Data.BuffonMachine (
|
||||
BuffonMachine,
|
||||
module Data.Boltzmann.BitOracle (
|
||||
BitOracle,
|
||||
Discrete,
|
||||
Oracle (..),
|
||||
EvalIO (..),
|
||||
@ -64,32 +60,32 @@ regenerate oracle =
|
||||
|
||||
-- |
|
||||
-- Buffon machines implemented as a `State` monad over `Oracle`.
|
||||
newtype BuffonMachine g a = MkBuffonMachine
|
||||
{runBuffonMachine :: State (Oracle g) a}
|
||||
newtype BitOracle g a = MkBitOracle
|
||||
{runBitOracle :: State (Oracle g) a}
|
||||
deriving (Functor, Applicative, Monad) via State (Oracle g)
|
||||
|
||||
class RandomGen g => EvalIO g where
|
||||
evalIO :: BuffonMachine g a -> IO a
|
||||
evalIO :: BitOracle g a -> IO a
|
||||
|
||||
type Bern g = BuffonMachine g Bool
|
||||
type Bern g = BitOracle g Bool
|
||||
|
||||
{-# INLINEABLE getBit #-}
|
||||
getBit :: RandomGen g => Bern g
|
||||
getBit = MkBuffonMachine $ do
|
||||
getBit = MkBitOracle $ do
|
||||
modify' regenerate
|
||||
oracle <- get
|
||||
put $ useBit oracle
|
||||
pure $ currentBit oracle
|
||||
|
||||
-- |
|
||||
-- Buffon machine computations resulting in discrete random variables.
|
||||
type Discrete g = BuffonMachine g Int
|
||||
-- Random computations resulting in discrete random variables.
|
||||
type Discrete g = BitOracle g Int
|
||||
|
||||
-- |
|
||||
-- Runs the given Buffon machine computation using the given random generator.
|
||||
-- Runs the given random computation using the given random generator.
|
||||
{-# INLINEABLE eval #-}
|
||||
eval :: RandomGen g => BuffonMachine g a -> g -> a
|
||||
eval m g = evalState (runBuffonMachine m) (fresh g)
|
||||
eval :: RandomGen g => BitOracle g a -> g -> a
|
||||
eval m g = evalState (runBitOracle m) (fresh g)
|
||||
|
||||
instance EvalIO SMGen where
|
||||
{-# INLINE evalIO #-}
|
@ -5,7 +5,7 @@ module Data.Boltzmann.Distribution (
|
||||
choice,
|
||||
) where
|
||||
|
||||
import Data.BuffonMachine (Discrete, getBit)
|
||||
import Data.Boltzmann.BitOracle (Discrete, getBit)
|
||||
import Data.Vector (Vector, null, (!))
|
||||
import Language.Haskell.TH.Lift (deriveLift)
|
||||
import System.Random (RandomGen, StdGen)
|
||||
|
@ -13,7 +13,7 @@ module Data.Boltzmann.Sampler (
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
|
||||
import Data.BuffonMachine (BuffonMachine, eval)
|
||||
import Data.Boltzmann.BitOracle (BitOracle, eval)
|
||||
import System.Random (RandomGen)
|
||||
import Test.QuickCheck (Gen)
|
||||
import Test.QuickCheck.Gen (Gen (MkGen))
|
||||
@ -21,10 +21,10 @@ import Test.QuickCheck.Random (QCGen (QCGen))
|
||||
|
||||
-- | Multiparametric Boltzmann samplers.
|
||||
class BoltzmannSampler a where
|
||||
sample :: RandomGen g => Int -> MaybeT (BuffonMachine g) (a, Int)
|
||||
sample :: RandomGen g => Int -> MaybeT (BitOracle g) (a, Int)
|
||||
|
||||
rejectionSampler ::
|
||||
(RandomGen g, BoltzmannSampler a) => Int -> Int -> BuffonMachine g a
|
||||
(RandomGen g, BoltzmannSampler a) => Int -> Int -> BitOracle g a
|
||||
rejectionSampler lb ub = do
|
||||
runMaybeT (sample ub)
|
||||
>>= ( \case
|
||||
@ -36,7 +36,7 @@ rejectionSampler lb ub = do
|
||||
)
|
||||
|
||||
rejectionSampler' ::
|
||||
(RandomGen g, BoltzmannSampler a) => Int -> Double -> BuffonMachine g a
|
||||
(RandomGen g, BoltzmannSampler a) => Int -> Double -> BitOracle g a
|
||||
rejectionSampler' n eps = rejectionSampler lb ub
|
||||
where
|
||||
lb = floor $ (1 - eps) * fromIntegral n
|
||||
|
@ -2,7 +2,7 @@ module Test.Unit.Distribution (unitTests) where
|
||||
|
||||
import Control.Monad (replicateM)
|
||||
import Data.Boltzmann.Distribution (Distribution (..), choice)
|
||||
import Data.BuffonMachine (evalIO)
|
||||
import Data.Boltzmann.BitOracle (evalIO)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Vector (fromList)
|
||||
import System.Random.SplitMix (SMGen)
|
||||
@ -19,7 +19,7 @@ import Test.Tasty.HUnit (
|
||||
unitTests :: TestTree
|
||||
unitTests =
|
||||
testGroup
|
||||
"BuffonMachine unit tests"
|
||||
"BitOracle unit tests"
|
||||
[choiceTests]
|
||||
|
||||
choiceTests :: TestTree
|
||||
|
Loading…
Reference in New Issue
Block a user