Minimal Haddock documentation.

src/Data/Boltzmann/Oracle.hs

@@ -1,14 +1,15 @@
-{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- |
 -- Module      : Data.Boltzmann.Oracle
--- Description :
+-- Description : Sampler tuners and (Template Haskell) generators.
 -- Copyright   : (c) Maciej Bendkowski, 2022
 -- License     : BSD3
 -- Maintainer  : maciej.bendkowski@gmail.com
 -- Stability   : experimental
+--
+-- 
 module Data.Boltzmann.Oracle
   ( mkSpecSampler,
   )
@@ -24,6 +25,7 @@ import Data.Boltzmann.Specifiable
   )
 import Data.Boltzmann.Specification (getWeight)
 import qualified Data.Boltzmann.Specification as S
+import Data.BuffonMachine (DDG)
 import qualified Data.Map as Map
 import Data.Map.Strict (Map)
 import Data.Maybe (fromJust)
@@ -43,8 +45,7 @@ import Data.Paganini
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Vector
-  ( Vector,
+  ( fromList,
-    fromList,
   )
 import Instances.TH.Lift ()
 import Language.Haskell.TH
@@ -65,10 +66,11 @@ import Language.Haskell.TH.Syntax
 sum' :: Num a => [a] -> a
 sum' = foldl1 (+)
 
+-- | Map from type names to generic Let variables.
 type VarDefs = Map String Let
 
--- Discrete distribution generating tree.
+-- | Map from type names to discrete distribution generating trees.
-type SystemDDGs = Map String (Vector Int)
+type SystemDDGs = Map String DDG
 
 mkVariables :: Set SpecifiableType -> Spec VarDefs
 mkVariables sys = do
@@ -100,36 +102,36 @@ data Params = Params
   }
 
 mkTypeVariables :: Params -> Set SpecifiableType -> Spec ()
-mkTypeVariables variables types =
+mkTypeVariables params types =
-  mapM_ (mkTypeVariable variables) (Set.toList types)
+  mapM_ (mkTypeVariable params) (Set.toList types)
 
 mkTypeVariable :: Params -> SpecifiableType -> Spec ()
-mkTypeVariable variables (SpecifiableType typ) = do
+mkTypeVariable params (SpecifiableType typ) = do
-  let (Let x) = typeVariable variables Map.! typeName typ
+  let (Let x) = typeVariable params Map.! typeName typ
-  x .=. typeExpr variables (typedef typ)
+  x .=. typeExpr params (typedef typ)
 
 typeExpr :: Params -> TypeDef -> Expr
-typeExpr variables = sum' . map (consExpr variables)
+typeExpr params = sum' . map (consExpr params)
 
 consExpr :: Params -> Cons -> Expr
-consExpr variables cons = defaults u * z ^ w * product args'
+consExpr params cons = defaults u * z ^ w * product args'
   where
-    z = sizeVar variables
+    z = sizeVar params
-    u = name cons `Map.lookup` markingVariable variables
+    u = name cons `Map.lookup` markingVariable params
-    w = systemSpec variables `getWeight` name cons
+    w = systemSpec params `getWeight` name cons
-    args' = map (argExpr variables) (args cons)
+    args' = map (argExpr params) (args cons)
 
 argExpr :: Params -> SpecifiableType -> Expr
-argExpr variables (SpecifiableType typ) =
+argExpr params (SpecifiableType typ) =
-  let Let x = typeVariable variables Map.! typeName typ in x
+  let Let x = typeVariable params Map.! typeName typ in x
 
 defaults :: (Num p, FromVariable p) => Maybe Let -> p
 defaults Nothing = 1
 defaults (Just (Let x)) = x
 
 mkDDGs :: Params -> Spec SystemDDGs
