diff --git a/benchmark/BinTree/BinTree.hs b/benchmark/BinTree/BinTree.hs deleted file mode 100644 index 61a6647..0000000 --- a/benchmark/BinTree/BinTree.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE TemplateHaskell #-} - -module BinTree where - -import Control.DeepSeq (NFData) -import Data.Boltzmann.Sampler (BoltzmannSampler (..)) -import Data.Boltzmann.Sampler.TH (mkSampler) -import Data.Boltzmann.Specifiable ( - Specifiable, - ) -import Data.Boltzmann.Specification ( - SystemSpec, - specification, - withSystem, - withWeights, - (==>), - ) -import GHC.Generics (Generic) - -data BinTree - = Leaf - | Node BinTree BinTree - deriving (Show, Generic, Specifiable) - -binTreeSysSpec :: SystemSpec -binTreeSysSpec = - (undefined :: BinTree, 1_000) - `withSystem` [ specification - (undefined :: BinTree) - ( withWeights - ['Leaf ==> 0] - ) - ] - -mediumBinTreeSysSpec :: SystemSpec -mediumBinTreeSysSpec = - (undefined :: BinTree, 10_000) - `withSystem` [ specification - (undefined :: BinTree) - ( withWeights - ['Leaf ==> 0] - ) - ] - -$(mkSampler ''BinTree) - -instance NFData BinTree diff --git a/benchmark/BinTree/BinTreeBenchmark.hs b/benchmark/BinTree/BinTreeBenchmark.hs deleted file mode 100644 index 5084eca..0000000 --- a/benchmark/BinTree/BinTreeBenchmark.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE NumericUnderscores #-} - -import BinTree (BinTree) -import BinTreeSampler (mediumRandomBinTreeListIO, randomBinTreeListIO) -import Criterion.Main (bench, defaultMain, nfIO) - -sampler :: Int -> IO [BinTree] -sampler = randomBinTreeListIO 800 1200 - -mediumSampler :: Int -> IO [BinTree] -mediumSampler = mediumRandomBinTreeListIO 8_000 12_000 - -main :: IO () -main = - defaultMain - [ bench "100 binary trees" $ nfIO (sampler 100) - , bench "100 large binary trees" $ nfIO (mediumSampler 100) - ] diff --git a/benchmark/BinTree/BinTreeSampler.hs b/benchmark/BinTree/BinTreeSampler.hs deleted file mode 100644 index 0edac11..0000000 --- a/benchmark/BinTree/BinTreeSampler.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module BinTreeSampler (randomBinTreeListIO, mediumRandomBinTreeListIO) where - -import BinTree (BinTree, binTreeSysSpec, mediumBinTreeSysSpec) -import Control.Monad (replicateM) -import Data.Boltzmann.Oracle (mkSpecSampler) -import Data.Boltzmann.Sampler (rejectionSampler) -import Data.BuffonMachine (runIO) - -randomBinTreeListIO :: Int -> Int -> Int -> IO [BinTree] -randomBinTreeListIO lb ub n = - runIO $ - replicateM n (rejectionSampler $(mkSpecSampler binTreeSysSpec) lb ub) - -mediumRandomBinTreeListIO :: Int -> Int -> Int -> IO [BinTree] -mediumRandomBinTreeListIO lb ub n = - runIO $ - replicateM n (rejectionSampler $(mkSpecSampler mediumBinTreeSysSpec) lb ub) diff --git a/generic-boltzmann-brain.cabal b/generic-boltzmann-brain.cabal index 8927cc6..db74df5 100644 --- a/generic-boltzmann-brain.cabal +++ b/generic-boltzmann-brain.cabal @@ -38,7 +38,7 @@ library Paths_generic_boltzmann_brain hs-source-dirs: src - ghc-options: -O2 -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-name-shadowing -fwarn-missing-signatures -ddump-splices + ghc-options: -O2 -Wall -Wcompat -Wmissing-export-lists -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-name-shadowing -fwarn-missing-signatures build-depends: base >=4.7 && <5 , containers >=0.6.4 @@ -61,7 +61,7 @@ executable binTreeProfile Paths_generic_boltzmann_brain hs-source-dirs: profile/BinTree - ghc-options: -O2 -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-name-shadowing -fwarn-missing-signatures -ddump-splices + ghc-options: -O2 -Wall -Wcompat -Wmissing-export-lists -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-name-shadowing -fwarn-missing-signatures -ddump-splices build-depends: base >=4.7 && <5 , containers >=0.6.4 @@ -81,22 +81,11 @@ test-suite generic-boltzmann-brain-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - Data.Samplers.BinTree - Data.Samplers.Lambda - Data.Samplers.Tree - Data.Types.BinTree - Data.Types.Custom - Data.Types.Lambda - Data.Types.Tree - Test.Unit.BuffonMachine - Test.Unit.Sampler - Test.Unit.Specifiable - Test.Unit.Specification - Test.Unit.Utils + Test.Unit.Samplable Paths_generic_boltzmann_brain hs-source-dirs: test - ghc-options: -O2 -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-name-shadowing -fwarn-missing-signatures -ddump-splices + ghc-options: -O2 -Wall -Wcompat -Wmissing-export-lists -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-name-shadowing -fwarn-missing-signatures build-depends: QuickCheck >=2.14.2 , base >=4.7 && <5 @@ -115,30 +104,3 @@ test-suite generic-boltzmann-brain-test , transformers >=0.5.6 , vector >=0.12.3.1 default-language: Haskell2010 - -benchmark binTree - type: exitcode-stdio-1.0 - main-is: BinTreeBenchmark.hs - other-modules: - BinTree - BinTreeSampler - Paths_generic_boltzmann_brain - hs-source-dirs: - benchmark/BinTree - ghc-options: -O2 -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-name-shadowing -fwarn-missing-signatures -ddump-splices - build-depends: - base >=4.7 && <5 - , containers >=0.6.4 - , criterion >=1.5.12.0 - , deepseq >=1.4.5.0 - , generic-boltzmann-brain - , mtl >=2.2.2 - , paganini-hs >=0.3.0.0 - , random >=1.2.0 - , template-haskell >=2.17.0.0 - , th-abstraction >=0.4.3.0 - , th-lift >=0.8.2 - , th-lift-instances >=0.1.18 - , transformers >=0.5.6 - , vector >=0.12.3.1 - default-language: Haskell2010 diff --git a/hie.yaml b/hie.yaml index 9ab6122..4ef275e 100644 --- a/hie.yaml +++ b/hie.yaml @@ -1,10 +1,2 @@ cradle: stack: - - path: "./src" - component: "generic-boltzmann-brain:lib" - - - path: "./benchmark" - component: "generic-boltzmann-brain:exe:generic-boltzmann-brain-benchmark" - - - path: "./test" - component: "generic-boltzmann-brain:test:generic-boltzmann-brain-test" diff --git a/package.yaml b/package.yaml index 839da9e..2d3f94b 100644 --- a/package.yaml +++ b/package.yaml @@ -37,12 +37,12 @@ library: - -O2 - -Wall - -Wcompat + - -Wmissing-export-lists - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wredundant-constraints - -Wno-name-shadowing - -fwarn-missing-signatures - - -ddump-splices executables: binTreeProfile: @@ -52,6 +52,7 @@ executables: - -O2 - -Wall - -Wcompat + - -Wmissing-export-lists - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wredundant-constraints @@ -61,25 +62,6 @@ executables: dependencies: - generic-boltzmann-brain -benchmarks: - binTree: - main: BinTreeBenchmark.hs - source-dirs: benchmark/BinTree - ghc-options: - - -O2 - - -Wall - - -Wcompat - - -Wincomplete-record-updates - - -Wincomplete-uni-patterns - - -Wredundant-constraints - - -Wno-name-shadowing - - -fwarn-missing-signatures - - -ddump-splices - dependencies: - - generic-boltzmann-brain - - criterion >= 1.5.12.0 - - deepseq >= 1.4.5.0 - tests: generic-boltzmann-brain-test: main: Spec.hs @@ -88,12 +70,12 @@ tests: - -O2 - -Wall - -Wcompat + - -Wmissing-export-lists - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wredundant-constraints - -Wno-name-shadowing - -fwarn-missing-signatures - - -ddump-splices dependencies: - generic-boltzmann-brain - tasty >= 1.4.2 diff --git a/test/Data/Samplers/BinTree.hs b/test/Data/Samplers/BinTree.hs deleted file mode 100644 index 2809290..0000000 --- a/test/Data/Samplers/BinTree.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Data.Samplers.BinTree (randomBinTreeIO) where - -import Data.Boltzmann.Oracle (mkSpecSampler) -import Data.Boltzmann.Sampler (rejectionSamplerIO) -import Data.Types.BinTree (BinTree, binTreeSysSpec) - -randomBinTreeIO :: Int -> Int -> IO BinTree -randomBinTreeIO = rejectionSamplerIO $(mkSpecSampler binTreeSysSpec) diff --git a/test/Data/Samplers/Lambda.hs b/test/Data/Samplers/Lambda.hs deleted file mode 100644 index faaed46..0000000 --- a/test/Data/Samplers/Lambda.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Data.Samplers.Lambda (randomLambdaIO, randomLambdaListIO) where - -import Data.Boltzmann.Oracle (mkSpecSampler) -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) diff --git a/test/Data/Samplers/Tree.hs b/test/Data/Samplers/Tree.hs deleted file mode 100644 index 5624fef..0000000 --- a/test/Data/Samplers/Tree.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Data.Samplers.Tree (randomTreeIO) where - -import Data.Boltzmann.Oracle (mkSpecSampler) -import Data.Boltzmann.Sampler (rejectionSamplerIO) -import Data.Types.Tree (Tree, treeSysSpec) - -randomTreeIO :: Int -> Int -> IO Tree -randomTreeIO = rejectionSamplerIO $(mkSpecSampler treeSysSpec) diff --git a/test/Data/Types/BinTree.hs b/test/Data/Types/BinTree.hs deleted file mode 100644 index 75ee6de..0000000 --- a/test/Data/Types/BinTree.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} - -module Data.Types.BinTree where - -import Data.Boltzmann.Sampler (BoltzmannSampler (..)) -import Data.Boltzmann.Sampler.TH (mkSampler) -import Data.Boltzmann.Specifiable ( - Cons (..), - Specifiable, - SpecifiableType (..), - TypeDef, - ) -import Data.Boltzmann.Specification ( - SystemSpec, - specification, - withSystem, - withWeights, - (==>), - ) -import GHC.Generics (Generic) -import Test.Unit.Utils (Size (..)) - -data BinTree - = Leaf - | Node BinTree BinTree - deriving (Show, Generic, Specifiable) - -instance Size BinTree where - size Leaf = 0 - size (Node ln rn) = 1 + size ln + size rn - -binTree :: SpecifiableType -binTree = SpecifiableType (undefined :: BinTree) - -expectedTypeDef :: TypeDef -expectedTypeDef = - [ Cons {name = "Data.Types.BinTree.Leaf", args = []} - , Cons {name = "Data.Types.BinTree.Node", args = [binTree, binTree]} - ] - -binTreeSysSpec :: SystemSpec -binTreeSysSpec = - (undefined :: BinTree, 4000) - `withSystem` [ specification - (undefined :: BinTree) - ( withWeights - ['Leaf ==> 0] - ) - ] - -$(mkSampler ''BinTree) diff --git a/test/Data/Types/Custom.hs b/test/Data/Types/Custom.hs deleted file mode 100644 index 530751d..0000000 --- a/test/Data/Types/Custom.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskellQuotes #-} - -module Data.Types.Custom where - -import Data.Boltzmann.Specifiable ( - Specifiable, - SpecifiableType (..), - ) -import Data.Boltzmann.Specification ( - SystemSpec, - specification, - withFrequencies, - withSystem, - withWeights, - (==>), - ) -import GHC.Generics (Generic) -import Test.Unit.Utils (Size (..)) - -data Custom - = ConsA Custom - | ConsB [Custom'] - deriving (Show, Generic, Specifiable) - -newtype Custom' - = ConsC Custom - deriving (Show, Generic, Specifiable) - -instance Size Custom where - size (ConsA x) = 1 + size x - size (ConsB x) = 1 + size x - -instance Size Custom' where - size (ConsC x) = 1 + size x - -custom :: SpecifiableType -custom = SpecifiableType (undefined :: Custom) - -custom' :: SpecifiableType -custom' = SpecifiableType (undefined :: Custom') - -customList' :: SpecifiableType -customList' = SpecifiableType (undefined :: [Custom']) - -customSysSpec :: SystemSpec -customSysSpec = - (undefined :: Custom, 10000) - `withSystem` [ specification - (undefined :: Custom) - ( withWeights - [ 'ConsA ==> 2 - , 'ConsB ==> 3 - , 'ConsC ==> 4 - ] - . withFrequencies - [ 'ConsA ==> 800 - , 'ConsB ==> 900 - ] - ) - ] diff --git a/test/Data/Types/Lambda.hs b/test/Data/Types/Lambda.hs deleted file mode 100644 index 45c69d2..0000000 --- a/test/Data/Types/Lambda.hs +++ /dev/null @@ -1,87 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TemplateHaskell #-} - -module Data.Types.Lambda where - -import Data.Boltzmann.Sampler (BoltzmannSampler (..)) -import Data.Boltzmann.Sampler.TH (mkSampler) -import Data.Boltzmann.Specifiable ( - Cons (..), - Specifiable, - SpecifiableType (..), - TypeDef, - ) -import Data.Boltzmann.Specification ( - SystemSpec, - specification, - withFrequencies, - withSystem, - withWeights, - (==>), - ) -import GHC.Generics (Generic) -import Test.Unit.Utils (Size (..)) - -data DeBruijn = S DeBruijn | Z - deriving (Generic, Show, Specifiable) - -instance Size DeBruijn where - size (S n) = 1 + size n - size Z = 1 - -data Lambda - = Abs Lambda - | App Lambda Lambda - | Index DeBruijn - deriving (Generic, Show, Specifiable) - -instance Size Lambda where - size (Abs t) = 1 + size t - size (App lt rt) = 1 + size lt + size rt - size (Index n) = size n - -deBruijn :: SpecifiableType -deBruijn = SpecifiableType (undefined :: DeBruijn) - -lambda :: SpecifiableType -lambda = SpecifiableType (undefined :: Lambda) - -expectedDeBruijnTypeDef :: TypeDef -expectedDeBruijnTypeDef = - [ Cons {name = "Data.Types.Lambda.S", args = [deBruijn]} - , Cons {name = "Data.Types.Lambda.Z", args = []} - ] - -expectedLambdaTypeDef :: TypeDef -expectedLambdaTypeDef = - [ Cons {name = "Data.Types.Lambda.Abs", args = [lambda]} - , Cons {name = "Data.Types.Lambda.App", args = [lambda, lambda]} - , Cons {name = "Data.Types.Lambda.Index", args = [deBruijn]} - ] - -lambdaSysSpec :: SystemSpec -lambdaSysSpec = - (undefined :: Lambda, 1000) - `withSystem` [ specification - (undefined :: Lambda) - ( withWeights - ['Index ==> 0] - . withFrequencies - ['Abs ==> 330] - ) - ] - -lambdaListSysSpec :: SystemSpec -lambdaListSysSpec = - (undefined :: [Lambda], 1000) - `withSystem` [ specification - (undefined :: [Lambda]) - ( withWeights - ['Index ==> 0] - ) - ] - -$(mkSampler ''DeBruijn) -$(mkSampler ''Lambda) diff --git a/test/Data/Types/Tree.hs b/test/Data/Types/Tree.hs deleted file mode 100644 index daea405..0000000 --- a/test/Data/Types/Tree.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} - -module Data.Types.Tree where - -import Data.Boltzmann.Sampler (BoltzmannSampler (..)) -import Data.Boltzmann.Sampler.TH (mkSampler) -import Data.Boltzmann.Specifiable ( - Cons (..), - Specifiable, - SpecifiableType (..), - TypeDef, - ) -import Data.Boltzmann.Specification ( - SystemSpec, - defaultTypeSpec, - withSystem, - ) -import GHC.Generics (Generic) -import Test.Unit.Utils (Size (..)) - -newtype Tree = Node [Tree] - deriving (Show, Generic, Specifiable) - -treeList :: SpecifiableType -treeList = SpecifiableType (undefined :: [Tree]) - -tree :: SpecifiableType -tree = SpecifiableType (undefined :: Tree) - -expectedTypeDef :: TypeDef -expectedTypeDef = - [Cons {name = "Data.Types.Tree.Node", args = [treeList]}] - -instance Size Tree where - size (Node xs) = 1 + size xs - -treeSysSpec :: SystemSpec -treeSysSpec = - (undefined :: Tree, 1000) - `withSystem` [defaultTypeSpec (undefined :: Tree)] - -$(mkSampler ''Tree) diff --git a/test/Spec.hs b/test/Spec.hs index ce2f37f..93c21fb 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,8 +1,5 @@ import Test.Tasty (TestTree, defaultMain, testGroup) -import qualified Test.Unit.BuffonMachine as BuffonMachine -import qualified Test.Unit.Sampler as Sampler -import qualified Test.Unit.Specifiable as Specifiable -import qualified Test.Unit.Specification as Specification +import qualified Test.Unit.Samplable as Samplable main :: IO () main = defaultMain tests @@ -12,8 +9,4 @@ tests = testGroup "Unit tests" unitTests unitTests :: [TestTree] unitTests = - [ Specifiable.unitTests - , Specification.unitTests - , BuffonMachine.unitTests - , Sampler.unitTests - ] + [Samplable.unitTests] diff --git a/test/Test/Unit/BuffonMachine.hs b/test/Test/Unit/Samplable.hs similarity index 51% rename from test/Test/Unit/BuffonMachine.hs rename to test/Test/Unit/Samplable.hs index a0f8b9d..83b330a 100644 --- a/test/Test/Unit/BuffonMachine.hs +++ b/test/Test/Unit/Samplable.hs @@ -1,9 +1,10 @@ -module Test.Unit.BuffonMachine (unitTests) where +module Test.Unit.Samplable (unitTests) where import Control.Monad (replicateM) -import Data.BuffonMachine (choice, runIO) +import Data.Boltzmann.Samplable (Distribution (..), choice) +import Data.BuffonMachine (runIO) import qualified Data.Map as Map -import Data.Vector (Vector, fromList) +import Data.Vector (fromList) import Test.Tasty ( TestTree, testGroup, @@ -44,21 +45,21 @@ choiceTests = ] -- [1/2, 1/2] -distributionA :: Vector Int -distributionA = fromList [2, 3, -2, -1] +distributionA :: Distribution a +distributionA = Distribution $ fromList [2, 3, -2, -1] -- [1/3, 1/3, 1/3] -distributionB :: Vector Int -distributionB = fromList [2, 138, 4, 137, 6, 133, 8, 132, 10, 128, 12, 127, 14, 123, 16, 122, 18, 118, 20, 117, 22, 113, 24, 112, 26, 108, 28, 107, 30, 103, 32, 102, 34, 98, 36, 97, 38, 93, 40, 92, 42, 88, 44, 87, 46, 83, 48, 82, 50, 78, 52, 77, 54, 73, 56, 72, 58, 68, 60, 67, 62, 66, 64, 65, -2, -1, -3, -3, 70, 71, -2, -1, -3, 75, 76, -2, -1, -3, 80, 81, -2, -1, -3, 85, 86, -2, -1, -3, 90, 91, -2, -1, -3, 95, 96, -2, -1, -3, 100, 101, -2, -1, -3, 105, 106, -2, -1, -3, 110, 111, -2, -1, -3, 115, 116, -2, -1, -3, 120, 121, -2, -1, -3, 125, 126, -2, -1, -3, 130, 131, -2, -1, -3, 135, 136, -2, -1, -3, 140, 141, -2, -1] +distributionB :: Distribution a +distributionB = Distribution $ fromList [2, 138, 4, 137, 6, 133, 8, 132, 10, 128, 12, 127, 14, 123, 16, 122, 18, 118, 20, 117, 22, 113, 24, 112, 26, 108, 28, 107, 30, 103, 32, 102, 34, 98, 36, 97, 38, 93, 40, 92, 42, 88, 44, 87, 46, 83, 48, 82, 50, 78, 52, 77, 54, 73, 56, 72, 58, 68, 60, 67, 62, 66, 64, 65, -2, -1, -3, -3, 70, 71, -2, -1, -3, 75, 76, -2, -1, -3, 80, 81, -2, -1, -3, 85, 86, -2, -1, -3, 90, 91, -2, -1, -3, 95, 96, -2, -1, -3, 100, 101, -2, -1, -3, 105, 106, -2, -1, -3, 110, 111, -2, -1, -3, 115, 116, -2, -1, -3, 120, 121, -2, -1, -3, 125, 126, -2, -1, -3, 130, 131, -2, -1, -3, 135, 136, -2, -1, -3, 140, 141, -2, -1] -- [1/7, 4/7, 2/7] -distributionC :: Vector Int -distributionC = fromList [2, 96, 4, 95, 6, 94, 8, 93, 10, 92, 12, 91, 14, 90, 16, 89, 18, 88, 20, 87, 22, 86, 24, 85, 26, 84, 28, 83, 30, 82, 32, 81, 34, 80, 36, 79, 38, 78, 40, 77, 42, 76, 44, 75, 46, 74, 48, 73, 50, 72, 52, 71, 54, 70, 56, 69, 58, 68, 60, 67, 62, 66, 64, 65, -3, -1, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2] +distributionC :: Distribution a +distributionC = Distribution $ fromList [2, 96, 4, 95, 6, 94, 8, 93, 10, 92, 12, 91, 14, 90, 16, 89, 18, 88, 20, 87, 22, 86, 24, 85, 26, 84, 28, 83, 30, 82, 32, 81, 34, 80, 36, 79, 38, 78, 40, 77, 42, 76, 44, 75, 46, 74, 48, 73, 50, 72, 52, 71, 54, 70, 56, 69, 58, 68, 60, 67, 62, 66, 64, 65, -3, -1, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2, -1, -3, -2] -distributionD :: Vector Int -distributionD = fromList [] +distributionD :: Distribution a +distributionD = Distribution $ fromList [] -choiceTest :: Vector Int -> Int -> IO [(Int, Double)] +choiceTest :: Distribution a -> Int -> IO [(Int, Double)] choiceTest dist n = runIO $ do sam <- replicateM n (choice dist) let groups = frequency sam diff --git a/test/Test/Unit/Sampler.hs b/test/Test/Unit/Sampler.hs deleted file mode 100644 index 4831bae..0000000 --- a/test/Test/Unit/Sampler.hs +++ /dev/null @@ -1,52 +0,0 @@ -module Test.Unit.Sampler (unitTests) where - -import Data.Boltzmann.Sampler () -import Data.Samplers.BinTree -import Data.Samplers.Lambda -import Data.Samplers.Tree -import Test.QuickCheck.Monadic -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck -import Test.Unit.Utils (size) - -unitTests :: TestTree -unitTests = - testGroup - "Sampler" - sampleSizeTests - -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 "Lambda list sampler respects size constraints for sizes around the mean of 1,000" lambdaListSamplerSizeProp - ] - -lambdaSamplerSizeProp :: Positive Int -> Property -lambdaSamplerSizeProp (Positive x) = monadicIO $ do - let (lb, ub) = (800 + x, 1200 + x) - term <- run $ randomLambdaIO lb ub - 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) - tree <- run $ randomBinTreeIO lb ub - let n = size tree - assert $ lb <= n && n <= ub - -treeSamplerSizeProp :: Positive Int -> Property -treeSamplerSizeProp (Positive x) = monadicIO $ do - let (lb, ub) = (800 + x, 1200 + x) - tree <- run $ randomTreeIO lb ub - let n = size tree - assert $ lb <= n && n <= ub diff --git a/test/Test/Unit/Specifiable.hs b/test/Test/Unit/Specifiable.hs deleted file mode 100644 index 9784e87..0000000 --- a/test/Test/Unit/Specifiable.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE TemplateHaskellQuotes #-} - -module Test.Unit.Specifiable (unitTests) where - -import Data.Boltzmann.Specifiable (typeName, typedef) -import Data.Types.BinTree (BinTree) -import qualified Data.Types.BinTree as BinTree -import Data.Types.Lambda (DeBruijn, Lambda) -import qualified Data.Types.Lambda as Lambda -import Data.Types.Tree (Tree) -import qualified Data.Types.Tree as Tree -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (testCase, (@=?)) - -unitTests :: TestTree -unitTests = - testGroup - "Specifiable unit tests" - [typeDefinitionTests, typeNameTests] - -typeDefinitionTests :: TestTree -typeDefinitionTests = - testGroup - "Type definition unit tests" - [ testCase "BinTree has a correct type definition" $ - BinTree.expectedTypeDef @=? typedef (undefined :: BinTree) - , testCase "Tree has a correct type definition" $ - Tree.expectedTypeDef @=? typedef (undefined :: Tree) - , testCase "DeBruijn has a correct type definition" $ - Lambda.expectedDeBruijnTypeDef @=? typedef (undefined :: DeBruijn) - , testCase "Lambda has a correct type definition" $ - Lambda.expectedLambdaTypeDef @=? typedef (undefined :: Lambda) - ] - -typeNameTests :: TestTree -typeNameTests = - testGroup - "Type name unit tests" - [ testCase "BinTree's type name is correct" $ - show ''BinTree @=? typeName (undefined :: BinTree) - , testCase "Tree's type name is correct" $ - show ''Tree @=? typeName (undefined :: Tree) - , testCase "Lambda's type name is correct" $ - show ''Lambda @=? typeName (undefined :: Lambda) - , testCase "[DeBruijn]'s type name is correct" $ - "[Data.Types.Lambda.DeBruijn]" @=? typeName (undefined :: [DeBruijn]) - , testCase "[[DeBruijn]]'s type name is correct" $ - "[[Data.Types.Lambda.DeBruijn]]" @=? typeName (undefined :: [[DeBruijn]]) - ] diff --git a/test/Test/Unit/Specification.hs b/test/Test/Unit/Specification.hs deleted file mode 100644 index d59fa77..0000000 --- a/test/Test/Unit/Specification.hs +++ /dev/null @@ -1,136 +0,0 @@ -{-# LANGUAGE TemplateHaskellQuotes #-} - -module Test.Unit.Specification ( - unitTests, -) where - -import qualified Data.Boltzmann.Specification as Specification -import qualified Data.Map as Map -import qualified Data.Set as Set -import Data.Types.BinTree (BinTree) -import qualified Data.Types.BinTree as BinTree -import qualified Data.Types.Custom as Custom -import Data.Types.Lambda (Lambda) -import qualified Data.Types.Lambda as Lambda -import qualified Data.Types.Tree as Tree -import Test.Tasty ( - TestTree, - testGroup, - ) -import Test.Tasty.HUnit ( - testCase, - (@=?), - ) - -unitTests :: TestTree -unitTests = - testGroup - "Specification unit tests" - [typeSpecTests, collectTypesTests, constructorFrequenciesTests, getWeightTests, getFrequencyTests] - -collectTypesTests :: TestTree -collectTypesTests = - testGroup - "Type collection unit tests" - [ testCase "BinTree's types are collected correctly" $ - Set.singleton BinTree.binTree - @=? Specification.collectTypes BinTree.binTreeSysSpec - , testCase "Lambda's types are collected correctly" $ - Set.fromList [Lambda.lambda, Lambda.deBruijn] - @=? Specification.collectTypes Lambda.lambdaSysSpec - , testCase "Trees's types are collected correctly" $ - Set.fromList [Tree.tree, Tree.treeList] - @=? Specification.collectTypes Tree.treeSysSpec - , testCase "Custom's types are collected correctly" $ - Set.fromList [Custom.custom, Custom.custom', Custom.customList'] - @=? Specification.collectTypes Custom.customSysSpec - ] - -constructorFrequenciesTests :: TestTree -constructorFrequenciesTests = - testGroup - "Constructor frequency tests" - [ testCase "BinTree's constructor frequencies are collected correctly" $ - Map.empty @=? Specification.constructorFrequencies BinTree.binTreeSysSpec - , testCase "Lambda's constructor frequencies are collected correctly" $ - Map.fromList [("Data.Types.Lambda.Abs", 330)] - @=? Specification.constructorFrequencies Lambda.lambdaSysSpec - , testCase "Tree's constructor frequencies are collected correctly" $ - Map.empty @=? Specification.constructorFrequencies Tree.treeSysSpec - , testCase "Custom's constructor frequencies are collected correctly" $ - Map.fromList [("Data.Types.Custom.ConsA", 800), ("Data.Types.Custom.ConsB", 900)] - @=? Specification.constructorFrequencies Custom.customSysSpec - ] - -getWeightTests :: TestTree -getWeightTests = - testGroup - "Constructor weight unit tests" - [ testCase "BinTree's constructor weights are computed correctly" $ do - 0 @=? BinTree.binTreeSysSpec `Specification.getWeight` show 'BinTree.Leaf - 1 @=? BinTree.binTreeSysSpec `Specification.getWeight` show 'BinTree.Node - , testCase "Lambda's constructor weights are computed correctly" $ do - 0 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Index - 1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Abs - 1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.App - 1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.S - 1 @=? Lambda.lambdaSysSpec `Specification.getWeight` show 'Lambda.Z - , testCase "Tree's constructor weights are computed correctly" $ do - 1 @=? Tree.treeSysSpec `Specification.getWeight` show 'Tree.Node - 0 @=? Tree.treeSysSpec `Specification.getWeight` show '[] - 0 @=? Tree.treeSysSpec `Specification.getWeight` show '(:) - , testCase "Custom's constructor weights are computed correctly" $ do - 2 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsA - 3 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsB - 4 @=? Custom.customSysSpec `Specification.getWeight` show 'Custom.ConsC - ] - -getFrequencyTests :: TestTree -getFrequencyTests = - testGroup - "Constructor frequencies unit tests" - [ testCase "BinTree's constructor frequencies are computed correctly" $ do - Nothing @=? BinTree.binTreeSysSpec `Specification.getFrequency` show 'BinTree.Leaf - Nothing @=? BinTree.binTreeSysSpec `Specification.getFrequency` show 'BinTree.Node - , testCase "Lambda's constructor frequencies are computed correctly" $ do - Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Index - Just 330 @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Abs - Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.App - Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.S - Nothing @=? Lambda.lambdaSysSpec `Specification.getFrequency` show 'Lambda.Z - , testCase "Tree's constructor frequencies are computed correctly" $ do - Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show 'Tree.Node - Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show '[] - Nothing @=? Tree.treeSysSpec `Specification.getFrequency` show '(:) - , testCase "Custom's constructor frequencies are computed correctly" $ do - Just 800 @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsA - Just 900 @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsB - Nothing @=? Custom.customSysSpec `Specification.getFrequency` show 'Custom.ConsC - ] - -typeSpecTests :: TestTree -typeSpecTests = - testGroup - "TypeSpec unit tests" - [ testCase "Equal type specs are correctly identified" $ do - True @=? a == a - False @=? a == b - , testCase "Type specs are correctly ordered" $ do - True @=? a <= a - True @=? b <= a - False @=? a <= b - ] - where - a = - Specification.TypeSpec - { Specification.specifiableType = undefined :: Lambda - , Specification.weight = Map.empty - , Specification.frequency = Map.empty - } - - b = - Specification.TypeSpec - { Specification.specifiableType = undefined :: BinTree - , Specification.weight = Map.empty - , Specification.frequency = Map.empty - } diff --git a/test/Test/Unit/Utils.hs b/test/Test/Unit/Utils.hs deleted file mode 100644 index 006f89f..0000000 --- a/test/Test/Unit/Utils.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Test.Unit.Utils (Size (..)) where - -class Size a where - size :: a -> Int - -instance Size a => Size [a] where - size = sum . map size