mirror of
https://github.com/maciej-bendkowski/generic-boltzmann-brain.git
synced 2024-09-11 12:48:09 +03:00
Convenience mkSystemBoltzmannSampler
This commit is contained in:
parent
60da3d5bb4
commit
1e2938c13d
@ -31,6 +31,7 @@ library
|
||||
Data.Boltzmann.Sampler
|
||||
Data.Boltzmann.Sampler.TH
|
||||
Data.Boltzmann.System
|
||||
Data.Boltzmann.System.TH
|
||||
Data.Boltzmann.Weighed
|
||||
Data.Boltzmann.Weighed.TH
|
||||
Data.BuffonMachine
|
||||
@ -61,7 +62,6 @@ executable binTreeProfile
|
||||
main-is: BinTreeProfile.hs
|
||||
other-modules:
|
||||
BinTree
|
||||
BinTreeSampler
|
||||
Paths_generic_boltzmann_brain
|
||||
hs-source-dirs:
|
||||
profile/BinTree
|
||||
|
@ -1,32 +1,32 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module BinTree (BinTree (..)) where
|
||||
module BinTree (BinTree (..), randomBinTreeListIO) where
|
||||
|
||||
import Data.Boltzmann.Samplable (Distribution, Samplable (..))
|
||||
import Data.Boltzmann.Samplable.TH (mkSamplable)
|
||||
import Data.Boltzmann.Sampler (BoltzmannSampler (..))
|
||||
import Data.Boltzmann.Sampler.TH (mkSampler)
|
||||
import Control.Monad (replicateM)
|
||||
import Data.Boltzmann.Samplable (Distribution (..), Samplable (..))
|
||||
import Data.Boltzmann.Sampler (BoltzmannSampler (..), rejectionSampler)
|
||||
import Data.Boltzmann.System (System (..))
|
||||
import Data.Boltzmann.System.TH (mkSystemBoltzmannSampler)
|
||||
import Data.Boltzmann.Weighed (Weighed (..))
|
||||
import Data.Boltzmann.Weighed.TH (mkWeighed)
|
||||
import Data.BuffonMachine (evalIO)
|
||||
import System.Random.SplitMix (SMGen)
|
||||
|
||||
data BinTree
|
||||
= Leaf
|
||||
| Node BinTree BinTree
|
||||
deriving (Show)
|
||||
|
||||
mkWeighed
|
||||
''BinTree
|
||||
[ ('Leaf, 0)
|
||||
, ('Node, 1)
|
||||
]
|
||||
|
||||
mkSamplable
|
||||
mkSystemBoltzmannSampler
|
||||
System
|
||||
{ targetType = ''BinTree
|
||||
, meanSize = 1000
|
||||
, frequencies = []
|
||||
, weights = []
|
||||
, weights =
|
||||
[ ('Leaf, 0)
|
||||
, ('Node, 1)
|
||||
]
|
||||
}
|
||||
|
||||
mkSampler ''BinTree
|
||||
randomBinTreeListIO :: Int -> Int -> Int -> IO [BinTree]
|
||||
randomBinTreeListIO lb ub n =
|
||||
evalIO $ replicateM n (rejectionSampler @SMGen lb ub)
|
||||
|
@ -1,5 +1,4 @@
|
||||
import BinTree (BinTree)
|
||||
import BinTreeSampler (randomBinTreeListIO)
|
||||
import BinTree (BinTree, randomBinTreeListIO)
|
||||
|
||||
sampler :: Int -> IO [BinTree]
|
||||
sampler = randomBinTreeListIO 8000 12000
|
||||
|
@ -1,12 +0,0 @@
|
||||
module BinTreeSampler (randomBinTreeListIO) where
|
||||
|
||||
import BinTree (BinTree (..))
|
||||
import Control.Monad (replicateM)
|
||||
import Data.Boltzmann.Sampler (rejectionSampler)
|
||||
import Data.BuffonMachine (evalIO)
|
||||
import System.Random.SplitMix (SMGen)
|
||||
|
||||
randomBinTreeListIO :: Int -> Int -> Int -> IO [BinTree]
|
||||
randomBinTreeListIO lb ub n =
|
||||
evalIO $
|
||||
replicateM n (rejectionSampler @SMGen lb ub)
|
@ -4,7 +4,7 @@ module Data.Boltzmann.Samplable.TH (mkSamplable) where
|
||||
|
||||
import Control.Monad (forM, void)
|
||||
import Data.Boltzmann.System (
|
||||
System,
|
||||
System (..),
|
||||
collectTypes,
|
||||
hasAdmissibleFrequencies,
|
||||
paganiniSpecIO,
|
||||
|
@ -7,7 +7,7 @@
|
||||
-- License : BSD3
|
||||
-- Maintainer : maciej.bendkowski@gmail.com
|
||||
-- Stability : experimental
|
||||
module Data.Boltzmann.Sampler.TH (mkSampler) where
|
||||
module Data.Boltzmann.Sampler.TH (mkBoltzmannSampler) where
|
||||
|
||||
import Control.Monad (guard)
|
||||
import qualified Control.Monad.Trans as T
|
||||
@ -185,8 +185,8 @@ genConstrGroup typ = do
|
||||
return $ zip consInfo [0 :: Integer ..]
|
||||
|
||||
-- | Given a type name `a`, instantiates it as `BoltzmannSampler` of `a`.
|
||||
mkSampler :: Name -> Q [Dec]
|
||||
mkSampler typ = do
|
||||
mkBoltzmannSampler :: Name -> Q [Dec]
|
||||
mkBoltzmannSampler typ = do
|
||||
samplerBody <- gen typ
|
||||
let clazz = AppT (ConT $ mkName "BoltzmannSampler") (ConT typ)
|
||||
funDec = FunD (mkName "sample") [Clause [] (NormalB samplerBody) []]
|
||||
|
@ -1,5 +1,3 @@
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
|
||||
module Data.Boltzmann.System (
|
||||
collectTypes,
|
||||
System (..),
|
||||
|
15
src/Data/Boltzmann/System/TH.hs
Normal file
15
src/Data/Boltzmann/System/TH.hs
Normal file
@ -0,0 +1,15 @@
|
||||
module Data.Boltzmann.System.TH (mkSystemBoltzmannSampler) where
|
||||
|
||||
import Data.Boltzmann.System (System (targetType, weights))
|
||||
|
||||
import Data.Boltzmann.Samplable.TH (mkSamplable)
|
||||
import Data.Boltzmann.Sampler.TH (mkBoltzmannSampler)
|
||||
import Data.Boltzmann.Weighed.TH (mkWeighed)
|
||||
import Language.Haskell.TH (Q)
|
||||
import Language.Haskell.TH.Syntax (Dec)
|
||||
|
||||
mkSystemBoltzmannSampler :: System -> Q [Dec]
|
||||
mkSystemBoltzmannSampler sys =
|
||||
mkWeighed (targetType sys) (weights sys)
|
||||
<> mkSamplable sys
|
||||
<> mkBoltzmannSampler (targetType sys)
|
Loading…
Reference in New Issue
Block a user