diff --git a/README.md b/README.md index 3414b16..a21f73c 100644 --- a/README.md +++ b/README.md @@ -63,7 +63,7 @@ in that respect closely related to QuickCheck's generator type `Gen a` to which it can be converted through, e.g.: ``` hs -hoistRejectionSampler :: +quickCheckRejectionSampler :: BoltzmannSampler a => (Int -> (LowerBound, UpperBound)) -> Gen a ``` diff --git a/api/Data/Boltzmann.hs b/api/Data/Boltzmann.hs index 822d415..245bba9 100644 --- a/api/Data/Boltzmann.hs +++ b/api/Data/Boltzmann.hs @@ -14,8 +14,8 @@ module Data.Boltzmann ( toleranceRejectionSampler, mkBoltzmannSampler, mkDefBoltzmannSampler, - hoistRejectionSampler, - hoistToleranceRejectionSampler, + quickCheckRejectionSampler, + quickCheckToleranceRejectionSampler, -- * Buffon machines BuffonMachine, @@ -39,8 +39,8 @@ import Data.Boltzmann.Sampler ( BoltzmannSampler (..), LowerBound (..), UpperBound (..), - hoistRejectionSampler, - hoistToleranceRejectionSampler, + quickCheckRejectionSampler, + quickCheckToleranceRejectionSampler, rejectionSampler, toleranceRejectionSampler, ) diff --git a/internal/Data/Boltzmann/Sampler.hs b/internal/Data/Boltzmann/Sampler.hs index a9b629e..fcc6d59 100644 --- a/internal/Data/Boltzmann/Sampler.hs +++ b/internal/Data/Boltzmann/Sampler.hs @@ -16,17 +16,18 @@ module Data.Boltzmann.Sampler ( toleranceRejectionSampler, -- * Other utilities - hoistRejectionSampler, - hoistToleranceRejectionSampler, + quickCheckRejectionSampler, + quickCheckToleranceRejectionSampler, ) where import Control.Monad.Trans.Maybe (MaybeT, runMaybeT) import Data.Boltzmann.BuffonMachine (BuffonMachine, eval) import Data.Coerce (coerce) import System.Random (RandomGen) -import Test.QuickCheck (Gen) -import Test.QuickCheck.Gen (Gen (MkGen)) -import Test.QuickCheck.Random (QCGen (QCGen)) + +import qualified Test.QuickCheck as QuickCheck (Gen) +import qualified Test.QuickCheck.Gen as QuickCheck (Gen (MkGen)) +import qualified Test.QuickCheck.Random as QuickCheck (QCGen (QCGen)) -- | Multiparametric Boltzmann samplers. class BoltzmannSampler a where @@ -73,21 +74,26 @@ toleranceRejectionSampler n eps = rejectionSampler lb ub ub = MkUpperBound $ ceiling $ (1 + eps) * fromIntegral n -- | --- Using the given tolerance, hoists a tolerance rejection sampler +-- Using the given tolerance, maps a tolerance rejection sampler -- for @a@ to a Quickcheck generator @Gen a@. -hoistRejectionSampler :: +quickCheckRejectionSampler :: BoltzmannSampler a => (Int -> (LowerBound, UpperBound)) -> - Gen a -hoistRejectionSampler genBounds = MkGen $ \(QCGen g) n -> - let (lb, ub) = genBounds n - machine = rejectionSampler lb ub - in eval machine g + QuickCheck.Gen a +quickCheckRejectionSampler genBounds = QuickCheck.MkGen $ + \(QuickCheck.QCGen g) n -> + let (lb, ub) = genBounds n + machine = rejectionSampler lb ub + in eval machine g -- | --- Using the given tolerance, hoists a tolerance rejection sampler +-- Using the given tolerance, maps a tolerance rejection sampler -- for @a@ to a Quickcheck generator @Gen a@. -hoistToleranceRejectionSampler :: BoltzmannSampler a => Double -> Gen a -hoistToleranceRejectionSampler eps = MkGen $ \(QCGen g) n -> - let machine = toleranceRejectionSampler n eps - in eval machine g +quickCheckToleranceRejectionSampler :: + BoltzmannSampler a => + Double -> + QuickCheck.Gen a +quickCheckToleranceRejectionSampler eps = QuickCheck.MkGen $ + \(QuickCheck.QCGen g) n -> + let machine = toleranceRejectionSampler n eps + in eval machine g diff --git a/stack.yaml b/stack.yaml index 4241b5c..72f612c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -39,6 +39,7 @@ packages: # extra-deps: - criterion-1.5.12.0 +- testing-feat-1.1.0.0 - git: https://github.com/maciej-bendkowski/paganini-hs commit: 941e8f6314ea49b79c2cf1a03924cbedc981917e - git: https://github.com/OctopiChalmers/BinderAnn diff --git a/stack.yaml.lock b/stack.yaml.lock index 64146cd..a5f9e4b 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -11,6 +11,13 @@ packages: sha256: 92034e3e490c5fe0eab10277f6e35534b37dc0962347025630380c7d37d99ca1 original: hackage: criterion-1.5.12.0 +- completed: + hackage: testing-feat-1.1.0.0@sha256:7c7629c5014edf06aefbf30a061d1ee64c6ee15f438d868e34749fb22208ab0b,2466 + pantry-tree: + size: 790 + sha256: 444f3c68a4f4fa1488fbbe9e8d9bbcc5f226b12a5027ee93683d5f95bf0ece28 + original: + hackage: testing-feat-1.1.0.0 - completed: name: paganini-hs version: 0.3.0.0 diff --git a/test/Test/Samplers/BinTree.hs b/test/Test/Samplers/BinTree.hs index c78f0a0..6d035dd 100644 --- a/test/Test/Samplers/BinTree.hs +++ b/test/Test/Samplers/BinTree.hs @@ -9,7 +9,7 @@ import Data.Boltzmann ( LowerBound (MkLowerBound), System (..), UpperBound (MkUpperBound), - hoistRejectionSampler, + quickCheckRejectionSampler, mkBoltzmannSampler, mkDefWeights, ) @@ -40,6 +40,6 @@ mkBoltzmannSampler instance Arbitrary BinTree where arbitrary = - hoistRejectionSampler $ + quickCheckRejectionSampler $ const (MkLowerBound 800, MkUpperBound 1200) shrink = const [] diff --git a/test/Test/Samplers/Lambda.hs b/test/Test/Samplers/Lambda.hs index b1bc88d..92046cf 100644 --- a/test/Test/Samplers/Lambda.hs +++ b/test/Test/Samplers/Lambda.hs @@ -14,7 +14,7 @@ import Data.Boltzmann ( LowerBound (MkLowerBound), System (..), UpperBound (MkUpperBound), - hoistRejectionSampler, + quickCheckRejectionSampler, mkBoltzmannSampler, mkDefWeights, ) @@ -67,7 +67,7 @@ instance Size Lambda where instance Arbitrary Lambda where arbitrary = - hoistRejectionSampler $ + quickCheckRejectionSampler $ const (MkLowerBound 8_000, MkUpperBound 12_000) shrink = const [] @@ -95,6 +95,6 @@ mkBoltzmannSampler instance Arbitrary BinLambda where arbitrary = - hoistRejectionSampler $ + quickCheckRejectionSampler $ const (MkLowerBound 5_000, MkUpperBound 6_400) shrink = const [] diff --git a/test/Test/Samplers/Tree.hs b/test/Test/Samplers/Tree.hs index cec55ee..88b0217 100644 --- a/test/Test/Samplers/Tree.hs +++ b/test/Test/Samplers/Tree.hs @@ -9,7 +9,7 @@ import Data.Boltzmann ( LowerBound (MkLowerBound), System (..), UpperBound (MkUpperBound), - hoistRejectionSampler, + quickCheckRejectionSampler, mkBoltzmannSampler, mkDefBoltzmannSampler, mkDefWeights, @@ -30,7 +30,7 @@ instance Size Tree where instance Arbitrary Tree where arbitrary = - hoistRejectionSampler $ + quickCheckRejectionSampler $ const (MkLowerBound 1600, MkUpperBound 2400) shrink = const [] @@ -53,6 +53,6 @@ mkBoltzmannSampler instance Arbitrary Tree' where arbitrary = - hoistRejectionSampler $ + quickCheckRejectionSampler $ const (MkLowerBound 8500, MkUpperBound 11_150) shrink = const []