-mkDDGs variables = do
+mkDDGs params = do
-  let typeList = Map.toList $ typeVariable variables
+  let typeList = Map.toList $ typeVariable params
   ddgs <-
     mapM
       ( \(n, x) -> do
@@ -145,13 +147,13 @@ paganiniSpecIO = debugPaganini . paganiniSpec
 
 paganiniSpec :: S.SystemSpec -> Spec SystemDDGs
 paganiniSpec sys@(S.SystemSpec {S.targetType = target, S.meanSize = n}) = do
-  let samplableTypes = S.collectTypes sys
+  let specifiableTypes = S.collectTypes sys
 
   Let z <- variable' n
-  varDefs <- mkVariables samplableTypes
+  varDefs <- mkVariables specifiableTypes
   markDefs <- mkMarkingVariables sys
 
-  let variables =
+  let params =
         Params
           { sizeVar = z,
             typeVariable = varDefs,
@@ -159,11 +161,11 @@ paganiniSpec sys@(S.SystemSpec {S.targetType = target, S.meanSize = n}) = do
             systemSpec = sys
           }
 
-  mkTypeVariables variables samplableTypes
+  mkTypeVariables params specifiableTypes
   let (Let t) = varDefs Map.! typeName target
 
   tune t -- tune for target variable.
-  mkDDGs variables
+  mkDDGs params
 
 systemDDGs :: S.SystemSpec -> IO SystemDDGs
 systemDDGs sys = do
@@ -178,7 +180,7 @@ mkChoiceFun sys = do
   matches <- mapM mkChoiceFun' $ Map.toList ddgs
   return $ LamCaseE matches
 
-mkChoiceFun' :: (String, Vector Int) -> Q Match
+mkChoiceFun' :: (String, DDG) -> Q Match
 mkChoiceFun' (s, ddg) = do
   listExpr <- [|ddg|]
   return $ Match (LitP (StringL s)) (NormalB listExpr) []
@@ -199,5 +201,10 @@ mkWeightMatch sys cons = return $ Match (LitP (StringL s)) (NormalB $ LitE (Inte
     s = name cons
     w = sys `S.getWeight` s
 
+-- | Given a system specification:
+--
+--   * tunes the specification using the external `paganini` library, and
+--   * uses so obtained constructor probability distributions to generate,
+--   at compile-time, a dedicated analytic sampler.
 mkSpecSampler :: S.SystemSpec -> Q Exp
 mkSpecSampler sys = [|sample $(mkChoiceFun sys) $(mkWeightFun sys)|]

src/Data/Boltzmann/Sampler.hs

@@ -7,13 +7,15 @@
 
 -- |
 -- Module      : Data.Boltzmann.Sampler
--- Description :
+-- Description : Boltzmann sampler for specifiable types.
 -- Copyright   : (c) Maciej Bendkowski, 2022
 -- License     : BSD3
 -- Maintainer  : maciej.bendkowski@gmail.com
 -- Stability   : experimental
 module Data.Boltzmann.Sampler
   ( RejectionSampler,
+    DDGSelector,
+    WeightSelector,
     BoltzmannSampler (..),
     rejectionSampler,
     rejectionSamplerIO,
@@ -24,14 +26,29 @@ import Control.Monad (guard)
 import Control.Monad.Trans (MonadTrans (lift))
 import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
 import Data.Boltzmann.Specifiable (Specifiable, listTypeName)
-import Data.BuffonMachine (BuffonMachine, choice, runIO)
+import Data.BuffonMachine (BuffonMachine, DDG, choice, runIO)
-import Data.Vector (Vector)
 import System.Random (RandomGen, StdGen)
 
+-- | Samplers which might "reject" generated objects, i.e. return `Nothing` instead.
 type RejectionSampler g a = MaybeT (BuffonMachine g) (a, Int)
 
+-- | Selector functions mapping (fully qualified) constructor names to their `DDG`s.
+type DDGSelector = String -> DDG
+
+-- | Selector functions mapping (fully qualified) constructor names to their weights.
+type WeightSelector = String -> Int
+
+-- | Multiparametric Boltzmann samplers.
 class BoltzmannSampler a where
-  sample :: RandomGen g => (String -> Vector Int) -> (String -> Int) -> Int -> RejectionSampler g a
+  sample ::
+    RandomGen g =>
+    -- | Function mapping constructor names to corresponding `DDG`s.
+    DDGSelector ->
+    -- | Function mapping constructor names to corresponding weights.
+    WeightSelector ->
+    -- | Upper bound for the generated objects' weight.
+    Int ->
+    RejectionSampler g a
 
 instance (Specifiable a, BoltzmannSampler a) => BoltzmannSampler [a] where
   sample ddgs weight ub = do
@@ -46,7 +63,16 @@ instance (Specifiable a, BoltzmannSampler a) => BoltzmannSampler [a] where
                 return (x : xs, w + ws + wcons)
           )
 
-rejectionSampler :: RandomGen g => (Int -> RejectionSampler g a) -> Int -> Int -> BuffonMachine g a
+-- | Rejection sampler generating objects within a prescribed size window.
+rejectionSampler ::
+  RandomGen g =>
+  -- | Function producing rejection samplers given weight upper bounds.
+  (Int -> RejectionSampler g a) ->
+  -- | Lower bound for the generated objects' weight.
+  Int ->
+  -- | Upper bound for the generated objects' weight.
+  Int ->
+  BuffonMachine g a
 rejectionSampler sam lb ub =
   do
     str <- runMaybeT (sam ub)
@@ -57,5 +83,13 @@ rejectionSampler sam lb ub =
           then return x
           else rejectionSampler sam lb ub
 
-rejectionSamplerIO :: (Int -> RejectionSampler StdGen a) -> Int -> Int -> IO a
+-- | `IO` variant of `rejectionsampler`.
+rejectionSamplerIO ::
+  -- | Function producing rejection samplers given weight upper bounds.
+  (Int -> RejectionSampler StdGen a) ->
+  -- | Lower bound for the generated objects' weight.
+  Int ->
+  -- | Upper bound for the generated objects' weight.
+  Int ->
+  IO a
 rejectionSamplerIO sam lb ub = runIO (rejectionSampler sam lb ub)

src/Data/Boltzmann/Sampler/Utils.hs

@@ -5,7 +5,7 @@
 
 -- |
 -- Module      : Data.Boltzmann.Oracle
--- Description :
+-- Description : Template Haskell utilities for sampler generation.
 -- Copyright   : (c) Maciej Bendkowski, 2022
 -- License     : BSD3
 -- Maintainer  : maciej.bendkowski@gmail.com
@@ -24,7 +24,20 @@ import Language.Haskell.TH.Datatype
     constructorName,
     reifyDatatype,
   )
-import Language.Haskell.TH.Syntax (Body (NormalB), Clause (Clause), Dec (FunD, InstanceD), Exp (AppE, ConE, InfixE, LamE, LitE, VarE), Lit (IntegerL, StringL), Match (Match), Name, Pat (LitP, TupP), Q, Stmt (BindS), Type (AppT, ConT), mkName)
+import Language.Haskell.TH.Syntax
+  ( Body (NormalB),
+    Clause (Clause),
+    Dec (FunD, InstanceD),
+    Exp (AppE, ConE, InfixE, LamE, LitE, VarE),
+    Lit (IntegerL, StringL),
+    Match (Match),
+    Name,
+    Pat (LitP, TupP),
+    Q,
+    Stmt (BindS),
+    Type (AppT, ConT),
+    mkName,
+  )
 import Prelude hiding (sum)
 
 application :: Exp -> Exp -> [Exp] -> Exp
@@ -164,6 +177,7 @@ genConstrGroup typ = do
   let consInfo = datatypeCons typInfo
   return $ zip consInfo [0 :: Integer ..]
 
+-- | Given a type name `a`, instantiates it as `BoltzmannSampler` of `a`.
 mkSampler :: Name -> Q [Dec]
 mkSampler typ = do
   samplerBody <- gen typ

src/Data/Boltzmann/Specification.hs

@@ -3,7 +3,7 @@
 
 -- |
 -- Module      : Data.Boltzmann.Specification
--- Description :
+-- Description : System and type specifications for specifiable types.
 -- Copyright   : (c) Maciej Bendkowski, 2022
 -- License     : BSD3
 -- Maintainer  : maciej.bendkowski@gmail.com
@@ -19,6 +19,7 @@ module Data.Boltzmann.Specification
     (==>),
     collectTypes,
     ConsFreq,
+    Value,
     constructorFrequencies,
     getWeight,
     getFrequency,
@@ -38,26 +39,44 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import Language.Haskell.TH.Syntax (Name)
 
+-- | Specifications corresponding to specifiable types.
 data TypeSpec = forall a.
   Specifiable a =>
   TypeSpec
-  { samplableType :: a,
+  { -- | Corresponding specifiable type `a`.
+    specifiableType :: a,
+    -- | Constructors of `a` mapped to their (custom) weight. If no custom
+    --  weight is provided, a default one of 1 is assumed.
     weight :: Map String Integer,
+    -- | Constructors of `a` mapped to their (custom) frequencies. If no custom
+    --  frequency is provided, no frequency is assumed.
     frequency :: Map String Integer
   }
 
 instance Eq TypeSpec where
-  TypeSpec {samplableType = typ} == TypeSpec {samplableType = typ'} =
+  TypeSpec {specifiableType = typ} == TypeSpec {specifiableType = typ'} =
     typeName typ == typeName typ'
 
 instance Ord TypeSpec where
-  TypeSpec {samplableType = typ} <= TypeSpec {samplableType = typ'} =
+  TypeSpec {specifiableType = typ} <= TypeSpec {specifiableType = typ'} =
     typeName typ <= typeName typ'
 
+-- | System specifications corresponding to a set of interdependent, specifiable types.
 data SystemSpec = forall a.
   Specifiable a =>
-  SystemSpec {targetType :: a, meanSize :: Integer, typeSpecs :: Set TypeSpec}
+  SystemSpec
+  { -- | Specifiable which is designated as the "target" tuning type.
+    targetType :: a,
+    -- | Target mean size of the objects corresponding to the tuned system.
+    meanSize :: Integer,
+    -- | Set of interdependent, specifiable types.
+    typeSpecs :: Set TypeSpec
+  }
 
+-- | Finds the weight of a given (fully qualified) constructor name in the
+--  corresponding system specification. If no weight is provided in the system,
+--  or the system does not mention the input type, a default value of 1 is
+--  returned.
 getWeight :: SystemSpec -> String -> Integer
 getWeight sys name =
   if Set.size res == 0
@@ -69,6 +88,10 @@ getWeight sys name =
 getWeight' :: String -> TypeSpec -> Maybe Integer
 getWeight' name spec = name `Map.lookup` weight spec
 
+-- | Finds the frequency of a given (fully qualified) constructor name in the
+--  corresponding system specification. If no frequency is provided in the
+--  system, or the system does not mention the input type, `Nothing` is
+--  returned.
 getFrequency :: SystemSpec -> String -> Maybe Integer
 getFrequency sys name =
   if Set.size res == 0
@@ -80,10 +103,13 @@ getFrequency sys name =
 getFrequency' :: String -> TypeSpec -> Maybe Integer
 getFrequency' name spec = name `Map.lookup` frequency spec
 
+-- | Default type specification corresponding to the given specifiable type.
+--  The specification has no constructor frequencies (no multiparametric
+--  tuning). List constructors have weight 0, all others have weight 1.
 defaultTypeSpec :: Specifiable a => a -> TypeSpec
 defaultTypeSpec typ =
   TypeSpec
-    { samplableType = typ,
+    { specifiableType = typ,
       weight =
         Map.fromList
           [ (show '[], 0),
@@ -92,28 +118,40 @@ defaultTypeSpec typ =
       frequency = Map.empty
     }
 
+-- | Constructor names with associated numeric values (for either weights or frequencies).
 type Value = (Name, Integer)
 
+-- | Convenience notation for `Value`.
 (==>) :: Name -> Integer -> Value
 consName ==> w = (consName, w)
 
 infix 6 ==>
 
+-- | Assigns weight values to the given type specification.
 withWeights :: [Value] -> TypeSpec -> TypeSpec
 withWeights values spec = spec {weight = weight spec `Map.union` valMap}
   where
     valMap = Map.fromList $ map (first show) values
 
+-- | Assigns frequency values to the given type specification.
 withFrequencies :: [Value] -> TypeSpec -> TypeSpec
 withFrequencies values spec =
   spec {frequency = frequency spec `Map.union` valMap}
   where
     valMap = Map.fromList $ map (first show) values
 
+-- | Convenience function constructing type specifications building on top of `defaultTypeSpec`.
 specification :: Specifiable a => a -> (TypeSpec -> TypeSpec) -> TypeSpec
 specification typ f = f (defaultTypeSpec typ)
 
-withSystem :: Specifiable a => (a, Integer) -> [TypeSpec] -> SystemSpec
+-- | Constructs a system specification.
+withSystem ::
+  Specifiable a =>
+  -- | Target specifiable type.
+  (a, Integer) ->
+  -- | Corresponding type specifications.
+  [TypeSpec] ->
+  SystemSpec
 withSystem (typ, size) specs =
   SystemSpec
     { targetType = typ,
@@ -125,8 +163,9 @@ toSpecifiableTypes :: SystemSpec -> Set SpecifiableType
 toSpecifiableTypes = Set.map toSpecifiableType . typeSpecs
 
 toSpecifiableType :: TypeSpec -> SpecifiableType
-toSpecifiableType (TypeSpec {samplableType = t}) = SpecifiableType t
+toSpecifiableType (TypeSpec {specifiableType = t}) = SpecifiableType t
 
+-- | Set of specifiable types involved in the given system specification.
 collectTypes :: SystemSpec -> Set SpecifiableType
 collectTypes sys =
   foldl collectTypesFromSpecifiableType Set.empty (toSpecifiableTypes sys)
@@ -143,8 +182,10 @@ collectTypesFromCons :: Set SpecifiableType -> Cons -> Set SpecifiableType
 collectTypesFromCons types cons =
   foldl collectTypesFromSpecifiableType types (args cons)
 
+-- | (Fully qualified) constructor names mapped to their frequencies.
 type ConsFreq = Map String Integer
 
+-- | Finds all constructor frequencies for the given system specification.
 constructorFrequencies :: SystemSpec -> ConsFreq
 constructorFrequencies sys = Map.unions consFreqs
   where

test/Test/Unit/Specification.hs

@@ -124,14 +124,14 @@ typeSpecTests =
   where
     a =
       Specification.TypeSpec
-        { Specification.samplableType = undefined :: Lambda,
+        { Specification.specifiableType = undefined :: Lambda,
           Specification.weight = Map.empty,
           Specification.frequency = Map.empty
         }
 
     b =
       Specification.TypeSpec
-        { Specification.samplableType = undefined :: BinTree,
+        { Specification.specifiableType = undefined :: BinTree,
           Specification.weight = Map.empty,
           Specification.frequency = Map.empty
         }