Lambda list sampler tests.

src/Data/Boltzmann/Oracle.hs

@@ -140,6 +140,9 @@ mkDDGs variables = do
 
   return $ Map.fromList ddgs
 
+paganiniSpecIO :: S.SystemSpec -> IO (Either PaganiniError SystemDDGs)
+paganiniSpecIO = debugPaganini . paganiniSpec
+
 paganiniSpec :: S.SystemSpec -> Spec SystemDDGs
 paganiniSpec sys@(S.SystemSpec {S.targetType = target, S.meanSize = n}) = do
   let samplableTypes = S.collectTypes sys
@@ -157,14 +160,11 @@ paganiniSpec sys@(S.SystemSpec {S.targetType = target, S.meanSize = n}) = do
           }
 
   mkTypeVariables variables samplableTypes
-
   let (Let t) = varDefs Map.! typeName target
+
   tune t -- tune for target variable.
   mkDDGs variables
 
-paganiniSpecIO :: S.SystemSpec -> IO (Either PaganiniError SystemDDGs)
-paganiniSpecIO = debugPaganini . paganiniSpec
-
 systemDDGs :: S.SystemSpec -> IO SystemDDGs
 systemDDGs sys = do
   spec <- paganiniSpecIO sys

test/Data/Samplers/BinTree.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Data.Samplers.BinTree where
+module Data.Samplers.BinTree (randomBinTreeIO) where
 
 import Data.Boltzmann.Oracle (mkSpecSampler)
-import Data.Boltzmann.Sampler (BoltzmannSampler (..), rejectionSamplerIO)
+import Data.Boltzmann.Sampler (rejectionSamplerIO)
 import Data.Types.BinTree (BinTree, binTreeSysSpec)
 
 randomBinTreeIO :: Int -> Int -> IO BinTree

test/Data/Samplers/Lambda.hs

@@ -1,10 +1,13 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Data.Samplers.Lambda where
+module Data.Samplers.Lambda (randomLambdaIO, randomLambdaListIO) where
 
 import Data.Boltzmann.Oracle (mkSpecSampler)
-import Data.Boltzmann.Sampler (BoltzmannSampler (..), rejectionSamplerIO)
-import Data.Types.Lambda (Lambda, lambdaSysSpec)
+import Data.Boltzmann.Sampler (rejectionSamplerIO)
+import Data.Types.Lambda (Lambda, lambdaListSysSpec, lambdaSysSpec)
 
 randomLambdaIO :: Int -> Int -> IO Lambda
 randomLambdaIO = rejectionSamplerIO $(mkSpecSampler lambdaSysSpec)
+
+randomLambdaListIO :: Int -> Int -> IO [Lambda]
+randomLambdaListIO = rejectionSamplerIO $(mkSpecSampler lambdaListSysSpec)

test/Data/Samplers/Tree.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Data.Samplers.Tree where
+module Data.Samplers.Tree (randomTreeIO) where
 
 import Data.Boltzmann.Oracle (mkSpecSampler)
-import Data.Boltzmann.Sampler (BoltzmannSampler (..), rejectionSamplerIO)
+import Data.Boltzmann.Sampler (rejectionSamplerIO)
 import Data.Types.Tree (Tree, treeSysSpec)
 
 randomTreeIO :: Int -> Int -> IO Tree

test/Data/Types/Lambda.hs

@@ -70,5 +70,15 @@ lambdaSysSpec =
                      )
                  ]
 
+lambdaListSysSpec :: SystemSpec
+lambdaListSysSpec =
+  (undefined :: [Lambda], 1000)
+    `withSystem` [ specification
+                     (undefined :: [Lambda])
+                     ( withWeights
+                         ['Index ==> 0]
+                     )
+                 ]
+
 $(mkSampler ''DeBruijn)
 $(mkSampler ''Lambda)

test/Data/Types/Tree.hs

@@ -31,7 +31,7 @@ expectedTypeDef =
   [Cons {name = "Data.Types.Tree.Node", args = [treeList]}]
 
 instance Size Tree where
-  size (Node xs) = 1 + sum (map size xs)
+  size (Node xs) = 1 + size xs
 
 treeSysSpec :: SystemSpec
 treeSysSpec =

test/Test/Unit/Sampler.hs

@@ -19,7 +19,8 @@ sampleSizeTests :: [TestTree]
 sampleSizeTests =
   [ 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 "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
   ]
 
 lambdaSamplerSizeProp :: Positive Int -> Property
@@ -29,6 +30,13 @@ lambdaSamplerSizeProp (Positive x) = monadicIO $ do
   let n = size term
   assert $ lb <= n && n <= ub
 
+lambdaListSamplerSizeProp :: Positive Int -> Property
+lambdaListSamplerSizeProp (Positive x) = monadicIO $ do
+  let (lb, ub) = (800 + x, 1200 + x)
+  terms <- run $ randomLambdaListIO lb ub
+  let n = size terms
+  assert $ lb <= n && n <= ub
+
 binTreeSamplerSizeProp :: Positive Int -> Property
 binTreeSamplerSizeProp (Positive x) = monadicIO $ do
   let (lb, ub) = (800 + x, 1200 + x)

test/Test/Unit/Utils.hs

@@ -2,3 +2,6 @@ module Test.Unit.Utils (Size (..)) where
 
 class Size a where
   size :: a -> Int
+
+instance Size a => Size [a] where
+  size = sum . map size