From 7adf3829425b0121eaca994c42034da39e920c6d Mon Sep 17 00:00:00 2001 From: Maciej Bendkowski Date: Sun, 20 Mar 2022 19:32:00 +0100 Subject: [PATCH] Rename BuffonMachine to BitOracle and move it into Data.Boltzmann --- generic-boltzmann-brain.cabal | 2 +- profile/BinTree/BinTree.hs | 2 +- profile/Lambda/Lambda.hs | 2 +- profile/Tree/Tree.hs | 2 +- .../BitOracle.hs} | 32 ++++++++----------- src/Data/Boltzmann/Distribution.hs | 2 +- src/Data/Boltzmann/Sampler.hs | 8 ++--- test/Test/Unit/Distribution.hs | 4 +-- 8 files changed, 25 insertions(+), 29 deletions(-) rename src/Data/{BuffonMachine.hs => Boltzmann/BitOracle.hs} (70%) diff --git a/generic-boltzmann-brain.cabal b/generic-boltzmann-brain.cabal index 4318eef..67612b9 100644 --- a/generic-boltzmann-brain.cabal +++ b/generic-boltzmann-brain.cabal @@ -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: diff --git a/profile/BinTree/BinTree.hs b/profile/BinTree/BinTree.hs index c411c2e..ac62976 100644 --- a/profile/BinTree/BinTree.hs +++ b/profile/BinTree/BinTree.hs @@ -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 diff --git a/profile/Lambda/Lambda.hs b/profile/Lambda/Lambda.hs index c305516..8ff7afb 100644 --- a/profile/Lambda/Lambda.hs +++ b/profile/Lambda/Lambda.hs @@ -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 diff --git a/profile/Tree/Tree.hs b/profile/Tree/Tree.hs index 94050b4..e604110 100644 --- a/profile/Tree/Tree.hs +++ b/profile/Tree/Tree.hs @@ -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] diff --git a/src/Data/BuffonMachine.hs b/src/Data/Boltzmann/BitOracle.hs similarity index 70% rename from src/Data/BuffonMachine.hs rename to src/Data/Boltzmann/BitOracle.hs index 894196a..fc2b080 100644 --- a/src/Data/BuffonMachine.hs +++ b/src/Data/Boltzmann/BitOracle.hs @@ -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 #-} diff --git a/src/Data/Boltzmann/Distribution.hs b/src/Data/Boltzmann/Distribution.hs index 126bb6e..87a7fc6 100644 --- a/src/Data/Boltzmann/Distribution.hs +++ b/src/Data/Boltzmann/Distribution.hs @@ -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) diff --git a/src/Data/Boltzmann/Sampler.hs b/src/Data/Boltzmann/Sampler.hs index 9294fca..99b91f9 100644 --- a/src/Data/Boltzmann/Sampler.hs +++ b/src/Data/Boltzmann/Sampler.hs @@ -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 diff --git a/test/Test/Unit/Distribution.hs b/test/Test/Unit/Distribution.hs index 30565e0..0c684fc 100644 --- a/test/Test/Unit/Distribution.hs +++ b/test/Test/Unit/Distribution.hs @@ -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