mirror of
https://github.com/maciej-bendkowski/generic-boltzmann-brain.git
synced 2024-08-17 00:20:40 +03:00
Enable fourmolu code formatter
This commit is contained in:
parent
04bfff59c9
commit
2924341479
@ -7,16 +7,16 @@ module BinTree where
|
|||||||
import Control.DeepSeq (NFData)
|
import Control.DeepSeq (NFData)
|
||||||
import Data.Boltzmann.Sampler (BoltzmannSampler (..))
|
import Data.Boltzmann.Sampler (BoltzmannSampler (..))
|
||||||
import Data.Boltzmann.Sampler.Utils (mkSampler)
|
import Data.Boltzmann.Sampler.Utils (mkSampler)
|
||||||
import Data.Boltzmann.Specifiable
|
import Data.Boltzmann.Specifiable (
|
||||||
( Specifiable,
|
Specifiable,
|
||||||
)
|
)
|
||||||
import Data.Boltzmann.Specification
|
import Data.Boltzmann.Specification (
|
||||||
( SystemSpec,
|
SystemSpec,
|
||||||
specification,
|
specification,
|
||||||
withSystem,
|
withSystem,
|
||||||
withWeights,
|
withWeights,
|
||||||
(==>),
|
(==>),
|
||||||
)
|
)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
|
|
||||||
data BinTree
|
data BinTree
|
||||||
@ -28,10 +28,10 @@ binTreeSysSpec :: SystemSpec
|
|||||||
binTreeSysSpec =
|
binTreeSysSpec =
|
||||||
(undefined :: BinTree, 4000)
|
(undefined :: BinTree, 4000)
|
||||||
`withSystem` [ specification
|
`withSystem` [ specification
|
||||||
(undefined :: BinTree)
|
(undefined :: BinTree)
|
||||||
( withWeights
|
( withWeights
|
||||||
['Leaf ==> 0]
|
['Leaf ==> 0]
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
|
||||||
$(mkSampler ''BinTree)
|
$(mkSampler ''BinTree)
|
||||||
|
8
fourmolu.yaml
Normal file
8
fourmolu.yaml
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
indentation: 2
|
||||||
|
comma-style: leading
|
||||||
|
record-brace-space: true
|
||||||
|
indent-wheres: true
|
||||||
|
diff-friendly-import-export: true
|
||||||
|
respectful: true
|
||||||
|
haddock-style: single-line
|
||||||
|
newlines-between-decls: 1
|
@ -8,59 +8,56 @@
|
|||||||
-- License : BSD3
|
-- License : BSD3
|
||||||
-- Maintainer : maciej.bendkowski@gmail.com
|
-- Maintainer : maciej.bendkowski@gmail.com
|
||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
--
|
module Data.Boltzmann.Oracle (
|
||||||
--
|
mkSpecSampler,
|
||||||
module Data.Boltzmann.Oracle
|
) where
|
||||||
( mkSpecSampler,
|
|
||||||
)
|
|
||||||
where
|
|
||||||
|
|
||||||
import Control.Monad (replicateM)
|
import Control.Monad (replicateM)
|
||||||
import Data.Boltzmann.Sampler (BoltzmannSampler (sample))
|
import Data.Boltzmann.Sampler (BoltzmannSampler (sample))
|
||||||
import Data.Boltzmann.Specifiable
|
import Data.Boltzmann.Specifiable (
|
||||||
( Cons (args, name),
|
Cons (args, name),
|
||||||
Specifiable (..),
|
Specifiable (..),
|
||||||
SpecifiableType (..),
|
SpecifiableType (..),
|
||||||
TypeDef,
|
TypeDef,
|
||||||
)
|
)
|
||||||
import Data.Boltzmann.Specification (getWeight)
|
import Data.Boltzmann.Specification (getWeight)
|
||||||
import qualified Data.Boltzmann.Specification as S
|
import qualified Data.Boltzmann.Specification as S
|
||||||
import Data.BuffonMachine (DDG)
|
import Data.BuffonMachine (DDG)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Map.Strict (Map)
|
import Data.Map.Strict (Map)
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Data.Paganini
|
import Data.Paganini (
|
||||||
( Expr,
|
Expr,
|
||||||
FromVariable,
|
FromVariable,
|
||||||
Let (Let),
|
Let (Let),
|
||||||
PaganiniError,
|
PaganiniError,
|
||||||
Spec,
|
Spec,
|
||||||
ddg,
|
ddg,
|
||||||
debugPaganini,
|
debugPaganini,
|
||||||
tune,
|
tune,
|
||||||
variable,
|
variable,
|
||||||
variable',
|
variable',
|
||||||
(.=.),
|
(.=.),
|
||||||
)
|
)
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Vector
|
import Data.Vector (
|
||||||
( fromList,
|
fromList,
|
||||||
)
|
)
|
||||||
import Instances.TH.Lift ()
|
import Instances.TH.Lift ()
|
||||||
import Language.Haskell.TH
|
import Language.Haskell.TH (
|
||||||
( Exp (LamCaseE),
|
Exp (LamCaseE),
|
||||||
Lit (IntegerL),
|
Lit (IntegerL),
|
||||||
runIO,
|
runIO,
|
||||||
)
|
)
|
||||||
import Language.Haskell.TH.Syntax
|
import Language.Haskell.TH.Syntax (
|
||||||
( Body (NormalB),
|
Body (NormalB),
|
||||||
Exp (LitE),
|
Exp (LitE),
|
||||||
Lit (StringL),
|
Lit (StringL),
|
||||||
Match (Match),
|
Match (Match),
|
||||||
Pat (LitP),
|
Pat (LitP),
|
||||||
Q,
|
Q,
|
||||||
)
|
)
|
||||||
|
|
||||||
-- nicer sum for non-empty lists.
|
-- nicer sum for non-empty lists.
|
||||||
sum' :: Num a => [a] -> a
|
sum' :: Num a => [a] -> a
|
||||||
@ -95,10 +92,10 @@ mkMarkingVariables sys = do
|
|||||||
return $ Map.fromList xs
|
return $ Map.fromList xs
|
||||||
|
|
||||||
data Params = Params
|
data Params = Params
|
||||||
{ sizeVar :: forall a. FromVariable a => a,
|
{ sizeVar :: forall a. FromVariable a => a
|
||||||
typeVariable :: Map String Let,
|
, typeVariable :: Map String Let
|
||||||
markingVariable :: Map String Let,
|
, markingVariable :: Map String Let
|
||||||
systemSpec :: S.SystemSpec
|
, systemSpec :: S.SystemSpec
|
||||||
}
|
}
|
||||||
|
|
||||||
mkTypeVariables :: Params -> Set SpecifiableType -> Spec ()
|
mkTypeVariables :: Params -> Set SpecifiableType -> Spec ()
|
||||||
@ -155,10 +152,10 @@ paganiniSpec sys@(S.SystemSpec {S.targetType = target, S.meanSize = n}) = do
|
|||||||
|
|
||||||
let params =
|
let params =
|
||||||
Params
|
Params
|
||||||
{ sizeVar = z,
|
{ sizeVar = z
|
||||||
typeVariable = varDefs,
|
, typeVariable = varDefs
|
||||||
markingVariable = markDefs,
|
, markingVariable = markDefs
|
||||||
systemSpec = sys
|
, systemSpec = sys
|
||||||
}
|
}
|
||||||
|
|
||||||
mkTypeVariables params specifiableTypes
|
mkTypeVariables params specifiableTypes
|
||||||
|
@ -12,15 +12,14 @@
|
|||||||
-- License : BSD3
|
-- License : BSD3
|
||||||
-- Maintainer : maciej.bendkowski@gmail.com
|
-- Maintainer : maciej.bendkowski@gmail.com
|
||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
module Data.Boltzmann.Sampler
|
module Data.Boltzmann.Sampler (
|
||||||
( RejectionSampler,
|
RejectionSampler,
|
||||||
DDGSelector,
|
DDGSelector,
|
||||||
WeightSelector,
|
WeightSelector,
|
||||||
BoltzmannSampler (..),
|
BoltzmannSampler (..),
|
||||||
rejectionSampler,
|
rejectionSampler,
|
||||||
rejectionSamplerIO,
|
rejectionSamplerIO,
|
||||||
)
|
) where
|
||||||
where
|
|
||||||
|
|
||||||
import Control.Monad (guard)
|
import Control.Monad (guard)
|
||||||
import Control.Monad.Trans (MonadTrans (lift))
|
import Control.Monad.Trans (MonadTrans (lift))
|
||||||
|
@ -17,27 +17,27 @@ import qualified Control.Monad.Trans as T
|
|||||||
import Data.Boltzmann.Sampler (sample)
|
import Data.Boltzmann.Sampler (sample)
|
||||||
import Data.BuffonMachine (choice)
|
import Data.BuffonMachine (choice)
|
||||||
import Language.Haskell.TH (Exp (DoE, LamCaseE, TupE), Pat (VarP), Stmt (NoBindS), newName)
|
import Language.Haskell.TH (Exp (DoE, LamCaseE, TupE), Pat (VarP), Stmt (NoBindS), newName)
|
||||||
import Language.Haskell.TH.Datatype
|
import Language.Haskell.TH.Datatype (
|
||||||
( ConstructorInfo (constructorName),
|
ConstructorInfo (constructorName),
|
||||||
DatatypeInfo (..),
|
DatatypeInfo (..),
|
||||||
constructorFields,
|
constructorFields,
|
||||||
constructorName,
|
constructorName,
|
||||||
reifyDatatype,
|
reifyDatatype,
|
||||||
)
|
)
|
||||||
import Language.Haskell.TH.Syntax
|
import Language.Haskell.TH.Syntax (
|
||||||
( Body (NormalB),
|
Body (NormalB),
|
||||||
Clause (Clause),
|
Clause (Clause),
|
||||||
Dec (FunD, InstanceD),
|
Dec (FunD, InstanceD),
|
||||||
Exp (AppE, ConE, InfixE, LamE, LitE, VarE),
|
Exp (AppE, ConE, InfixE, LamE, LitE, VarE),
|
||||||
Lit (IntegerL, StringL),
|
Lit (IntegerL, StringL),
|
||||||
Match (Match),
|
Match (Match),
|
||||||
Name,
|
Name,
|
||||||
Pat (LitP, TupP),
|
Pat (LitP, TupP),
|
||||||
Q,
|
Q,
|
||||||
Stmt (BindS),
|
Stmt (BindS),
|
||||||
Type (AppT, ConT),
|
Type (AppT, ConT),
|
||||||
mkName,
|
mkName,
|
||||||
)
|
)
|
||||||
import Prelude hiding (sum)
|
import Prelude hiding (sum)
|
||||||
|
|
||||||
application :: Exp -> Exp -> [Exp] -> Exp
|
application :: Exp -> Exp -> [Exp] -> Exp
|
||||||
@ -108,9 +108,9 @@ genConstrApplication s args' = do
|
|||||||
return $ foldl AppE con args'
|
return $ foldl AppE con args'
|
||||||
|
|
||||||
data ArgStmtExpr = ArgStmtExpr
|
data ArgStmtExpr = ArgStmtExpr
|
||||||
{ stmts :: [Stmt],
|
{ stmts :: [Stmt]
|
||||||
objs :: [Exp],
|
, objs :: [Exp]
|
||||||
weights :: [Exp]
|
, weights :: [Exp]
|
||||||
}
|
}
|
||||||
|
|
||||||
genArgExprs :: ConstructorInfo -> Q ArgStmtExpr
|
genArgExprs :: ConstructorInfo -> Q ArgStmtExpr
|
||||||
@ -130,9 +130,9 @@ genArgExprs' ubExpr (_ : as) = do
|
|||||||
let stmt = BindS (TupP [xp, wp]) (AppE (AppE (AppE argExpr (VarE $ mkName "ddgs")) (VarE $ mkName "weight")) ubExpr)
|
let stmt = BindS (TupP [xp, wp]) (AppE (AppE (AppE argExpr (VarE $ mkName "ddgs")) (VarE $ mkName "weight")) ubExpr)
|
||||||
return
|
return
|
||||||
ArgStmtExpr
|
ArgStmtExpr
|
||||||
{ stmts = stmt : stmts argStmtExpr,
|
{ stmts = stmt : stmts argStmtExpr
|
||||||
objs = x : objs argStmtExpr,
|
, objs = x : objs argStmtExpr
|
||||||
weights = w : weights argStmtExpr
|
, weights = w : weights argStmtExpr
|
||||||
}
|
}
|
||||||
|
|
||||||
genChoiceExpr :: Name -> Q Exp
|
genChoiceExpr :: Name -> Q Exp
|
||||||
@ -167,8 +167,8 @@ gen typ = do
|
|||||||
[pat "ddgs", pat "weight", pat "ub"]
|
[pat "ddgs", pat "weight", pat "ub"]
|
||||||
$ DoE
|
$ DoE
|
||||||
Nothing
|
Nothing
|
||||||
[ NoBindS guardExpr,
|
[ NoBindS guardExpr
|
||||||
NoBindS $ InfixE (Just choiceExpr) bindOp (Just caseExpr)
|
, NoBindS $ InfixE (Just choiceExpr) bindOp (Just caseExpr)
|
||||||
]
|
]
|
||||||
|
|
||||||
genConstrGroup :: Name -> Q [(ConstructorInfo, Integer)]
|
genConstrGroup :: Name -> Q [(ConstructorInfo, Integer)]
|
||||||
|
@ -17,28 +17,27 @@
|
|||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
--
|
--
|
||||||
-- Specifiable types, i.e. types which have corresponding (multiparametric) samplers.
|
-- Specifiable types, i.e. types which have corresponding (multiparametric) samplers.
|
||||||
module Data.Boltzmann.Specifiable
|
module Data.Boltzmann.Specifiable (
|
||||||
( SpecifiableType (..),
|
SpecifiableType (..),
|
||||||
TypeDef,
|
TypeDef,
|
||||||
Cons (..),
|
Cons (..),
|
||||||
Specifiable (..),
|
Specifiable (..),
|
||||||
listTypeName,
|
listTypeName,
|
||||||
)
|
) where
|
||||||
where
|
|
||||||
|
|
||||||
import GHC.Generics
|
import GHC.Generics (
|
||||||
( C1,
|
C1,
|
||||||
Constructor (conName),
|
Constructor (conName),
|
||||||
D1,
|
D1,
|
||||||
Datatype (datatypeName, moduleName),
|
Datatype (datatypeName, moduleName),
|
||||||
Generic (Rep, from),
|
Generic (Rep, from),
|
||||||
K1,
|
K1,
|
||||||
R,
|
R,
|
||||||
S1,
|
S1,
|
||||||
U1,
|
U1,
|
||||||
type (:*:),
|
type (:*:),
|
||||||
type (:+:),
|
type (:+:),
|
||||||
)
|
)
|
||||||
import Language.Haskell.TH.Syntax (Lift)
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
|
|
||||||
-- | Specifiable, algebraic type definition given
|
-- | Specifiable, algebraic type definition given
|
||||||
@ -48,8 +47,8 @@ type TypeDef = [Cons]
|
|||||||
-- | Type constructors.
|
-- | Type constructors.
|
||||||
data Cons = Cons
|
data Cons = Cons
|
||||||
{ -- | Fully-qualified constructor name.
|
{ -- | Fully-qualified constructor name.
|
||||||
name :: String,
|
name :: String
|
||||||
-- | List of (specifiable) arguments.
|
, -- | List of (specifiable) arguments.
|
||||||
args :: [SpecifiableType]
|
args :: [SpecifiableType]
|
||||||
}
|
}
|
||||||
deriving (Eq, Show, Lift)
|
deriving (Eq, Show, Lift)
|
||||||
|
@ -8,30 +8,29 @@
|
|||||||
-- License : BSD3
|
-- License : BSD3
|
||||||
-- Maintainer : maciej.bendkowski@gmail.com
|
-- Maintainer : maciej.bendkowski@gmail.com
|
||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
module Data.Boltzmann.Specification
|
module Data.Boltzmann.Specification (
|
||||||
( TypeSpec (..),
|
TypeSpec (..),
|
||||||
SystemSpec (..),
|
SystemSpec (..),
|
||||||
defaultTypeSpec,
|
defaultTypeSpec,
|
||||||
withWeights,
|
withWeights,
|
||||||
withFrequencies,
|
withFrequencies,
|
||||||
specification,
|
specification,
|
||||||
withSystem,
|
withSystem,
|
||||||
(==>),
|
(==>),
|
||||||
collectTypes,
|
collectTypes,
|
||||||
ConsFreq,
|
ConsFreq,
|
||||||
Value,
|
Value,
|
||||||
constructorFrequencies,
|
constructorFrequencies,
|
||||||
getWeight,
|
getWeight,
|
||||||
getFrequency,
|
getFrequency,
|
||||||
)
|
) where
|
||||||
where
|
|
||||||
|
|
||||||
import Data.Bifunctor (Bifunctor (first))
|
import Data.Bifunctor (Bifunctor (first))
|
||||||
import Data.Boltzmann.Specifiable
|
import Data.Boltzmann.Specifiable (
|
||||||
( Cons (args),
|
Cons (args),
|
||||||
Specifiable (..),
|
Specifiable (..),
|
||||||
SpecifiableType (..),
|
SpecifiableType (..),
|
||||||
)
|
)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Map.Strict (Map)
|
import Data.Map.Strict (Map)
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
@ -44,11 +43,11 @@ data TypeSpec = forall a.
|
|||||||
Specifiable a =>
|
Specifiable a =>
|
||||||
TypeSpec
|
TypeSpec
|
||||||
{ -- | Corresponding specifiable type `a`.
|
{ -- | Corresponding specifiable type `a`.
|
||||||
specifiableType :: a,
|
specifiableType :: a
|
||||||
-- | Constructors of `a` mapped to their (custom) weight. If no custom
|
, -- | Constructors of `a` mapped to their (custom) weight. If no custom
|
||||||
-- weight is provided, a default one of 1 is assumed.
|
-- weight is provided, a default one of 1 is assumed.
|
||||||
weight :: Map String Integer,
|
weight :: Map String Integer
|
||||||
-- | Constructors of `a` mapped to their (custom) frequencies. If no custom
|
, -- | Constructors of `a` mapped to their (custom) frequencies. If no custom
|
||||||
-- frequency is provided, no frequency is assumed.
|
-- frequency is provided, no frequency is assumed.
|
||||||
frequency :: Map String Integer
|
frequency :: Map String Integer
|
||||||
}
|
}
|
||||||
@ -66,10 +65,10 @@ data SystemSpec = forall a.
|
|||||||
Specifiable a =>
|
Specifiable a =>
|
||||||
SystemSpec
|
SystemSpec
|
||||||
{ -- | Specifiable which is designated as the "target" tuning type.
|
{ -- | Specifiable which is designated as the "target" tuning type.
|
||||||
targetType :: a,
|
targetType :: a
|
||||||
-- | Target mean size of the objects corresponding to the tuned system.
|
, -- | Target mean size of the objects corresponding to the tuned system.
|
||||||
meanSize :: Integer,
|
meanSize :: Integer
|
||||||
-- | Set of interdependent, specifiable types.
|
, -- | Set of interdependent, specifiable types.
|
||||||
typeSpecs :: Set TypeSpec
|
typeSpecs :: Set TypeSpec
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -109,13 +108,13 @@ getFrequency' name spec = name `Map.lookup` frequency spec
|
|||||||
defaultTypeSpec :: Specifiable a => a -> TypeSpec
|
defaultTypeSpec :: Specifiable a => a -> TypeSpec
|
||||||
defaultTypeSpec typ =
|
defaultTypeSpec typ =
|
||||||
TypeSpec
|
TypeSpec
|
||||||
{ specifiableType = typ,
|
{ specifiableType = typ
|
||||||
weight =
|
, weight =
|
||||||
Map.fromList
|
Map.fromList
|
||||||
[ (show '[], 0),
|
[ (show '[], 0)
|
||||||
(show '(:), 0)
|
, (show '(:), 0)
|
||||||
],
|
]
|
||||||
frequency = Map.empty
|
, frequency = Map.empty
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Constructor names with associated numeric values (for either weights or frequencies).
|
-- | Constructor names with associated numeric values (for either weights or frequencies).
|
||||||
@ -154,9 +153,9 @@ withSystem ::
|
|||||||
SystemSpec
|
SystemSpec
|
||||||
withSystem (typ, size) specs =
|
withSystem (typ, size) specs =
|
||||||
SystemSpec
|
SystemSpec
|
||||||
{ targetType = typ,
|
{ targetType = typ
|
||||||
meanSize = size,
|
, meanSize = size
|
||||||
typeSpecs = Set.fromList specs
|
, typeSpecs = Set.fromList specs
|
||||||
}
|
}
|
||||||
|
|
||||||
toSpecifiableTypes :: SystemSpec -> Set SpecifiableType
|
toSpecifiableTypes :: SystemSpec -> Set SpecifiableType
|
||||||
|
@ -15,24 +15,23 @@
|
|||||||
-- * J. Lumbroso : "Optimal Discrete Uniform Generation from Coin Flips, and Applications".
|
-- * J. Lumbroso : "Optimal Discrete Uniform Generation from Coin Flips, and Applications".
|
||||||
-- * F. A. Saad, C. E. Freer, M. C. Rinard, V.K. Mansinghka "Optimal Approximate
|
-- * F. A. Saad, C. E. Freer, M. C. Rinard, V.K. Mansinghka "Optimal Approximate
|
||||||
-- Sampling from Discrete Probability Distributions", POPL'20 (2020).
|
-- Sampling from Discrete Probability Distributions", POPL'20 (2020).
|
||||||
module Data.BuffonMachine
|
module Data.BuffonMachine (
|
||||||
( BuffonMachine,
|
BuffonMachine,
|
||||||
Discrete,
|
Discrete,
|
||||||
Oracle (..),
|
Oracle (..),
|
||||||
DDG,
|
DDG,
|
||||||
choice,
|
choice,
|
||||||
run,
|
run,
|
||||||
runIO,
|
runIO,
|
||||||
)
|
) where
|
||||||
where
|
|
||||||
|
|
||||||
import Control.Monad.Trans.State.Strict
|
import Control.Monad.Trans.State.Strict (
|
||||||
( State,
|
State,
|
||||||
evalState,
|
evalState,
|
||||||
get,
|
get,
|
||||||
modify',
|
modify',
|
||||||
put,
|
put,
|
||||||
)
|
)
|
||||||
import Data.Bits (Bits (testBit))
|
import Data.Bits (Bits (testBit))
|
||||||
import Data.Vector (Vector, null, (!))
|
import Data.Vector (Vector, null, (!))
|
||||||
import Data.Word (Word32)
|
import Data.Word (Word32)
|
||||||
@ -42,10 +41,10 @@ import Prelude hiding (null)
|
|||||||
-- | Buffered random bit oracle.
|
-- | Buffered random bit oracle.
|
||||||
data Oracle g = Oracle
|
data Oracle g = Oracle
|
||||||
{ -- | 32-bit buffer of random bits.
|
{ -- | 32-bit buffer of random bits.
|
||||||
buffer :: !Word32,
|
buffer :: !Word32
|
||||||
-- | Number of bits consumed from the current buffer.
|
, -- | Number of bits consumed from the current buffer.
|
||||||
usedBits :: !Int,
|
usedBits :: !Int
|
||||||
-- | Random number generator used to obtain random bits.
|
, -- | Random number generator used to obtain random bits.
|
||||||
rng :: g
|
rng :: g
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -6,19 +6,19 @@ module Data.Types.BinTree where
|
|||||||
|
|
||||||
import Data.Boltzmann.Sampler (BoltzmannSampler (..))
|
import Data.Boltzmann.Sampler (BoltzmannSampler (..))
|
||||||
import Data.Boltzmann.Sampler.Utils (mkSampler)
|
import Data.Boltzmann.Sampler.Utils (mkSampler)
|
||||||
import Data.Boltzmann.Specifiable
|
import Data.Boltzmann.Specifiable (
|
||||||
( Cons (..),
|
Cons (..),
|
||||||
Specifiable,
|
Specifiable,
|
||||||
SpecifiableType (..),
|
SpecifiableType (..),
|
||||||
TypeDef,
|
TypeDef,
|
||||||
)
|
)
|
||||||
import Data.Boltzmann.Specification
|
import Data.Boltzmann.Specification (
|
||||||
( SystemSpec,
|
SystemSpec,
|
||||||
specification,
|
specification,
|
||||||
withSystem,
|
withSystem,
|
||||||
withWeights,
|
withWeights,
|
||||||
(==>),
|
(==>),
|
||||||
)
|
)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Test.Unit.Utils (Size (..))
|
import Test.Unit.Utils (Size (..))
|
||||||
|
|
||||||
@ -36,18 +36,18 @@ binTree = SpecifiableType (undefined :: BinTree)
|
|||||||
|
|
||||||
expectedTypeDef :: TypeDef
|
expectedTypeDef :: TypeDef
|
||||||
expectedTypeDef =
|
expectedTypeDef =
|
||||||
[ Cons {name = "Data.Types.BinTree.Leaf", args = []},
|
[ Cons {name = "Data.Types.BinTree.Leaf", args = []}
|
||||||
Cons {name = "Data.Types.BinTree.Node", args = [binTree, binTree]}
|
, Cons {name = "Data.Types.BinTree.Node", args = [binTree, binTree]}
|
||||||
]
|
]
|
||||||
|
|
||||||
binTreeSysSpec :: SystemSpec
|
binTreeSysSpec :: SystemSpec
|
||||||
binTreeSysSpec =
|
binTreeSysSpec =
|
||||||
(undefined :: BinTree, 4000)
|
(undefined :: BinTree, 4000)
|
||||||
`withSystem` [ specification
|
`withSystem` [ specification
|
||||||
(undefined :: BinTree)
|
(undefined :: BinTree)
|
||||||
( withWeights
|
( withWeights
|
||||||
['Leaf ==> 0]
|
['Leaf ==> 0]
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
|
||||||
$(mkSampler ''BinTree)
|
$(mkSampler ''BinTree)
|
||||||
|
@ -4,18 +4,18 @@
|
|||||||
|
|
||||||
module Data.Types.Custom where
|
module Data.Types.Custom where
|
||||||
|
|
||||||
import Data.Boltzmann.Specifiable
|
import Data.Boltzmann.Specifiable (
|
||||||
( Specifiable,
|
Specifiable,
|
||||||
SpecifiableType (..),
|
SpecifiableType (..),
|
||||||
)
|
)
|
||||||
import Data.Boltzmann.Specification
|
import Data.Boltzmann.Specification (
|
||||||
( SystemSpec,
|
SystemSpec,
|
||||||
specification,
|
specification,
|
||||||
withFrequencies,
|
withFrequencies,
|
||||||
withSystem,
|
withSystem,
|
||||||
withWeights,
|
withWeights,
|
||||||
(==>),
|
(==>),
|
||||||
)
|
)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Test.Unit.Utils (Size (..))
|
import Test.Unit.Utils (Size (..))
|
||||||
|
|
||||||
@ -48,15 +48,15 @@ customSysSpec :: SystemSpec
|
|||||||
customSysSpec =
|
customSysSpec =
|
||||||
(undefined :: Custom, 10000)
|
(undefined :: Custom, 10000)
|
||||||
`withSystem` [ specification
|
`withSystem` [ specification
|
||||||
(undefined :: Custom)
|
(undefined :: Custom)
|
||||||
( withWeights
|
( withWeights
|
||||||
[ 'ConsA ==> 2,
|
[ 'ConsA ==> 2
|
||||||
'ConsB ==> 3,
|
, 'ConsB ==> 3
|
||||||
'ConsC ==> 4
|
, 'ConsC ==> 4
|
||||||
]
|
]
|
||||||
. withFrequencies
|
. withFrequencies
|
||||||
[ 'ConsA ==> 800,
|
[ 'ConsA ==> 800
|
||||||
'ConsB ==> 900
|
, 'ConsB ==> 900
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
@ -7,20 +7,20 @@ module Data.Types.Lambda where
|
|||||||
|
|
||||||
import Data.Boltzmann.Sampler (BoltzmannSampler (..))
|
import Data.Boltzmann.Sampler (BoltzmannSampler (..))
|
||||||
import Data.Boltzmann.Sampler.Utils (mkSampler)
|
import Data.Boltzmann.Sampler.Utils (mkSampler)
|
||||||
import Data.Boltzmann.Specifiable
|
import Data.Boltzmann.Specifiable (
|
||||||
( Cons (..),
|
Cons (..),
|
||||||
Specifiable,
|
Specifiable,
|
||||||
SpecifiableType (..),
|
SpecifiableType (..),
|
||||||
TypeDef,
|
TypeDef,
|
||||||
)
|
)
|
||||||
import Data.Boltzmann.Specification
|
import Data.Boltzmann.Specification (
|
||||||
( SystemSpec,
|
SystemSpec,
|
||||||
specification,
|
specification,
|
||||||
withFrequencies,
|
withFrequencies,
|
||||||
withSystem,
|
withSystem,
|
||||||
withWeights,
|
withWeights,
|
||||||
(==>),
|
(==>),
|
||||||
)
|
)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Test.Unit.Utils (Size (..))
|
import Test.Unit.Utils (Size (..))
|
||||||
|
|
||||||
@ -50,37 +50,37 @@ lambda = SpecifiableType (undefined :: Lambda)
|
|||||||
|
|
||||||
expectedDeBruijnTypeDef :: TypeDef
|
expectedDeBruijnTypeDef :: TypeDef
|
||||||
expectedDeBruijnTypeDef =
|
expectedDeBruijnTypeDef =
|
||||||
[ Cons {name = "Data.Types.Lambda.S", args = [deBruijn]},
|
[ Cons {name = "Data.Types.Lambda.S", args = [deBruijn]}
|
||||||
Cons {name = "Data.Types.Lambda.Z", args = []}
|
, Cons {name = "Data.Types.Lambda.Z", args = []}
|
||||||
]
|
]
|
||||||
|
|
||||||
expectedLambdaTypeDef :: TypeDef
|
expectedLambdaTypeDef :: TypeDef
|
||||||
expectedLambdaTypeDef =
|
expectedLambdaTypeDef =
|
||||||
[ Cons {name = "Data.Types.Lambda.Abs", args = [lambda]},
|
[ Cons {name = "Data.Types.Lambda.Abs", args = [lambda]}
|
||||||
Cons {name = "Data.Types.Lambda.App", args = [lambda, lambda]},
|
, Cons {name = "Data.Types.Lambda.App", args = [lambda, lambda]}
|
||||||
Cons {name = "Data.Types.Lambda.Index", args = [deBruijn]}
|
, Cons {name = "Data.Types.Lambda.Index", args = [deBruijn]}
|
||||||
]
|
]
|
||||||
|
|
||||||
lambdaSysSpec :: SystemSpec
|
lambdaSysSpec :: SystemSpec
|
||||||
lambdaSysSpec =
|
lambdaSysSpec =
|
||||||
(undefined :: Lambda, 1000)
|
(undefined :: Lambda, 1000)
|
||||||
`withSystem` [ specification
|
`withSystem` [ specification
|
||||||
(undefined :: Lambda)
|
(undefined :: Lambda)
|
||||||
( withWeights
|
( withWeights
|
||||||
['Index ==> 0]
|
['Index ==> 0]
|
||||||
. withFrequencies
|
. withFrequencies
|
||||||
['Abs ==> 330]
|
['Abs ==> 330]
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
|
||||||
lambdaListSysSpec :: SystemSpec
|
lambdaListSysSpec :: SystemSpec
|
||||||
lambdaListSysSpec =
|
lambdaListSysSpec =
|
||||||
(undefined :: [Lambda], 1000)
|
(undefined :: [Lambda], 1000)
|
||||||
`withSystem` [ specification
|
`withSystem` [ specification
|
||||||
(undefined :: [Lambda])
|
(undefined :: [Lambda])
|
||||||
( withWeights
|
( withWeights
|
||||||
['Index ==> 0]
|
['Index ==> 0]
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
|
|
||||||
$(mkSampler ''DeBruijn)
|
$(mkSampler ''DeBruijn)
|
||||||
|
@ -6,17 +6,17 @@ module Data.Types.Tree where
|
|||||||
|
|
||||||
import Data.Boltzmann.Sampler (BoltzmannSampler (..))
|
import Data.Boltzmann.Sampler (BoltzmannSampler (..))
|
||||||
import Data.Boltzmann.Sampler.Utils (mkSampler)
|
import Data.Boltzmann.Sampler.Utils (mkSampler)
|
||||||
import Data.Boltzmann.Specifiable
|
import Data.Boltzmann.Specifiable (
|
||||||
( Cons (..),
|
Cons (..),
|
||||||
Specifiable,
|
Specifiable,
|
||||||
SpecifiableType (..),
|
SpecifiableType (..),
|
||||||
TypeDef,
|
TypeDef,
|
||||||
)
|
)
|
||||||
import Data.Boltzmann.Specification
|
import Data.Boltzmann.Specification (
|
||||||
( SystemSpec,
|
SystemSpec,
|
||||||
defaultTypeSpec,
|
defaultTypeSpec,
|
||||||
withSystem,
|
withSystem,
|
||||||
)
|
)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Test.Unit.Utils (Size (..))
|
import Test.Unit.Utils (Size (..))
|
||||||
|
|
||||||
|
@ -12,8 +12,8 @@ tests = testGroup "Unit tests" unitTests
|
|||||||
|
|
||||||
unitTests :: [TestTree]
|
unitTests :: [TestTree]
|
||||||
unitTests =
|
unitTests =
|
||||||
[ Specifiable.unitTests,
|
[ Specifiable.unitTests
|
||||||
Specification.unitTests,
|
, Specification.unitTests
|
||||||
BuffonMachine.unitTests,
|
, BuffonMachine.unitTests
|
||||||
Sampler.unitTests
|
, Sampler.unitTests
|
||||||
]
|
]
|
||||||
|
@ -4,15 +4,15 @@ import Control.Monad (replicateM)
|
|||||||
import Data.BuffonMachine (choice, runIO)
|
import Data.BuffonMachine (choice, runIO)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Vector (Vector, fromList)
|
import Data.Vector (Vector, fromList)
|
||||||
import Test.Tasty
|
import Test.Tasty (
|
||||||
( TestTree,
|
TestTree,
|
||||||
testGroup,
|
testGroup,
|
||||||
)
|
)
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit (
|
||||||
( Assertion,
|
Assertion,
|
||||||
assertBool,
|
assertBool,
|
||||||
testCase,
|
testCase,
|
||||||
)
|
)
|
||||||
|
|
||||||
unitTests :: TestTree
|
unitTests :: TestTree
|
||||||
unitTests =
|
unitTests =
|
||||||
@ -27,18 +27,18 @@ choiceTests =
|
|||||||
[ testCase "[1/2, 1/2] is correctly sampled from" $ do
|
[ testCase "[1/2, 1/2] is correctly sampled from" $ do
|
||||||
[(0, a), (1, b)] <- choiceTest distributionA 1000000
|
[(0, a), (1, b)] <- choiceTest distributionA 1000000
|
||||||
a `almostEqual` 0.5
|
a `almostEqual` 0.5
|
||||||
b `almostEqual` 0.5,
|
b `almostEqual` 0.5
|
||||||
testCase "[1/3, 1/3, 1/3] is correctly sampled from" $ do
|
, testCase "[1/3, 1/3, 1/3] is correctly sampled from" $ do
|
||||||
[(0, a), (1, b), (2, c)] <- choiceTest distributionB 1000000
|
[(0, a), (1, b), (2, c)] <- choiceTest distributionB 1000000
|
||||||
a `almostEqual` 0.33
|
a `almostEqual` 0.33
|
||||||
b `almostEqual` 0.33
|
b `almostEqual` 0.33
|
||||||
c `almostEqual` 0.33,
|
c `almostEqual` 0.33
|
||||||
testCase "[1/7, 4/7, 2/7] is correctly sampled from" $ do
|
, testCase "[1/7, 4/7, 2/7] is correctly sampled from" $ do
|
||||||
[(0, a), (1, b), (2, c)] <- choiceTest distributionC 1000000
|
[(0, a), (1, b), (2, c)] <- choiceTest distributionC 1000000
|
||||||
a `almostEqual` 0.14
|
a `almostEqual` 0.14
|
||||||
b `almostEqual` 0.57
|
b `almostEqual` 0.57
|
||||||
c `almostEqual` 0.28,
|
c `almostEqual` 0.28
|
||||||
testCase "[1/1] is correctly sampled from" $ do
|
, testCase "[1/1] is correctly sampled from" $ do
|
||||||
[(0, a)] <- choiceTest distributionD 1000000
|
[(0, a)] <- choiceTest distributionD 1000000
|
||||||
a `almostEqual` 1.0
|
a `almostEqual` 1.0
|
||||||
]
|
]
|
||||||
|
@ -17,10 +17,10 @@ unitTests =
|
|||||||
|
|
||||||
sampleSizeTests :: [TestTree]
|
sampleSizeTests :: [TestTree]
|
||||||
sampleSizeTests =
|
sampleSizeTests =
|
||||||
[ testProperty "Lambda sampler respects size constraints for sizes around the mean of 1,000" lambdaSamplerSizeProp,
|
[ testProperty "Lambda sampler respects size constraints for sizes around the mean of 1,000" lambdaSamplerSizeProp
|
||||||
testProperty "BinTree sampler respects size constraints for sizes around the mean of 1,000" binTreeSamplerSizeProp,
|
, testProperty "BinTree sampler respects size constraints for sizes around the mean of 1,000" binTreeSamplerSizeProp
|
||||||
testProperty "Tree sampler respects size constraints for sizes around the mean of 1,000" treeSamplerSizeProp,
|
, testProperty "Tree sampler respects size constraints for sizes around the mean of 1,000" treeSamplerSizeProp
|
||||||
testProperty "Lambda list sampler respects size constraints for sizes around the mean of 1,000" lambdaListSamplerSizeProp
|
, testProperty "Lambda list sampler respects size constraints for sizes around the mean of 1,000" lambdaListSamplerSizeProp
|
||||||
]
|
]
|
||||||
|
|
||||||
lambdaSamplerSizeProp :: Positive Int -> Property
|
lambdaSamplerSizeProp :: Positive Int -> Property
|
||||||
|
@ -23,12 +23,12 @@ typeDefinitionTests =
|
|||||||
testGroup
|
testGroup
|
||||||
"Type definition unit tests"
|
"Type definition unit tests"
|
||||||
[ testCase "BinTree has a correct type definition" $
|
[ testCase "BinTree has a correct type definition" $
|
||||||
BinTree.expectedTypeDef @=? typedef (undefined :: BinTree),
|
BinTree.expectedTypeDef @=? typedef (undefined :: BinTree)
|
||||||
testCase "Tree has a correct type definition" $
|
, testCase "Tree has a correct type definition" $
|
||||||
Tree.expectedTypeDef @=? typedef (undefined :: Tree),
|
Tree.expectedTypeDef @=? typedef (undefined :: Tree)
|
||||||
testCase "DeBruijn has a correct type definition" $
|
, testCase "DeBruijn has a correct type definition" $
|
||||||
Lambda.expectedDeBruijnTypeDef @=? typedef (undefined :: DeBruijn),
|
Lambda.expectedDeBruijnTypeDef @=? typedef (undefined :: DeBruijn)
|
||||||
testCase "Lambda has a correct type definition" $
|
, testCase "Lambda has a correct type definition" $
|
||||||
Lambda.expectedLambdaTypeDef @=? typedef (undefined :: Lambda)
|
Lambda.expectedLambdaTypeDef @=? typedef (undefined :: Lambda)
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -37,13 +37,13 @@ typeNameTests =
|
|||||||
testGroup
|
testGroup
|
||||||
"Type name unit tests"
|
"Type name unit tests"
|
||||||
[ testCase "BinTree's type name is correct" $
|
[ testCase "BinTree's type name is correct" $
|
||||||
show ''BinTree @=? typeName (undefined :: BinTree),
|
show ''BinTree @=? typeName (undefined :: BinTree)
|
||||||
testCase "Tree's type name is correct" $
|
, testCase "Tree's type name is correct" $
|
||||||
show ''Tree @=? typeName (undefined :: Tree),
|
show ''Tree @=? typeName (undefined :: Tree)
|
||||||
testCase "Lambda's type name is correct" $
|
, testCase "Lambda's type name is correct" $
|
||||||
show ''Lambda @=? typeName (undefined :: Lambda),
|
show ''Lambda @=? typeName (undefined :: Lambda)
|
||||||
testCase "[DeBruijn]'s type name is correct" $
|
, testCase "[DeBruijn]'s type name is correct" $
|
||||||
"[Data.Types.Lambda.DeBruijn]" @=? typeName (undefined :: [DeBruijn]),
|
"[Data.Types.Lambda.DeBruijn]" @=? typeName (undefined :: [DeBruijn])
|
||||||
testCase "[[DeBruijn]]'s type name is correct" $
|
, testCase "[[DeBruijn]]'s type name is correct" $
|
||||||
"[[Data.Types.Lambda.DeBruijn]]" @=? typeName (undefined :: [[DeBruijn]])
|
"[[Data.Types.Lambda.DeBruijn]]" @=? typeName (undefined :: [[DeBruijn]])
|
||||||
]
|
]
|
||||||
|
@ -1,9 +1,8 @@
|
|||||||
{-# LANGUAGE TemplateHaskellQuotes #-}
|
{-# LANGUAGE TemplateHaskellQuotes #-}
|
||||||
|
|
||||||
module Test.Unit.Specification
|
module Test.Unit.Specification (
|
||||||
( unitTests,
|
unitTests,
|
||||||
)
|
) where
|
||||||
where
|
|
||||||
|
|
||||||
import qualified Data.Boltzmann.Specification as Specification
|
import qualified Data.Boltzmann.Specification as Specification
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
@ -14,14 +13,14 @@ import qualified Data.Types.Custom as Custom
|
|||||||
import Data.Types.Lambda (Lambda)
|
import Data.Types.Lambda (Lambda)
|
||||||
import qualified Data.Types.Lambda as Lambda
|
import qualified Data.Types.Lambda as Lambda
|
||||||
import qualified Data.Types.Tree as Tree
|
import qualified Data.Types.Tree as Tree
|
||||||
import Test.Tasty
|
import Test.Tasty (
|
||||||
( TestTree,
|
TestTree,
|
||||||
testGroup,
|
testGroup,
|
||||||
)
|
)
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit (
|
||||||
( testCase,
|
testCase,
|
||||||
(@=?),
|
(@=?),
|
||||||
)
|
)
|
||||||
|
|
||||||
unitTests :: TestTree
|
unitTests :: TestTree
|
||||||
unitTests =
|
unitTests =
|
||||||
@ -35,14 +34,14 @@ collectTypesTests =
|
|||||||
"Type collection unit tests"
|
"Type collection unit tests"
|
||||||
[ testCase "BinTree's types are collected correctly" $
|
[ testCase "BinTree's types are collected correctly" $
|
||||||
Set.singleton BinTree.binTree
|
Set.singleton BinTree.binTree
|
||||||
@=? Specification.collectTypes BinTree.binTreeSysSpec,
|
@=? Specification.collectTypes BinTree.binTreeSysSpec
|
||||||
testCase "Lambda's types are collected correctly" $
|
, testCase "Lambda's types are collected correctly" $
|
||||||
Set.fromList [Lambda.lambda, Lambda.deBruijn]
|
Set.fromList [Lambda.lambda, Lambda.deBruijn]
|
||||||
@=? Specification.collectTypes Lambda.lambdaSysSpec,
|
@=? Specification.collectTypes Lambda.lambdaSysSpec
|
||||||
testCase "Trees's types are collected correctly" $
|
, testCase "Trees's types are collected correctly" $
|
||||||
Set.fromList [Tree.tree, Tree.treeList]
|
Set.fromList [Tree.tree, Tree.treeList]
|
||||||
@=? Specification.collectTypes Tree.treeSysSpec,
|
@=? Specification.collectTypes Tree.treeSysSpec
|
||||||
testCase "Custom's types are collected correctly" $
|
, testCase "Custom's types are collected correctly" $
|
||||||
Set.fromList [Custom.custom, Custom.custom', Custom.customList']
|
Set.fromList [Custom.custom, Custom.custom', Custom.customList']
|
||||||
@=? Specification.collectTypes Custom.customSysSpec
|
@=? Specification.collectTypes Custom.customSysSpec
|
||||||
]
|
]
|
||||||
@ -52,13 +51,13 @@ constructorFrequenciesTests =
|
|||||||
testGroup
|
testGroup
|
||||||
"Constructor frequency tests"
|
"Constructor frequency tests"
|
||||||
[ testCase "BinTree's constructor frequencies are collected correctly" $
|
[ testCase "BinTree's constructor frequencies are collected correctly" $
|
||||||
Map.empty @=? Specification.constructorFrequencies BinTree.binTreeSysSpec,
|
Map.empty @=? Specification.constructorFrequencies BinTree.binTreeSysSpec
|
||||||
testCase "Lambda's constructor frequencies are collected correctly" $
|
, testCase "Lambda's constructor frequencies are collected correctly" $
|
||||||
Map.fromList [("Data.Types.Lambda.Abs", 330)]
|
Map.fromList [("Data.Types.Lambda.Abs", 330)]
|
||||||
@=? Specification.constructorFrequencies Lambda.lambdaSysSpec,
|
@=? Specification.constructorFrequencies Lambda.lambdaSysSpec
|
||||||
testCase "Tree's constructor frequencies are collected correctly" $
|
, testCase "Tree's constructor frequencies are collected correctly" $
|
||||||
Map.empty @=? Specification.constructorFrequencies Tree.treeSysSpec,
|
Map.empty @=? Specification.constructorFrequencies Tree.treeSysSpec
|
||||||
testCase "Custom's constructor frequencies are collected correctly" $
|
, testCase "Custom's constructor frequencies are collected correctly" $
|
||||||
Map.fromList [("Data.Types.Custom.ConsA", 800), ("Data.Types.Custom.ConsB", 900)]
|
Map.fromList [("Data.Types.Custom.ConsA", 800), ("Data.Types.Custom.ConsB", 900)]
|
||||||
@=? Specification.constructorFrequencies Custom.customSysSpec
|
@=? Specification.constructorFrequencies Custom.customSysSpec
|
||||||
]
|
]
|
||||||
@ -69,18 +68,18 @@ getWeightTests =
|
|||||||
"Constructor weight unit tests"
|
"Constructor weight unit tests"
|
||||||
[ testCase "BinTree's constructor weights are computed correctly" $ do
|
[ testCase "BinTree's constructor weights are computed correctly" $ do
|
||||||
0 @=? BinTree.binTreeSysSpec `Specification.getWeight` show 'BinTree.Leaf
|
0 @=? BinTree.binTreeSysSpec `Specification.getWeight` show 'BinTree.Leaf
|
||||||
1 @=? BinTree.binTreeSysSpec `Specification.getWeight` show 'BinTree.Node,
|
1 @=? BinTree.binTreeSysSpec `Specification.getWeight` show 'BinTree.Node
|
||||||
testCase "Lambda's constructor weights are computed correctly" $ do
|
, testCase "Lambda's constructor weights are computed correctly" $ do
|
||||||
0 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Index
|
0 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Index
|
||||||
1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Abs
|
1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Abs
|
||||||
1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.App
|
1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.App
|
||||||
1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.S
|
1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.S
|
||||||
1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Z,
|
1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Z
|
||||||
testCase "Tree's constructor weights are computed correctly" $ do
|
, testCase "Tree's constructor weights are computed correctly" $ do
|
||||||
1 @=? Tree.treeSysSpec `Specification.getWeight` show 'Tree.Node
|
1 @=? Tree.treeSysSpec `Specification.getWeight` show 'Tree.Node
|
||||||
0 @=? Tree.treeSysSpec `Specification.getWeight` show '[]
|
0 @=? Tree.treeSysSpec `Specification.getWeight` show '[]
|
||||||
0 @=? Tree.treeSysSpec `Specification.getWeight` show '(:),
|
0 @=? Tree.treeSysSpec `Specification.getWeight` show '(:)
|
||||||
testCase "Custom's constructor weights are computed correctly" $ do
|
, testCase "Custom's constructor weights are computed correctly" $ do
|
||||||
2 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsA
|
2 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsA
|
||||||
3 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsB
|
3 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsB
|
||||||
4 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsC
|
4 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsC
|
||||||
@ -92,18 +91,18 @@ getFrequencyTests =
|
|||||||
"Constructor frequencies unit tests"
|
"Constructor frequencies unit tests"
|
||||||
[ testCase "BinTree's constructor frequencies are computed correctly" $ do
|
[ testCase "BinTree's constructor frequencies are computed correctly" $ do
|
||||||
Nothing @=? BinTree.binTreeSysSpec `Specification.getFrequency` show 'BinTree.Leaf
|
Nothing @=? BinTree.binTreeSysSpec `Specification.getFrequency` show 'BinTree.Leaf
|
||||||
Nothing @=? BinTree.binTreeSysSpec `Specification.getFrequency` show 'BinTree.Node,
|
Nothing @=? BinTree.binTreeSysSpec `Specification.getFrequency` show 'BinTree.Node
|
||||||
testCase "Lambda's constructor frequencies are computed correctly" $ do
|
, testCase "Lambda's constructor frequencies are computed correctly" $ do
|
||||||
Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Index
|
Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Index
|
||||||
Just 330 @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Abs
|
Just 330 @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Abs
|
||||||
Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.App
|
Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.App
|
||||||
Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.S
|
Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.S
|
||||||
Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Z,
|
Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Z
|
||||||
testCase "Tree's constructor frequencies are computed correctly" $ do
|
, testCase "Tree's constructor frequencies are computed correctly" $ do
|
||||||
Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show 'Tree.Node
|
Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show 'Tree.Node
|
||||||
Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show '[]
|
Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show '[]
|
||||||
Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show '(:),
|
Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show '(:)
|
||||||
testCase "Custom's constructor frequencies are computed correctly" $ do
|
, testCase "Custom's constructor frequencies are computed correctly" $ do
|
||||||
Just 800 @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsA
|
Just 800 @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsA
|
||||||
Just 900 @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsB
|
Just 900 @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsB
|
||||||
Nothing @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsC
|
Nothing @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsC
|
||||||
@ -115,8 +114,8 @@ typeSpecTests =
|
|||||||
"TypeSpec unit tests"
|
"TypeSpec unit tests"
|
||||||
[ testCase "Equal type specs are correctly identified" $ do
|
[ testCase "Equal type specs are correctly identified" $ do
|
||||||
True @=? a == a
|
True @=? a == a
|
||||||
False @=? a == b,
|
False @=? a == b
|
||||||
testCase "Type specs are correctly ordered" $ do
|
, testCase "Type specs are correctly ordered" $ do
|
||||||
True @=? a <= a
|
True @=? a <= a
|
||||||
True @=? b <= a
|
True @=? b <= a
|
||||||
False @=? a <= b
|
False @=? a <= b
|
||||||
@ -124,14 +123,14 @@ typeSpecTests =
|
|||||||
where
|
where
|
||||||
a =
|
a =
|
||||||
Specification.TypeSpec
|
Specification.TypeSpec
|
||||||
{ Specification.specifiableType = undefined :: Lambda,
|
{ Specification.specifiableType = undefined :: Lambda
|
||||||
Specification.weight = Map.empty,
|
, Specification.weight = Map.empty
|
||||||
Specification.frequency = Map.empty
|
, Specification.frequency = Map.empty
|
||||||
}
|
}
|
||||||
|
|
||||||
b =
|
b =
|
||||||
Specification.TypeSpec
|
Specification.TypeSpec
|
||||||
{ Specification.specifiableType = undefined :: BinTree,
|
{ Specification.specifiableType = undefined :: BinTree
|
||||||
Specification.weight = Map.empty,
|
, Specification.weight = Map.empty
|
||||||
Specification.frequency = Map.empty
|
, Specification.frequency = Map.empty
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user