diff --git a/internal/Data/Boltzmann/Sampler/TH.hs b/internal/Data/Boltzmann/Sampler/TH.hs index c4779de..b3981df 100644 --- a/internal/Data/Boltzmann/Sampler/TH.hs +++ b/internal/Data/Boltzmann/Sampler/TH.hs @@ -222,6 +222,10 @@ mkDefWeights' targetType = do pure $ MkConstructorWeights $ names `zip` repeat (1 :: Int) +-- | +-- Generates a @ConstructorWeights@ container with all constructors +-- in the system corresponding to the target type. Constructor weights +-- are all set to one. mkDefWeights :: Name -> Q Exp mkDefWeights targetType = mkDefWeights' targetType >>= Lift.lift diff --git a/internal/Data/Boltzmann/System.hs b/internal/Data/Boltzmann/System.hs index 61b5014..3581b35 100644 --- a/internal/Data/Boltzmann/System.hs +++ b/internal/Data/Boltzmann/System.hs @@ -1,5 +1,12 @@ {-# LANGUAGE TemplateHaskell #-} +-- | +-- Module : Data.Boltzmann.System +-- Description : +-- Copyright : (c) Maciej Bendkowski, 2022 +-- License : BSD3 +-- Maintainer : maciej.bendkowski@gmail.com +-- Stability : experimental module Data.Boltzmann.System ( Types (..), Distributions (..), @@ -55,17 +62,26 @@ import Data.Coerce (coerce) import Data.Default (Default (def)) import Prelude hiding (seq) +-- | +-- Map-like containers for constructors with respective weights/frequencies. +-- Stored constructors should have unique values. class Constructable a where + -- | + -- Inserts a new name @(constructor, value)@ pair into the container. + -- If the constructor is already present in the container, its value + -- should be updated. (<:>) :: (Name, Int) -> a -> a infixr 6 <:> +-- | +-- Constructors with corresponding weights. +-- Note that semigroup's @<>@ is left-biased. newtype ConstructorWeights = MkConstructorWeights {unConstructorWeights :: [(Name, Int)]} deriving (Show) via [(Name, Int)] instance Semigroup ConstructorWeights where - -- left-biased union xs <> ys = MkConstructorWeights (Map.toList $ xs' <> ys') where xs' = Map.fromList (unConstructorWeights xs) @@ -79,6 +95,9 @@ instance Constructable ConstructorWeights where Lift.deriveLift ''ConstructorWeights +-- | +-- Constructors with corresponding frequencies. +-- Note that semigroup's @<>@ is left-biased. newtype ConstructorFrequencies = MkConstructorFrequencies {unConstructorFrequencies :: [(Name, Int)]} deriving (Show) via [(Name, Int)] @@ -99,11 +118,17 @@ instance Monoid ConstructorFrequencies where instance Constructable ConstructorFrequencies where x <:> xs = MkConstructorFrequencies [x] <> xs +-- | +-- System of algebraic data types. data System = System - { targetType :: Name - , meanSize :: Int - , weights :: ConstructorWeights - , frequencies :: ConstructorFrequencies + { -- | Target type of the system. + targetType :: Name + , -- | Target mean size of the target types. + meanSize :: Int + , -- | Weights of all constructors in the system. + weights :: ConstructorWeights + , -- | Frequencies of selected constructors in the system. + frequencies :: ConstructorFrequencies } deriving (Show) diff --git a/internal/Data/Boltzmann/System/TH.hs b/internal/Data/Boltzmann/System/TH.hs index b0450bd..26e2036 100644 --- a/internal/Data/Boltzmann/System/TH.hs +++ b/internal/Data/Boltzmann/System/TH.hs @@ -280,6 +280,10 @@ mkBoltzmannSampler' sys = do pure $ typeSynonyms <> concat decls +-- | +-- Given a system of algebraic data types, generates a series of corresponding +-- @BoltzmannSampler@ instances. For @newtype@ target types, anonymous +-- intermediate types are constructed. mkBoltzmannSampler :: System -> Q [Dec] mkBoltzmannSampler sys = do ctx <- mkSystemCtx sys @@ -291,6 +295,11 @@ mkBoltzmannSampler sys = do runReaderT (mkBoltzmannSampler' sys') ctx +-- | +-- Given a target type name and a mean size, generates a Boltzmann sampler for +-- the corresponding system using @mkBoltzmannSampler@. Default constructor +-- weights are used (see @mkDefWeights@). No custom constructor frequencies are +-- assumed. mkDefBoltzmannSampler :: Name -> Int -> Q [Dec] mkDefBoltzmannSampler typ meanSize = do defWeights <- mkDefWeights' typ diff --git a/src/Data/Boltzmann.hs b/src/Data/Boltzmann.hs index 6d11e90..adb6c59 100644 --- a/src/Data/Boltzmann.hs +++ b/src/Data/Boltzmann.hs @@ -1,15 +1,20 @@ module Data.Boltzmann ( - ConstructorWeights, - ConstructorFrequencies, - System (..), + -- * Combinatorial systems Constructable (..), - mkBoltzmannSampler, - mkDefBoltzmannSampler, + ConstructorFrequencies, + ConstructorWeights, + System (..), + mkDefWeights, + + -- * Boltzmann samplers BoltzmannSampler (..), rejectionSampler, toleranceRejectionSampler, + mkBoltzmannSampler, + mkDefBoltzmannSampler, hoistBoltzmannSampler, - mkDefWeights, + + -- * Buffon machines BuffonMachine, EvalIO (..), eval,