combinatorial 0.1.0.1 → 0.1.1
raw patch · 19 files changed
+905/−461 lines, 19 filesdep +doctest-exitcode-stdiodep +doctest-libdep ~containersdep ~transformersPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: doctest-exitcode-stdio, doctest-lib
Dependency ranges changed: containers, transformers
API changes (from Hackage documentation)
- Combinatorics.CardPairs: instance GHC.Arr.Ix i => GHC.Arr.Ix (Combinatorics.CardPairs.CardCount i)
- Combinatorics.CardPairs: testCardsBorderDynamic :: (CardCount Integer, CardCount Integer, CardCount Integer)
- Combinatorics.Partitions: propNumPartitions :: Int -> Bool
- Combinatorics.Partitions: propPartitions :: Int -> Int -> Bool
+ Combinatorics: pairPartitions :: [a] -> [[(a, a)]]
+ Combinatorics.CardPairs: instance GHC.Ix.Ix i => GHC.Ix.Ix (Combinatorics.CardPairs.CardCount i)
+ Combinatorics.Mastermind: numberDistinctWhite :: Int -> Int -> Int -> Integer
- Combinatorics: binomialSeqGen :: (Fractional b) => b -> [b]
+ Combinatorics: binomialSeqGen :: Fractional b => b -> [b]
- Combinatorics.Mastermind: evaluate :: (Ord a) => [a] -> [a] -> Eval
+ Combinatorics.Mastermind: evaluate :: Ord a => [a] -> [a] -> Eval
- Combinatorics.Mastermind: evaluateAll :: (Ord a) => [[a]] -> [a] -> Map Eval Int
+ Combinatorics.Mastermind: evaluateAll :: Ord a => [[a]] -> [a] -> Map Eval Int
- Combinatorics.Partitions: partitionsDec :: (Integral a) => a -> a -> [[a]]
+ Combinatorics.Partitions: partitionsDec :: Integral a => a -> a -> [[a]]
- Combinatorics.Partitions: partitionsInc :: (Integral a) => a -> a -> [[a]]
+ Combinatorics.Partitions: partitionsInc :: Integral a => a -> a -> [[a]]
- Combinatorics.Permutation.WithoutSomeFixpoints: enumerate :: (Eq a) => Int -> [a] -> [[a]]
+ Combinatorics.Permutation.WithoutSomeFixpoints: enumerate :: Eq a => Int -> [a] -> [[a]]
- Combinatorics.Permutation.WithoutSomeFixpoints: numbers :: (Num a) => [[a]]
+ Combinatorics.Permutation.WithoutSomeFixpoints: numbers :: Num a => [[a]]
Files
- Makefile +8/−0
- combinatorial.cabal +18/−6
- src/Combinatorics.hs +159/−9
- src/Combinatorics/BellNumbers.hs +13/−2
- src/Combinatorics/CardPairs.hs +20/−9
- src/Combinatorics/Mastermind.hs +25/−6
- src/Combinatorics/Partitions.hs +27/−14
- src/Combinatorics/Permutation/WithoutSomeFixpoints.hs +21/−1
- src/Combinatorics/Private.hs +51/−0
- test-module.list +7/−0
- test/Test.hs +18/−414
- test/Test/Combinatorics.hs +276/−0
- test/Test/Combinatorics/BellNumbers.hs +18/−0
- test/Test/Combinatorics/CardPairs.hs +33/−0
- test/Test/Combinatorics/Mastermind.hs +41/−0
- test/Test/Combinatorics/Partitions.hs +45/−0
- test/Test/Combinatorics/Permutation/WithoutSomeFixpoints.hs +37/−0
- test/Test/Combinatorics/Private.hs +75/−0
- test/Test/Utility.hs +13/−0
+ Makefile view
@@ -0,0 +1,8 @@+run-test: update-test+ runhaskell Setup configure --user --enable-test+ runhaskell Setup build+ runhaskell Setup haddock+ runhaskell Setup test --show-details=streaming++update-test:+ doctest-extract-0.1 -i src/ -o test/ --module-prefix Test --executable-main=Test.hs $$(cat test-module.list)
combinatorial.cabal view
@@ -1,10 +1,10 @@ Name: combinatorial-Version: 0.1.0.1+Version: 0.1.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de> Maintainer: Henning Thielemann <haskell@henning-thielemann.de>-Homepage: http://hub.darcs.net/thielema/combinatorial/+Homepage: https://hub.darcs.net/thielema/combinatorial/ Category: Math, Statistics Synopsis: Count, enumerate, rank and unrank combinatorial objects Description:@@ -28,21 +28,23 @@ Build-Type: Simple Extra-Source-Files: Changes.md+ Makefile+ test-module.list Source-Repository this- Tag: 0.1.0.1+ Tag: 0.1.1 Type: darcs- Location: http://hub.darcs.net/thielema/combinatorial/+ Location: https://hub.darcs.net/thielema/combinatorial/ Source-Repository head Type: darcs- Location: http://hub.darcs.net/thielema/combinatorial/+ Location: https://hub.darcs.net/thielema/combinatorial/ Library Build-Depends: containers >=0.4.2 && <0.7, array >=0.4 && <0.6,- transformers >=0.3 && <0.6,+ transformers >=0.3 && <0.7, utility-ht >=0.0.8 && <0.1, base >=4.5 && <5 @@ -69,6 +71,8 @@ Test-Suite combinatorial-test Type: exitcode-stdio-1.0 Build-Depends:+ doctest-exitcode-stdio >=0.0 && <0.1,+ doctest-lib >=0.1 && <0.2, QuickCheck >=2.5 && <3.0, containers, array,@@ -77,6 +81,14 @@ base Main-Is: Test.hs Other-Modules:+ Test.Combinatorics+ Test.Combinatorics.Private+ Test.Combinatorics.BellNumbers+ Test.Combinatorics.CardPairs+ Test.Combinatorics.Mastermind+ Test.Combinatorics.Partitions+ Test.Combinatorics.Permutation.WithoutSomeFixpoints+ Test.Utility Combinatorics Combinatorics.BellNumbers Combinatorics.CardPairs
src/Combinatorics.hs view
@@ -14,6 +14,7 @@ partitions, rectifications, setPartitions,+ pairPartitions, chooseUnrank, chooseUnrankMaybe, chooseRank,@@ -49,6 +50,44 @@ import Control.Monad (liftM2, ) +{- $setup+>>> import qualified Combinatorics as Comb+>>> import qualified Test.QuickCheck as QC+>>> import Test.Utility (equalFuncList, equalFuncList2)+>>>+>>> import Control.Applicative (liftA2, (<$>))+>>> import qualified Data.List.Match as Match+>>> import qualified Data.List.Key as Key+>>> import qualified Data.List as List+>>> import qualified Data.Set as Set+>>> import Data.Tuple.HT (uncurry3)+>>> import Data.List.HT (allEqual, isAscending)+>>> import Data.List (sort, nub)+>>> import Data.Eq.HT (equating)+>>>+>>> genPermuteRep :: Int -> QC.Gen [(Char, Int)]+>>> genPermuteRep n = do+>>> xns <- QC.listOf $ liftA2 (,) QC.arbitrary $ QC.choose (0,n)+>>> return $ Match.take (takeWhile (<=n) $ scanl1 (+) $ map snd xns) xns+>>>+>>> genVariate :: QC.Gen [Char]+>>> genVariate = take 7 <$> QC.arbitrary+>>>+>>> genBinomial :: QC.Gen (Integer, Integer)+>>> genBinomial = do+>>> n <- QC.choose (0,100)+>>> k <- QC.choose (0,n)+>>> return (n,k)+>>>+>>> genChooseIndex :: QC.Gen (Integer, Integer, Integer)+>>> genChooseIndex = do+>>> n <- QC.choose (0,25)+>>> k <- QC.choose (0,n)+>>> i <- QC.choose (0, Comb.binomial n k - 1)+>>> return (n,k,i)+-}++ {-* Generate compositions from a list of elements. -} -- several functions for permutation@@ -57,6 +96,13 @@ {- | Generate list of all permutations of the input list. The list is sorted lexicographically.++>>> Comb.permute "abc"+["abc","acb","bac","bca","cab","cba"]+>>> Comb.permute "aabc"+["aabc","aacb","abac","abca","acab","acba","aabc","aacb","abac","abca","acab","acba","baac","baca","baac","baca","bcaa","bcaa","caab","caba","caab","caba","cbaa","cbaa"]++prop> QC.forAll (take 6 <$> QC.arbitrary :: QC.Gen [Int]) $ \xs -> allEqual $ map (\p -> sort (p xs)) $ Comb.permute : Comb.permuteFast : Comb.permuteShare : [] -} permute :: [a] -> [[a]] permute = Comb.permuteRec@@ -96,10 +142,27 @@ (removeEach todo) +{- |+>>> Comb.permuteRep [('a',2), ('b',1), ('c',1)]+["aabc","aacb","abac","abca","acab","acba","baac","baca","bcaa","caab","caba","cbaa"]++prop> QC.forAll (genPermuteRep 7) $ \xs -> let perms = Comb.permuteRep $ Key.nub fst xs in perms == nub perms+prop> QC.forAll (genPermuteRep 10) $ \xs -> let perms = Comb.permuteRep $ Key.nub fst xs in List.sort perms == Set.toList (Set.fromList perms)+prop> QC.forAll (genPermuteRep 10) $ isAscending . Comb.permuteRep . Key.nub fst . sort+prop> QC.forAll (QC.choose (0,10)) $ \n k -> Comb.choose n k == Comb.permuteRep [(False, n-k), (True, k)]+-} permuteRep :: [(a,Int)] -> [[a]] permuteRep = Comb.permuteRep +{- |+>>> map (map (\b -> if b then 'x' else '.')) $ Comb.choose 5 3+["..xxx",".x.xx",".xx.x",".xxx.","x..xx","x.x.x","x.xx.","xx..x","xx.x.","xxx.."]+>>> map (map (\b -> if b then 'x' else '.')) $ Comb.choose 3 5+[]++prop> QC.forAll (QC.choose (0,10)) $ \n k -> all (\x -> n == length x && k == length (filter id x)) (Comb.choose n k)+-} choose :: Int -> Int -> [[Bool]] choose = Comb.chooseRec @@ -108,6 +171,9 @@ Generate all choices of n elements out of the list x with repetitions. \"variation\" seems to be used historically, but I like it more than \"k-permutation\".++>>> Comb.variateRep 2 "abc"+["aa","ab","ac","ba","bb","bc","ca","cb","cc"] -} variateRep :: Int -> [a] -> [[a]] variateRep = Comb.variateRep@@ -115,8 +181,16 @@ {- | Generate all choices of n elements out of the list x without repetitions.-It holds- @ variate (length xs) xs == permute xs @++>>> Comb.variate 2 "abc"+["ab","ac","ba","bc","ca","cb"]+>>> Comb.variate 2 "abcd"+["ab","ac","ad","ba","bc","bd","ca","cb","cd","da","db","dc"]+>>> Comb.variate 3 "abcd"+["abc","abd","acb","acd","adb","adc","bac","bad","bca","bcd","bda","bdc","cab","cad","cba","cbd","cda","cdb","dab","dac","dba","dbc","dca","dcb"]++prop> QC.forAll genVariate $ \xs -> Comb.variate (length xs) xs == Comb.permute xs+prop> \xs -> equating (take 1000) (Comb.variate (length xs) xs) (Comb.permute (xs::String)) -} variate :: Int -> [a] -> [[a]] variate = Comb.variateRec@@ -125,11 +199,24 @@ {- | Generate all choices of n elements out of the list x respecting the order in x and without repetitions.++>>> Comb.tuples 2 "abc"+["ab","ac","bc"]+>>> Comb.tuples 2 "abcd"+["ab","ac","ad","bc","bd","cd"]+>>> Comb.tuples 3 "abcd"+["abc","abd","acd","bcd"] -} tuples :: Int -> [a] -> [[a]] tuples = Comb.tuplesRec +{- |+>>> Comb.partitions "abc"+[("abc",""),("bc","a"),("ac","b"),("c","ab"),("ab","c"),("b","ac"),("a","bc"),("","abc")]++prop> QC.forAll genVariate $ \xs -> length (Comb.partitions xs) == 2 ^ length xs+-} partitions :: [a] -> [([a],[a])] partitions = foldr@@ -145,8 +232,12 @@ into @k@ non-empty subsets. <http://oeis.org/A048993> -> *Combinatorics> map (length . uncurry rectifications) $ do x<-[0..10]; y<-[0..x]; return (x,[1..y::Int])-> [1,0,1,0,1,1,0,1,3,1,0,1,7,6,1,0,1,15,25,10,1,0,1,31,90,65,15,1,0,1,63,301,350,140,21,1,0,1,127,966,1701,1050,266,28,1,0,1,255,3025,7770,6951,2646,462,36,1,0,1,511,9330,34105,42525,22827,5880,750,45,1]+>>> Comb.rectifications 4 "abc"+["aabc","abac","abbc","abca","abcb","abcc"]+>>> map (length . uncurry Comb.rectifications) $ do x<-[0..10]; y<-[0..x]; return (x,[1..y::Int])+[1,0,1,0,1,1,0,1,3,1,0,1,7,6,1,0,1,15,25,10,1,0,1,31,90,65,15,1,0,1,63,301,350,140,21,1,0,1,127,966,1701,1050,266,28,1,0,1,255,3025,7770,6951,2646,462,36,1,0,1,511,9330,34105,42525,22827,5880,750,45,1]++prop> QC.forAll (QC.choose (0,7)) $ \k xs -> isAscending . Comb.rectifications k . nub . sort $ (xs::String) -} rectifications :: Int -> [a] -> [[a]] rectifications =@@ -180,6 +271,7 @@ in recourse -} +-- TestMe: isAscending . Comb.setPartitions k . nub . sort setPartitions :: Int -> [a] -> [[[a]]] setPartitions 0 xs = if null xs@@ -193,10 +285,37 @@ return ((x:choosen) : part) +{- |+All ways of separating a list of terms into pairs.+All partitions are given in a canonical form,+sorted lexicographically.+The canonical form is:+The list of pairs is ordered with respect to the first pair members,+and the elements in each pair are ordered.+The order is implied by the order in the input list.++<http://oeis.org/A123023>+-}+pairPartitions :: [a] -> [[(a,a)]]+pairPartitions xs =+ if odd (length xs)+ then []+ else+ let go (y:ys) = do+ (z,zs) <- removeEach ys+ fmap ((y,z):) $ go zs+ go [] = [[]]+ in go xs++ {-* Rank and unrank combinatorial objects. -} {- | @chooseUnrank n k i == choose n k !! i@++prop> QC.forAll (QC.choose (0,10)) $ \n k -> map (Comb.chooseUnrank n k) [0 .. Comb.binomial n k - 1] == Comb.choose n k+prop> QC.forAll genChooseIndex $ \(n,k,i) -> Comb.chooseRank (Comb.chooseUnrank n k i) == (n, k, i)+prop> \bs -> uncurry3 Comb.chooseUnrank (Comb.chooseRank bs :: (Integer, Integer, Integer)) == bs -} chooseUnrank :: Integral a => a -> a -> a -> [Bool] chooseUnrank = Comb.chooseUnrankRec@@ -225,10 +344,21 @@ {-* Generate complete lists of combinatorial numbers. -} ++{- |+prop> QC.forAll (take 8 <$> QC.arbitrary) $ \xs -> length (Comb.permute xs) == Comb.factorial (length (xs::String))+prop> QC.forAll (take 6 <$> QC.arbitrary) $ \xs -> sum (map sum (Comb.permute xs)) == sum xs * Comb.factorial (length xs)+-} factorial :: Integral a => a -> a factorial n = product [1..n] -{-| Pascal's triangle containing the binomial coefficients. -}+{- |+Pascal's triangle containing the binomial coefficients.++prop> QC.forAll (QC.choose (0,12)) $ \n k -> length (Comb.choose n k) == Comb.binomial n k+prop> QC.forAll genBinomial $ \(n,k) -> let (q, r) = divMod (Comb.factorial n) (Comb.factorial k * Comb.factorial (n-k)) in r == 0 && Comb.binomial n k == q+prop> QC.forAll (take 16 <$> QC.arbitrary) $ \xs k -> length (Comb.tuples k xs) == Comb.binomial (length (xs::String)) k+-} binomial :: Integral a => a -> a -> a binomial = Comb.binomial @@ -245,6 +375,10 @@ (zip (iterate (subtract 1) n) (iterate (1+) 1)) +{- |+prop> QC.forAll (genPermuteRep 10) $ \xs -> length (Comb.permuteRep xs) == Comb.multinomial (map snd xs)+prop> QC.forAll (QC.listOf $ QC.choose (0,300::Integer)) $ \xs -> Comb.multinomial xs == Comb.multinomial (sort xs)+-} multinomial :: Integral a => [a] -> a multinomial = product . mapAdjacent binomial . scanr1 (+)@@ -252,6 +386,9 @@ {-* Generate complete lists of factorial numbers. -} +{- |+prop> equalFuncList Comb.factorial Comb.factorials 1000+-} factorials :: Num a => [a] factorials = Comb.factorials @@ -260,6 +397,8 @@ Only efficient if a prefix of all rows is required. It is not efficient for picking particular rows or even particular elements.++prop> equalFuncList2 Comb.binomial Comb.binomials 100 -} binomials :: Num a => [[a]] binomials = Comb.binomials@@ -270,14 +409,15 @@ -} catalanNumber :: Integer -> Integer catalanNumber n =- let (c,r) = divMod (binomial (2*n) n) (n+1)- in if r==0- then c- else error "catalanNumber: Integer implementation broken"+ case divMod (binomial (2*n) n) (n+1) of+ (c,0) -> c+ _ -> error "catalanNumber: Integer implementation broken" {- | Compute the sequence of Catalan numbers by recurrence identity. It is @catalanNumbers !! n == catalanNumber n@++prop> equalFuncList Comb.catalanNumber Comb.catalanNumbers 1000 -} catalanNumbers :: Num a => [a] catalanNumbers =@@ -294,6 +434,8 @@ Number of fix-point-free permutations with @n@ elements. <http://oeis.org/A000166>++prop> equalFuncList Comb.derangementNumber Comb.derangementNumbers 1000 -} derangementNumbers :: Num a => [a] derangementNumbers = Comb.derangementNumbersPS0@@ -304,6 +446,9 @@ {- | Number of partitions of an @n@ element set into @k@ non-empty subsets. Known as Stirling numbers <http://oeis.org/A048993>.++prop> QC.forAll (QC.choose (0,10000)) $ \k -> QC.forAll (take 7 <$> QC.arbitrary) $ \xs -> length (Comb.setPartitions k xs) == (Comb.setPartitionNumbers !! length (xs::String) ++ repeat 0) !! k+prop> QC.forAll (QC.choose (0,7)) $ \k xs -> length (Comb.rectifications k xs) == (Comb.setPartitionNumbers !! k ++ repeat 0) !! length (xs::String) -} setPartitionNumbers :: Num a => [[a]] setPartitionNumbers = Comb.setPartitionNumbers@@ -322,6 +467,9 @@ (map (^n) [0..]) (binomialSeq k) +{- |+prop> equalFuncList2 Comb.surjectiveMappingNumber Comb.surjectiveMappingNumbers 20+-} surjectiveMappingNumbers :: Num a => [[a]] surjectiveMappingNumbers = Comb.surjectiveMappingNumbersPS @@ -373,6 +521,8 @@ > ||| |-- --| > ||| |-- --|++prop> equalFuncList Comb.fibonacciNumber Comb.fibonacciNumbers 10000 -} fibonacciNumbers :: [Integer] fibonacciNumbers =
src/Combinatorics/BellNumbers.hs view
@@ -5,12 +5,23 @@ import qualified PowerSeries -{- List of Bell numbers computed with the recursive formula given in- Wurzel 2004-06, page 136 -}+{- $setup+>>> import qualified Combinatorics.BellNumbers as Bell+>>> import Test.Utility (equalFuncList)+-}+++{- |+List of Bell numbers computed with the recursive formula+given in Wurzel 2004-06, page 136+-} bellRec :: Num a => [a] bellRec = 1 : map (scalarProduct bellRec) binomials +{- |+prop> equalFuncList (\k -> round (Bell.bellSeries (fromInteger k) :: Double)) (Bell.bellRec :: [Integer]) 20+-} bellSeries :: (Floating a, Enum a) => Int -> a bellSeries n = scalarProduct
src/Combinatorics/CardPairs.hs view
@@ -1,4 +1,4 @@-{-+{- | Compute how often it happens that a Queen and a King are adjacent in a randomly ordered card set. -}@@ -18,7 +18,6 @@ cardSetSizeRummy, numberOfPossibilitiesRummy, probabilityRummy, cardSetSizeRummyJK, numberOfPossibilitiesRummyJK, probabilityRummyJK, -- * tests- testCardsBorderDynamic, exampleOutput, adjacentCouplesSmall, allPossibilitiesSmall,@@ -38,6 +37,22 @@ import Data.Ratio ((%), ) +{- $setup+>>> import qualified Combinatorics.CardPairs as CardPairs+>>> import Combinatorics.CardPairs (CardCount(CardCount))+>>>+>>> import qualified Test.QuickCheck as QC+>>> import Control.Applicative (liftA3)+>>> import Data.List.HT (allEqual)+>>> import Data.Array ((!))+>>>+>>> genCardCount :: QC.Gen (CardPairs.CardCount Int)+>>> genCardCount =+>>> liftA3 CardPairs.CardCount+>>> (QC.choose (0,5)) (QC.choose (0,5)) (QC.choose (0,5))+-}++ type CardSet a = [(a, Int)] data Card = Other | Queen | King@@ -165,6 +180,9 @@ (card set starts with an ordinary card ' ', start with queen 'q', start with king 'k')++prop> allEqual [CardPairs.possibilitiesCardsBorderNaive (CardCount 2 3 5), CardPairs.possibilitiesCardsBorderDynamic (CardCount 5 5 5) ! (CardCount 2 3 5), CardPairs.possibilitiesCardsBorder2Dynamic (CardCount 5 5 5) ! (CardCount 2 3 5)]+prop> QC.forAll genCardCount $ \cc -> allEqual [CardPairs.possibilitiesCardsBorderNaive cc, CardPairs.possibilitiesCardsBorderDynamic cc ! cc, CardPairs.possibilitiesCardsBorder2Dynamic cc ! cc] -} possibilitiesCardsBorderNaive :: CardCount Int -> CardCount Integer@@ -289,13 +307,6 @@ |n_{2,0}| = |n_{1,0}| \n_{2,1}/ \n_{1,1}/ -}--testCardsBorderDynamic ::- (CardCount Integer, CardCount Integer, CardCount Integer)-testCardsBorderDynamic =- (possibilitiesCardsBorderNaive (CardCount 2 3 5),- possibilitiesCardsBorderDynamic (CardCount 5 5 5) ! (CardCount 2 3 5),- possibilitiesCardsBorder2Dynamic (CardCount 5 5 5) ! (CardCount 2 3 5)) numberOfAllPossibilities :: CardCount Int -> Integer
src/Combinatorics/Mastermind.hs view
@@ -4,6 +4,8 @@ evaluateAll, formatEvalHistogram, numberDistinct,+ -- * only for testing+ numberDistinctWhite, ) where import qualified Combinatorics.Permutation.WithoutSomeFixpoints as PermWOFP@@ -17,6 +19,23 @@ import Data.Tuple.HT (mapPair) +{- $setup+>>> import qualified Combinatorics.Mastermind as Mastermind+>>> import qualified Combinatorics as Comb+>>> import qualified Test.QuickCheck as QC+>>> import Control.Monad (replicateM)+>>> import Data.List (genericLength)+>>>+>>> genMastermindDistinct :: QC.Gen (Int, Int, Int, Int)+>>> genMastermindDistinct = do+>>> n <- QC.choose (0,12)+>>> k <- QC.choose (0, min 5 n)+>>> b <- QC.choose (0,k)+>>> w <- QC.choose (0,k-b)+>>> return (n,k,b,w)+-}++ {- | Cf. @board-games@ package. -}@@ -25,6 +44,9 @@ {- | Given the code and a guess, compute the evaluation.++>>> filter ((Mastermind.Eval 2 0 ==) . Mastermind.evaluate "aabbb") $ replicateM 5 ['a'..'c']+["aaaaa","aaaac","aaaca","aaacc","aacaa","aacac","aacca","aaccc","acbcc","accbc","acccb","cabcc","cacbc","caccb","ccbbc","ccbcb","cccbb"] -} evaluate :: (Ord a) => [a] -> [a] -> Eval evaluate code attempt =@@ -36,11 +58,6 @@ ListHT.partition (uncurry (==)) $ zip code attempt -{--*Combinatorics.Mastermind> filter ((Eval 2 0 ==) . evaluate "aabbb") $ replicateM 5 ['a'..'c']-["aaaaa","aaaac","aaaca","aaacc","aacaa","aacac","aacca","aaccc","acbcc","accbc","acccb","cabcc","cacbc","caccb","ccbbc","ccbcb","cccbb"]--}- evaluateAll :: (Ord a) => [[a]] -> [a] -> Map Eval Int evaluateAll codes attempt = histogram $ map (evaluate attempt) codes @@ -65,6 +82,8 @@ @n@ is the alphabet size, @k@ the width of the code, @b@ the number of black evaluation sticks and @w@ the number of white evaluation sticks.++prop> QC.forAll genMastermindDistinct $ \(n,k,b,w) -> let alphabet = take n ['a'..]; code = take k alphabet in Mastermind.numberDistinct n k b w == (genericLength $ filter ((Mastermind.Eval b w ==) . Mastermind.evaluate code) $ Comb.variate k alphabet) -} numberDistinct :: Int -> Int -> Int -> Int -> Integer numberDistinct n k b w =@@ -73,7 +92,7 @@ numberDistinctWhite (n-b) (k-b) w {- |-@numberDistinctWhite n k w == numberDistinct n k 0 w@+prop> QC.forAll genMastermindDistinct $ \(n,k,_b,w) -> Mastermind.numberDistinctWhite n k w == Mastermind.numberDistinct n k 0 w -} numberDistinctWhite :: Int -> Int -> Int -> Integer numberDistinctWhite n k w =
src/Combinatorics/Partitions.hs view
@@ -9,14 +9,20 @@ propPentagonalPowerSeries, propPentagonalsDifP, propPentagonalsDifN,- propPartitions,- propNumPartitions, ) where -import qualified Data.List as List import qualified PowerSeries as PS import Data.Eq.HT (equating) ++{- $setup+>>> import qualified Combinatorics.Partitions as Parts+>>> import qualified Test.QuickCheck as QC+>>> import Data.List (genericLength)+>>> import Data.Eq.HT (equating)+-}++ {- a(n) denotes the number in how many ways n can be presented as a sum of positive integers:@@ -49,6 +55,9 @@ (scanl (\prod i -> delayedSub prod i prod) [1] [1..]) [0..] +{- |+prop> QC.forAll (QC.choose (0,100)) Parts.propInfProdLinearFactors+-} propInfProdLinearFactors :: Int -> Bool propInfProdLinearFactors n = and $@@ -71,11 +80,17 @@ pentagonalsDifP = map (\n -> 3*n+1) [0..] pentagonalsDifN = map (\n -> 3*n+2) [0..] +{- |+prop> Parts.propPentagonalsDifP 10000+-} propPentagonalsDifP :: Int -> Bool propPentagonalsDifP n = equating (take n) pentagonalsDifP (zipWith (-) (tail pentagonalsP) pentagonalsP) +{- |+prop> Parts.propPentagonalsDifN 10000+-} propPentagonalsDifN :: Int -> Bool propPentagonalsDifN n = equating (take n)@@ -118,6 +133,9 @@ (make pentagonalsDifP) (make pentagonalsDifN) +{- |+prop> Parts.propPentagonalPowerSeries 1000+-} propPentagonalPowerSeries :: Int -> Bool propPentagonalPowerSeries n = equating (take n) infProdLinearFactors pentagonalPowerSeries@@ -146,8 +164,12 @@ else concatMap (\y -> map (y:) (_partitionsInc y (n-y))) [k..(n-1)] ++ [[n]] -{- | it shall be k>0 && n>=0 ==> partitionsInc k n == allPartitionsInc !! k !! n- type Int is needed because of list node indexing -}+{- |+type Int is needed because of list node indexing++prop> QC.forAll (QC.choose (1,10)) $ \k -> QC.forAll (QC.choose (0,50)) $ \n -> Parts.partitionsInc k n == Parts.allPartitionsInc !! k !! n+prop> equating (take 30) (map genericLength (Parts.allPartitionsInc !! 1)) Parts.numPartitions+-} allPartitionsInc :: [[[[Int]]]] allPartitionsInc = let part :: Int -> Int -> [[Int]]@@ -156,12 +178,3 @@ ++ [[n]] xs = repeat [[]] : map (\k -> map (part k) [0..]) [1..] in xs--propPartitions :: Int -> Int -> Bool-propPartitions k n =- partitionsInc k n == allPartitionsInc !! k !! n--propNumPartitions :: Int -> Bool-propNumPartitions n =- equating (take n)- (map List.genericLength (allPartitionsInc !! 1)) numPartitions
src/Combinatorics/Permutation/WithoutSomeFixpoints.hs view
@@ -2,6 +2,21 @@ import Combinatorics (permute) +{- $setup+>>> import qualified Combinatorics.Permutation.WithoutSomeFixpoints as PermWOFP+>>> import qualified Combinatorics as Comb+>>> import qualified Test.QuickCheck as QC+>>> import Control.Applicative ((<$>))+>>> import Data.List (nub)+>>>+>>> genPermutationWOFP :: QC.Gen (Int, String)+>>> genPermutationWOFP = do+>>> xs <- take 6 . nub <$> QC.arbitrary+>>> k <- QC.choose (0, length xs)+>>> return (k,xs)+-}++ {- | @enumerate n xs@ list all permutations of @xs@ where the first @n@ elements do not keep their position@@ -14,7 +29,12 @@ enumerate :: (Eq a) => Int -> [a] -> [[a]] enumerate k xs = filter (and . zipWith (/=) xs . take k) $ permute xs -{- | <http://oeis.org/A047920> -}+{- | <http://oeis.org/A047920>++prop> QC.forAll genPermutationWOFP $ \(k,xs) -> PermWOFP.numbers !! length xs !! k == length (PermWOFP.enumerate k xs)+prop> QC.forAll (QC.choose (0,100)) $ \k -> Comb.factorial (toInteger k) == PermWOFP.numbers !! k !! 0+prop> QC.forAll (QC.choose (0,100)) $ \k -> Comb.derangementNumber (toInteger k) == PermWOFP.numbers !! k !! k+-} numbers :: (Num a) => [[a]] numbers = tail $ scanl (\row fac -> scanl (-) fac row) [] $
src/Combinatorics/Private.hs view
@@ -15,10 +15,36 @@ import Control.Monad (MonadPlus, liftM, forM, guard, ) +{- $setup+>>> import qualified Combinatorics.Private as CombPriv+>>> import Test.Combinatorics (genPermuteRep, genVariate, genChooseIndex)+>>>+>>> import qualified Test.QuickCheck as QC+>>> import Control.Applicative ((<$>))+>>> import Data.List.HT (allEqual)+>>> import Data.Eq.HT (equating)+>>>+>>> genChoose :: QC.Gen (Int, Int)+>>> genChoose = do+>>> n <- QC.choose (0,15)+>>> k <- QC.choose (-2,n)+>>> return (n,k)+>>>+>>> genTuples :: QC.Gen (Int, [Char])+>>> genTuples = do+>>> xs <- take 16 <$> QC.arbitrary+>>> n <- QC.choose (-1, length xs + 1)+>>> return (n,xs)+-}++ replicateM :: (MonadPlus m) => Int -> m a -> m [a] replicateM n m = guard (n>=0) >> Monad.replicate n m +{- |+prop> QC.forAll (take 6 <$> QC.arbitrary) $ \xs -> CombPriv.permuteRec xs == CombPriv.permuteMSL (xs::[Int])+-} permuteRec :: [a] -> [[a]] permuteRec = let go [] = [[]]@@ -37,6 +63,9 @@ then [] else f ps +{- |+prop> QC.forAll (genPermuteRep 10) $ \xs -> CombPriv.permuteRep xs == CombPriv.permuteRepM xs+-} permuteRep :: [(a,Int)] -> [[a]] permuteRep = let go [] = [[]]@@ -65,6 +94,9 @@ (False,_) ?: xs = xs +{- |+prop> QC.forAll genChoose $ \(n,k) -> allEqual $ CombPriv.chooseRec n k : CombPriv.chooseMSL n k : CombPriv.chooseMSL0 n k : []+-} chooseRec :: Int -> Int -> [[Bool]] chooseRec = let go n k =@@ -96,6 +128,9 @@ return count +{- |+prop> QC.forAll (QC.choose (-1,7)) $ \n -> QC.forAll genVariate $ \xs -> CombPriv.variateRep n xs == CombPriv.variateRepM n xs+-} variateRep :: Int -> [a] -> [[a]] variateRep n x = if n<0 then [] else nest n (\y -> concatMap (\z -> map (z:) y) x) [[]]@@ -104,6 +139,9 @@ variateRepM = replicateM +{- |+prop> QC.forAll (QC.choose (-1,7)) $ \n -> QC.forAll genVariate $ \xs -> CombPriv.variateRec n xs == CombPriv.variateMSL n xs+-} variateRec :: Int -> [a] -> [[a]] variateRec = let go n =@@ -117,6 +155,10 @@ variateMSL n = MS.evalStateT $ replicateM n $ MS.StateT removeEach ++{- |+prop> QC.forAll genTuples $ \(n,xs) -> allEqual $ CombPriv.tuplesRec n xs : CombPriv.tuplesRec0 n xs : CombPriv.tuplesMSL n xs : CombPriv.tuplesMSL0 n xs : []+-} tuplesRec :: Int -> [a] -> [[a]] tuplesRec = let go r =@@ -153,6 +195,9 @@ return y +{- |+prop> QC.forAll genChooseIndex $ \(n,k,i) -> CombPriv.chooseUnrankRec n k i == CombPriv.chooseUnrankList n k i+-} chooseUnrankRec :: Integral a => a -> a -> a -> [Bool] chooseUnrankRec = let go n 0 _ = genericReplicate n False@@ -215,6 +260,9 @@ in iterate conv11 [1] +{- |+prop> allEqual $ map (take 1000) (CombPriv.derangementNumbersPS0 : CombPriv.derangementNumbersPS1 : CombPriv.derangementNumbersInclExcl : [] :: [[Integer]])+-} derangementNumbersPS0 :: Num a => [a] derangementNumbersPS0 = -- OEIS-A166: a(n) = n·a(n-1)+(-1)^n@@ -243,6 +291,9 @@ iterate (\x -> 0 : PowerSeries.add x (PowerSeries.differentiate x)) [1] +{- |+prop> equating (take 20) CombPriv.surjectiveMappingNumbersPS (CombPriv.surjectiveMappingNumbersStirling :: [[Integer]])+-} surjectiveMappingNumbersPS :: Num a => [[a]] surjectiveMappingNumbersPS = iterate
+ test-module.list view
@@ -0,0 +1,7 @@+Combinatorics+Combinatorics.Private+Combinatorics.BellNumbers+Combinatorics.CardPairs+Combinatorics.Mastermind+Combinatorics.Partitions+Combinatorics.Permutation.WithoutSomeFixpoints
test/Test.hs view
@@ -1,418 +1,22 @@-module Main (main) where--import qualified Combinatorics.Permutation.WithoutSomeFixpoints as PermWOFP-import qualified Combinatorics.Mastermind as Mastermind-import qualified Combinatorics.CardPairs as CardPairs-import qualified Combinatorics.Partitions as Parts-import qualified Combinatorics.BellNumbers as Bell-import qualified Combinatorics.Private as CombPriv-import qualified Combinatorics as Comb--import qualified Test.QuickCheck as QC-import Test.QuickCheck (Testable, quickCheck, )--import Control.Monad (liftM2, liftM3, )-import Control.Applicative ((<$>), )--import qualified Data.List.Match as Match-import qualified Data.List.Key as Key-import qualified Data.List as List-import qualified Data.Set as Set-import Data.Array ((!), )-import Data.Tuple.HT (uncurry3, )-import Data.List.HT (allEqual, isAscending, )-import Data.List (sort, nub, )-import Data.Eq.HT (equating, )----permuteSum :: [Int] -> Bool-permuteSum xs =- sum (map sum (Comb.permute xs)) ==- sum xs * Comb.factorial (length xs)--permute :: Ord a => [a] -> Bool-permute xs =- allEqual $- map (\p -> sort (p xs)) $- Comb.permute :- Comb.permuteFast :- Comb.permuteShare :- []--permuteAlt :: Eq a => [a] -> Bool-permuteAlt xs = CombPriv.permuteRec xs == CombPriv.permuteMSL xs---genPermuteRep :: Int -> QC.Gen [(Char, Int)]-genPermuteRep n = do- xns <- QC.listOf $ liftM2 (,) QC.arbitrary $ QC.choose (0,n)- return $ Match.take (takeWhile (<=n) $ scanl1 (+) $ map snd xns) xns--permuteRepM :: Eq a => [(a, Int)] -> Bool-permuteRepM xs = CombPriv.permuteRep xs == CombPriv.permuteRepM xs--permuteRepNub :: Eq a => [(a, Int)] -> Bool-permuteRepNub xs =- let perms = Comb.permuteRep $ Key.nub fst xs- in perms == nub perms--permuteRepNubBig :: Ord a => [(a, Int)] -> Bool-permuteRepNubBig xs =- let perms = Comb.permuteRep $ Key.nub fst xs- in List.sort perms == Set.toList (Set.fromList perms)--permuteRepMonotony :: Ord a => [(a, Int)] -> Bool-permuteRepMonotony = isAscending . Comb.permuteRep . Key.nub fst . sort--permuteRepChoose :: Int -> Int -> Bool-permuteRepChoose n k =- Comb.choose n k == Comb.permuteRep [(False, n-k), (True, k)]--chooseLength :: Int -> Int -> Bool-chooseLength n k =- all- (\x -> n == length x && k == length (filter id x))- (Comb.choose n k)---genChoose :: QC.Gen (Int, Int)-genChoose = do- n <- QC.choose (0,15)- k <- QC.choose (-2,n)- return (n,k)--choose :: Int -> Int -> Bool-choose n k =- allEqual $- CombPriv.chooseRec n k :- CombPriv.chooseMSL n k :- CombPriv.chooseMSL0 n k :- []--genChooseIndex :: QC.Gen (Integer, Integer, Integer)-genChooseIndex = do- n <- QC.choose (0,25)- k <- QC.choose (0,n)- i <- QC.choose (0, Comb.binomial n k - 1)- return (n,k,i)--chooseUnrank :: Integer -> Integer -> Integer -> Bool-chooseUnrank n k i =- CombPriv.chooseUnrankRec n k i == CombPriv.chooseUnrankList n k i--chooseUnrankSequence :: Int -> Int -> Bool-chooseUnrankSequence n k =- map (Comb.chooseUnrank n k) [0 .. Comb.binomial n k - 1]- == Comb.choose n k--chooseRankUnrank :: Integer -> Integer -> Integer -> Bool-chooseRankUnrank n k i =- Comb.chooseRank (Comb.chooseUnrank n k i) == (n, k, i)--chooseUnrankRank :: [Bool] -> Bool-chooseUnrankRank bs =- uncurry3 Comb.chooseUnrank- (Comb.chooseRank bs :: (Integer, Integer, Integer))- == bs----genVariate :: QC.Gen [Char]-genVariate = take 7 <$> QC.arbitrary--variate :: Eq a => Int -> [a] -> Bool-variate n xs =- CombPriv.variateRec n xs == CombPriv.variateMSL n xs--variateRep :: Eq a => Int -> [a] -> Bool-variateRep n xs =- CombPriv.variateRep n xs == CombPriv.variateRepM n xs--variatePermute :: Eq a => [a] -> Bool-variatePermute xs =- Comb.variate (length xs) xs == Comb.permute xs--variatePermuteClip :: Eq a => Int -> [a] -> Bool-variatePermuteClip n xs =- equating (take n) (Comb.variate (length xs) xs) (Comb.permute xs)----genTuples :: QC.Gen (Int, [Char])-genTuples = do- xs <- take 16 <$> QC.arbitrary- n <- QC.choose (-1, length xs + 1)- return (n,xs)--tuples :: Eq a => Int -> [a] -> Bool-tuples n xs =- allEqual $- CombPriv.tuplesRec n xs :- CombPriv.tuplesRec0 n xs :- CombPriv.tuplesMSL n xs :- CombPriv.tuplesMSL0 n xs :- []---_setPartitionsMonotony :: Ord a => Int -> [a] -> Bool-_setPartitionsMonotony k =- isAscending . Comb.setPartitions k . nub . sort--rectificationsMonotony :: Ord a => Int -> [a] -> Bool-rectificationsMonotony k =- isAscending . Comb.rectifications k . nub . sort----factorial :: [Char] -> Bool-factorial xs =- length (Comb.permute xs) == Comb.factorial (length xs)---binomial :: [Char] -> Int -> Bool-binomial xs k =- length (Comb.tuples k xs) == Comb.binomial (length xs) k---genBinomial :: QC.Gen (Integer, Integer)-genBinomial = do- n <- QC.choose (0,100)- k <- QC.choose (0,n)- return (n,k)--binomialFactorial :: Integer -> Integer -> Bool-binomialFactorial n k =- let (q, r) =- divMod- (Comb.factorial n)- (Comb.factorial k * Comb.factorial (n-k))- in r == 0 && Comb.binomial n k == q---binomialChoose :: Int -> Int -> Bool-binomialChoose n k =- length (Comb.choose n k) == Comb.binomial n k--multinomialPermuteRep :: [(Char,Int)] -> Bool-multinomialPermuteRep xs =- length (Comb.permuteRep xs) == Comb.multinomial (map snd xs)--multinomialCommutative :: [Integer] -> Bool-multinomialCommutative xs =- Comb.multinomial xs == Comb.multinomial (sort xs)--setPartitionNumbers :: Int -> [Int] -> Bool-setPartitionNumbers k xs =- length (Comb.setPartitions k xs) ==- (Comb.setPartitionNumbers !! length xs ++ repeat 0) !! k--rectificationNumbers :: Int -> [Int] -> Bool-rectificationNumbers k xs =- length (Comb.rectifications k xs) ==- (Comb.setPartitionNumbers !! k ++ repeat 0) !! length xs---surjectiveMappingNumber :: Int -> Bool-surjectiveMappingNumber =- equalFuncList2 Comb.surjectiveMappingNumber Comb.surjectiveMappingNumbers--surjectiveMappingNumbers :: Int -> Bool-surjectiveMappingNumbers n =- allEqual $ map (take n) $ (- CombPriv.surjectiveMappingNumbersPS :- CombPriv.surjectiveMappingNumbersStirling :- [] :: [[[Integer]]])---equalFuncList :: (Integer -> Integer) -> [Integer] -> Int -> Bool-equalFuncList f xs n =- equating (take n) xs (map f $ iterate (1+) 0)--factorials :: Int -> Bool-factorials = equalFuncList Comb.factorial Comb.factorials--equalFuncList2 :: (Integer -> Integer -> Integer) -> [[Integer]] -> Int -> Bool-equalFuncList2 f xs n =- equating (take n) xs (zipWith (map . f) [0..] $ tail $ List.inits [0..])--binomials :: Int -> Bool-binomials = equalFuncList2 Comb.binomial Comb.binomials--catalanNumbers :: Int -> Bool-catalanNumbers = equalFuncList Comb.catalanNumber Comb.catalanNumbers--fibonacciNumbers :: Int -> Bool-fibonacciNumbers = equalFuncList Comb.fibonacciNumber Comb.fibonacciNumbers--derangementNumber :: Int -> Bool-derangementNumber = equalFuncList Comb.derangementNumber Comb.derangementNumbers--derangementNumbers :: Int -> Bool-derangementNumbers n =- allEqual $ map (take n) $ (- CombPriv.derangementNumbersPS0 :- CombPriv.derangementNumbersPS1 :- CombPriv.derangementNumbersInclExcl :- [] :: [[Integer]])---bellSeries :: Int -> Bool-bellSeries =- equalFuncList- (\k -> round (Bell.bellSeries (fromInteger k) :: Double))- (Bell.bellRec :: [Integer])---genPermutationWOFP :: QC.Gen (Int, String)-genPermutationWOFP = do- xs <- take 6 . nub <$> QC.arbitrary- k <- QC.choose (0, length xs)- return (k,xs)--permutationWOFP :: Int -> String -> Bool-permutationWOFP k xs =- PermWOFP.numbers !! length xs !! k == length (PermWOFP.enumerate k xs)--permutationWOFPFactorial :: Int -> Bool-permutationWOFPFactorial k =- Comb.factorial (toInteger k) == PermWOFP.numbers !! k !! 0--permutationWOFPDerangement :: Int -> Bool-permutationWOFPDerangement k =- Comb.derangementNumber (toInteger k) == PermWOFP.numbers !! k !! k---cardPairs1 :: Bool-cardPairs1 =- case CardPairs.testCardsBorderDynamic of- (x,y,z) -> x == y && y == z--genCardCount :: QC.Gen (CardPairs.CardCount Int)-genCardCount =- liftM3 CardPairs.CardCount- (QC.choose (0,5)) (QC.choose (0,5)) (QC.choose (0,5))--cardPairs :: CardPairs.CardCount Int -> Bool-cardPairs cc =- let x = CardPairs.possibilitiesCardsBorderNaive cc- y = CardPairs.possibilitiesCardsBorderDynamic cc ! cc- z = CardPairs.possibilitiesCardsBorder2Dynamic cc ! cc- in x == y && y == z---genMastermindDistinct :: QC.Gen (Int, Int, Int, Int)-genMastermindDistinct = do- n <- QC.choose (0,12)- k <- QC.choose (0, min 5 n)- b <- QC.choose (0,k)- w <- QC.choose (0,k-b)- return (n,k,b,w)--mastermindDistinct :: Int -> Int -> Int -> Int -> Bool-mastermindDistinct n k b w =- let alphabet = take n ['a'..]- code = take k alphabet- in Mastermind.numberDistinct n k b w ==- (toInteger $ length $- filter ((Mastermind.Eval b w ==) . Mastermind.evaluate code) $- Comb.variate k alphabet)-+-- Do not edit! Automatically created with doctest-extract.+module Main where +import qualified Test.Combinatorics+import qualified Test.Combinatorics.Private+import qualified Test.Combinatorics.BellNumbers+import qualified Test.Combinatorics.CardPairs+import qualified Test.Combinatorics.Mastermind+import qualified Test.Combinatorics.Partitions+import qualified Test.Combinatorics.Permutation.WithoutSomeFixpoints -testUnit :: Testable prop => String -> prop -> IO ()-testUnit label p = putStr (label++": ") >> quickCheck p+import qualified Test.DocTest.Driver as DocTest main :: IO ()-main =- sequence_ $- testUnit "permutation sums"- (QC.forAll (take 6 <$> QC.arbitrary) permuteSum) :- testUnit "permutations"- (QC.forAll (take 6 <$> QC.arbitrary :: QC.Gen [Int]) permute) :- testUnit "permuteAlt"- (QC.forAll (take 6 <$> QC.arbitrary :: QC.Gen [Int]) permuteAlt) :- testUnit "permuteRepM"- (QC.forAll (genPermuteRep 10) permuteRepM) :- testUnit "permuteRepNub"- (QC.forAll (genPermuteRep 7) permuteRepNub) :- testUnit "permuteRepNubBig"- (QC.forAll (genPermuteRep 10) permuteRepNubBig) :- testUnit "permuteRepMonotony"- (QC.forAll (genPermuteRep 10) permuteRepMonotony) :- testUnit "permuteRepChoose"- (QC.forAll (QC.choose (0,10)) permuteRepChoose) :- testUnit "choose"- (QC.forAll genChoose (uncurry choose)) :- testUnit "chooseLength"- (QC.forAll (QC.choose (0,10)) chooseLength) :- testUnit "chooseUnrank"- (QC.forAll genChooseIndex $ uncurry3 chooseUnrank) :- testUnit "chooseUnrankSequence"- (QC.forAll (QC.choose (0,10)) chooseUnrankSequence) :- testUnit "chooseRankUnrank"- (QC.forAll genChooseIndex $ uncurry3 chooseRankUnrank) :- testUnit "chooseUnrankRank" chooseUnrankRank :- testUnit "variation without repetitions with list monad"- (QC.forAll (QC.choose (-1,7)) $ \n ->- QC.forAll genVariate $ variate n) :- testUnit "variation with repetitions with list monad"- (QC.forAll (QC.choose (-1,7)) $ \n ->- QC.forAll genVariate $ variateRep n) :- testUnit "variatePermute" (QC.forAll genVariate variatePermute) :- testUnit "tuples" (QC.forAll genTuples (uncurry tuples)) :- testUnit "permute expressed by variate"- (variatePermuteClip 1000 :: String -> Bool) :- testUnit "binomial vs. choose"- (QC.forAll (QC.choose (0,12)) binomialChoose) :- testUnit "multinomial vs. permutation with repetitions"- (QC.forAll (genPermuteRep 10) multinomialPermuteRep) :- testUnit "multinomial commutative"- (QC.forAll (QC.listOf $ QC.choose (0,300)) multinomialCommutative) :- testUnit "factorial vs. permute"- (QC.forAll (take 8 <$> QC.arbitrary) factorial) :- testUnit "binomial vs. tuples"- (QC.forAll (take 16 <$> QC.arbitrary) binomial) :- testUnit "binomial by factorial"- (QC.forAll genBinomial $ uncurry binomialFactorial) :- testUnit "factorial vs. factorials" (factorials 1000) :- testUnit "binomial vs. binomials" (binomials 100) :- testUnit "catalan numbers" (catalanNumbers 1000) :- testUnit "fibonacci numbers" (fibonacciNumbers 10000) :- testUnit "derangement number" (derangementNumber 1000) :- testUnit "derangement numbers" (derangementNumbers 1000) :- testUnit "set partition numbers"- (QC.forAll (QC.choose (0,10000)) $ \n ->- QC.forAll (take 7 <$> QC.arbitrary) $ setPartitionNumbers n) :- testUnit "rectification numbers"- (QC.forAll (QC.choose (0,7)) $ \n xs -> rectificationNumbers n xs) :- testUnit "rectification montony"- (QC.forAll (QC.choose (0,7)) $ \n xs ->- rectificationsMonotony n (xs::[Int])) :- testUnit "surjective mapping number" (surjectiveMappingNumber 20) :- testUnit "surjective mapping numbers" (surjectiveMappingNumbers 20) :- testUnit "bell series" (bellSeries 20) :- testUnit "permutation without some fixpoints"- (QC.forAll genPermutationWOFP $ uncurry permutationWOFP) :- testUnit "permutation without some fixpoints vs. factorial"- (QC.forAll (QC.choose (0,100)) permutationWOFPFactorial) :- testUnit "permutation without some fixpoints vs. derangement"- (QC.forAll (QC.choose (0,100)) permutationWOFPDerangement) :- testUnit "partitions infinite linear factors"- (QC.forAll (QC.choose (0,100)) Parts.propInfProdLinearFactors) :- testUnit "partitions pentagonal power series"- (Parts.propPentagonalPowerSeries 1000) :- testUnit "partitions positive pentagonal numbers"- (Parts.propPentagonalsDifP 10000) :- testUnit "partitions negative pentagonal numbers"- (Parts.propPentagonalsDifN 10000) :- testUnit "partitions"- (QC.forAll (QC.choose (1,10)) $ \k ->- QC.forAll (QC.choose (0,50)) $ \n -> Parts.propPartitions k n) :- testUnit "partitions count" (Parts.propNumPartitions 30) :- testUnit "card pairs" cardPairs1 :- testUnit "card pairs many" (QC.forAll genCardCount cardPairs) :- testUnit "mastermind with distinct symbols"- (QC.forAll genMastermindDistinct $ \(n,k,b,w) ->- mastermindDistinct n k b w) :- []+main = DocTest.run $ do+ Test.Combinatorics.test+ Test.Combinatorics.Private.test+ Test.Combinatorics.BellNumbers.test+ Test.Combinatorics.CardPairs.test+ Test.Combinatorics.Mastermind.test+ Test.Combinatorics.Partitions.test+ Test.Combinatorics.Permutation.WithoutSomeFixpoints.test
+ test/Test/Combinatorics.hs view
@@ -0,0 +1,276 @@+-- Do not edit! Automatically created with doctest-extract from src/Combinatorics.hs+{-# LINE 53 "src/Combinatorics.hs" #-}++module Test.Combinatorics where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 54 "src/Combinatorics.hs" #-}+import qualified Combinatorics as Comb+import qualified Test.QuickCheck as QC+import Test.Utility (equalFuncList, equalFuncList2)++import Control.Applicative (liftA2, (<$>))+import qualified Data.List.Match as Match+import qualified Data.List.Key as Key+import qualified Data.List as List+import qualified Data.Set as Set+import Data.Tuple.HT (uncurry3)+import Data.List.HT (allEqual, isAscending)+import Data.List (sort, nub)+import Data.Eq.HT (equating)++genPermuteRep :: Int -> QC.Gen [(Char, Int)]+genPermuteRep n = do+ xns <- QC.listOf $ liftA2 (,) QC.arbitrary $ QC.choose (0,n)+ return $ Match.take (takeWhile (<=n) $ scanl1 (+) $ map snd xns) xns++genVariate :: QC.Gen [Char]+genVariate = take 7 <$> QC.arbitrary++genBinomial :: QC.Gen (Integer, Integer)+genBinomial = do+ n <- QC.choose (0,100)+ k <- QC.choose (0,n)+ return (n,k)++genChooseIndex :: QC.Gen (Integer, Integer, Integer)+genChooseIndex = do+ n <- QC.choose (0,25)+ k <- QC.choose (0,n)+ i <- QC.choose (0, Comb.binomial n k - 1)+ return (n,k,i)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Combinatorics:105: "+{-# LINE 105 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 105 "src/Combinatorics.hs" #-}+ (QC.forAll (take 6 <$> QC.arbitrary :: QC.Gen [Int]) $ \xs -> allEqual $ map (\p -> sort (p xs)) $ Comb.permute : Comb.permuteFast : Comb.permuteShare : [])+ DocTest.printPrefix "Combinatorics:100: "+{-# LINE 100 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 100 "src/Combinatorics.hs" #-}+ (Comb.permute "abc")+ [ExpectedLine [LineChunk "[\"abc\",\"acb\",\"bac\",\"bca\",\"cab\",\"cba\"]"]]+ DocTest.printPrefix "Combinatorics:102: "+{-# LINE 102 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 102 "src/Combinatorics.hs" #-}+ (Comb.permute "aabc")+ [ExpectedLine [LineChunk "[\"aabc\",\"aacb\",\"abac\",\"abca\",\"acab\",\"acba\",\"aabc\",\"aacb\",\"abac\",\"abca\",\"acab\",\"acba\",\"baac\",\"baca\",\"baac\",\"baca\",\"bcaa\",\"bcaa\",\"caab\",\"caba\",\"caab\",\"caba\",\"cbaa\",\"cbaa\"]"]]+ DocTest.printPrefix "Combinatorics:149: "+{-# LINE 149 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 149 "src/Combinatorics.hs" #-}+ (QC.forAll (genPermuteRep 7) $ \xs -> let perms = Comb.permuteRep $ Key.nub fst xs in perms == nub perms)+ DocTest.printPrefix "Combinatorics:150: "+{-# LINE 150 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 150 "src/Combinatorics.hs" #-}+ (QC.forAll (genPermuteRep 10) $ \xs -> let perms = Comb.permuteRep $ Key.nub fst xs in List.sort perms == Set.toList (Set.fromList perms))+ DocTest.printPrefix "Combinatorics:151: "+{-# LINE 151 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 151 "src/Combinatorics.hs" #-}+ (QC.forAll (genPermuteRep 10) $ isAscending . Comb.permuteRep . Key.nub fst . sort)+ DocTest.printPrefix "Combinatorics:152: "+{-# LINE 152 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 152 "src/Combinatorics.hs" #-}+ (QC.forAll (QC.choose (0,10)) $ \n k -> Comb.choose n k == Comb.permuteRep [(False, n-k), (True, k)])+ DocTest.printPrefix "Combinatorics:146: "+{-# LINE 146 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 146 "src/Combinatorics.hs" #-}+ (Comb.permuteRep [('a',2), ('b',1), ('c',1)])+ [ExpectedLine [LineChunk "[\"aabc\",\"aacb\",\"abac\",\"abca\",\"acab\",\"acba\",\"baac\",\"baca\",\"bcaa\",\"caab\",\"caba\",\"cbaa\"]"]]+ DocTest.printPrefix "Combinatorics:164: "+{-# LINE 164 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 164 "src/Combinatorics.hs" #-}+ (QC.forAll (QC.choose (0,10)) $ \n k -> all (\x -> n == length x && k == length (filter id x)) (Comb.choose n k))+ DocTest.printPrefix "Combinatorics:159: "+{-# LINE 159 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 159 "src/Combinatorics.hs" #-}+ (map (map (\b -> if b then 'x' else '.')) $ Comb.choose 5 3)+ [ExpectedLine [LineChunk "[\"..xxx\",\".x.xx\",\".xx.x\",\".xxx.\",\"x..xx\",\"x.x.x\",\"x.xx.\",\"xx..x\",\"xx.x.\",\"xxx..\"]"]]+ DocTest.printPrefix "Combinatorics:161: "+{-# LINE 161 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 161 "src/Combinatorics.hs" #-}+ (map (map (\b -> if b then 'x' else '.')) $ Comb.choose 3 5)+ [ExpectedLine [LineChunk "[]"]]+ DocTest.printPrefix "Combinatorics:175: "+{-# LINE 175 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 175 "src/Combinatorics.hs" #-}+ (Comb.variateRep 2 "abc")+ [ExpectedLine [LineChunk "[\"aa\",\"ab\",\"ac\",\"ba\",\"bb\",\"bc\",\"ca\",\"cb\",\"cc\"]"]]+ DocTest.printPrefix "Combinatorics:192: "+{-# LINE 192 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 192 "src/Combinatorics.hs" #-}+ (QC.forAll genVariate $ \xs -> Comb.variate (length xs) xs == Comb.permute xs)+ DocTest.printPrefix "Combinatorics:193: "+{-# LINE 193 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 193 "src/Combinatorics.hs" #-}+ (\xs -> equating (take 1000) (Comb.variate (length xs) xs) (Comb.permute (xs::String)))+ DocTest.printPrefix "Combinatorics:185: "+{-# LINE 185 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 185 "src/Combinatorics.hs" #-}+ (Comb.variate 2 "abc")+ [ExpectedLine [LineChunk "[\"ab\",\"ac\",\"ba\",\"bc\",\"ca\",\"cb\"]"]]+ DocTest.printPrefix "Combinatorics:187: "+{-# LINE 187 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 187 "src/Combinatorics.hs" #-}+ (Comb.variate 2 "abcd")+ [ExpectedLine [LineChunk "[\"ab\",\"ac\",\"ad\",\"ba\",\"bc\",\"bd\",\"ca\",\"cb\",\"cd\",\"da\",\"db\",\"dc\"]"]]+ DocTest.printPrefix "Combinatorics:189: "+{-# LINE 189 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 189 "src/Combinatorics.hs" #-}+ (Comb.variate 3 "abcd")+ [ExpectedLine [LineChunk "[\"abc\",\"abd\",\"acb\",\"acd\",\"adb\",\"adc\",\"bac\",\"bad\",\"bca\",\"bcd\",\"bda\",\"bdc\",\"cab\",\"cad\",\"cba\",\"cbd\",\"cda\",\"cdb\",\"dab\",\"dac\",\"dba\",\"dbc\",\"dca\",\"dcb\"]"]]+ DocTest.printPrefix "Combinatorics:203: "+{-# LINE 203 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 203 "src/Combinatorics.hs" #-}+ (Comb.tuples 2 "abc")+ [ExpectedLine [LineChunk "[\"ab\",\"ac\",\"bc\"]"]]+ DocTest.printPrefix "Combinatorics:205: "+{-# LINE 205 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 205 "src/Combinatorics.hs" #-}+ (Comb.tuples 2 "abcd")+ [ExpectedLine [LineChunk "[\"ab\",\"ac\",\"ad\",\"bc\",\"bd\",\"cd\"]"]]+ DocTest.printPrefix "Combinatorics:207: "+{-# LINE 207 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 207 "src/Combinatorics.hs" #-}+ (Comb.tuples 3 "abcd")+ [ExpectedLine [LineChunk "[\"abc\",\"abd\",\"acd\",\"bcd\"]"]]+ DocTest.printPrefix "Combinatorics:218: "+{-# LINE 218 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 218 "src/Combinatorics.hs" #-}+ (QC.forAll genVariate $ \xs -> length (Comb.partitions xs) == 2 ^ length xs)+ DocTest.printPrefix "Combinatorics:215: "+{-# LINE 215 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 215 "src/Combinatorics.hs" #-}+ (Comb.partitions "abc")+ [ExpectedLine [LineChunk "[(\"abc\",\"\"),(\"bc\",\"a\"),(\"ac\",\"b\"),(\"c\",\"ab\"),(\"ab\",\"c\"),(\"b\",\"ac\"),(\"a\",\"bc\"),(\"\",\"abc\")]"]]+ DocTest.printPrefix "Combinatorics:240: "+{-# LINE 240 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 240 "src/Combinatorics.hs" #-}+ (QC.forAll (QC.choose (0,7)) $ \k xs -> isAscending . Comb.rectifications k . nub . sort $ (xs::String))+ DocTest.printPrefix "Combinatorics:235: "+{-# LINE 235 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 235 "src/Combinatorics.hs" #-}+ (Comb.rectifications 4 "abc")+ [ExpectedLine [LineChunk "[\"aabc\",\"abac\",\"abbc\",\"abca\",\"abcb\",\"abcc\"]"]]+ DocTest.printPrefix "Combinatorics:237: "+{-# LINE 237 "src/Combinatorics.hs" #-}+ DocTest.example+{-# LINE 237 "src/Combinatorics.hs" #-}+ (map (length . uncurry Comb.rectifications) $ do x<-[0..10]; y<-[0..x]; return (x,[1..y::Int]))+ [ExpectedLine [LineChunk "[1,0,1,0,1,1,0,1,3,1,0,1,7,6,1,0,1,15,25,10,1,0,1,31,90,65,15,1,0,1,63,301,350,140,21,1,0,1,127,966,1701,1050,266,28,1,0,1,255,3025,7770,6951,2646,462,36,1,0,1,511,9330,34105,42525,22827,5880,750,45,1]"]]+ DocTest.printPrefix "Combinatorics:316: "+{-# LINE 316 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 316 "src/Combinatorics.hs" #-}+ (QC.forAll (QC.choose (0,10)) $ \n k -> map (Comb.chooseUnrank n k) [0 .. Comb.binomial n k - 1] == Comb.choose n k)+ DocTest.printPrefix "Combinatorics:317: "+{-# LINE 317 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 317 "src/Combinatorics.hs" #-}+ (QC.forAll genChooseIndex $ \(n,k,i) -> Comb.chooseRank (Comb.chooseUnrank n k i) == (n, k, i))+ DocTest.printPrefix "Combinatorics:318: "+{-# LINE 318 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 318 "src/Combinatorics.hs" #-}+ (\bs -> uncurry3 Comb.chooseUnrank (Comb.chooseRank bs :: (Integer, Integer, Integer)) == bs)+ DocTest.printPrefix "Combinatorics:349: "+{-# LINE 349 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 349 "src/Combinatorics.hs" #-}+ (QC.forAll (take 8 <$> QC.arbitrary) $ \xs -> length (Comb.permute xs) == Comb.factorial (length (xs::String)))+ DocTest.printPrefix "Combinatorics:350: "+{-# LINE 350 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 350 "src/Combinatorics.hs" #-}+ (QC.forAll (take 6 <$> QC.arbitrary) $ \xs -> sum (map sum (Comb.permute xs)) == sum xs * Comb.factorial (length xs))+ DocTest.printPrefix "Combinatorics:358: "+{-# LINE 358 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 358 "src/Combinatorics.hs" #-}+ (QC.forAll (QC.choose (0,12)) $ \n k -> length (Comb.choose n k) == Comb.binomial n k)+ DocTest.printPrefix "Combinatorics:359: "+{-# LINE 359 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 359 "src/Combinatorics.hs" #-}+ (QC.forAll genBinomial $ \(n,k) -> let (q, r) = divMod (Comb.factorial n) (Comb.factorial k * Comb.factorial (n-k)) in r == 0 && Comb.binomial n k == q)+ DocTest.printPrefix "Combinatorics:360: "+{-# LINE 360 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 360 "src/Combinatorics.hs" #-}+ (QC.forAll (take 16 <$> QC.arbitrary) $ \xs k -> length (Comb.tuples k xs) == Comb.binomial (length (xs::String)) k)+ DocTest.printPrefix "Combinatorics:379: "+{-# LINE 379 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 379 "src/Combinatorics.hs" #-}+ (QC.forAll (genPermuteRep 10) $ \xs -> length (Comb.permuteRep xs) == Comb.multinomial (map snd xs))+ DocTest.printPrefix "Combinatorics:380: "+{-# LINE 380 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 380 "src/Combinatorics.hs" #-}+ (QC.forAll (QC.listOf $ QC.choose (0,300::Integer)) $ \xs -> Comb.multinomial xs == Comb.multinomial (sort xs))+ DocTest.printPrefix "Combinatorics:390: "+{-# LINE 390 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 390 "src/Combinatorics.hs" #-}+ (equalFuncList Comb.factorial Comb.factorials 1000)+ DocTest.printPrefix "Combinatorics:401: "+{-# LINE 401 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 401 "src/Combinatorics.hs" #-}+ (equalFuncList2 Comb.binomial Comb.binomials 100)+ DocTest.printPrefix "Combinatorics:420: "+{-# LINE 420 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 420 "src/Combinatorics.hs" #-}+ (equalFuncList Comb.catalanNumber Comb.catalanNumbers 1000)+ DocTest.printPrefix "Combinatorics:438: "+{-# LINE 438 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 438 "src/Combinatorics.hs" #-}+ (equalFuncList Comb.derangementNumber Comb.derangementNumbers 1000)+ DocTest.printPrefix "Combinatorics:450: "+{-# LINE 450 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 450 "src/Combinatorics.hs" #-}+ (QC.forAll (QC.choose (0,10000)) $ \k -> QC.forAll (take 7 <$> QC.arbitrary) $ \xs -> length (Comb.setPartitions k xs) == (Comb.setPartitionNumbers !! length (xs::String) ++ repeat 0) !! k)+ DocTest.printPrefix "Combinatorics:451: "+{-# LINE 451 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 451 "src/Combinatorics.hs" #-}+ (QC.forAll (QC.choose (0,7)) $ \k xs -> length (Comb.rectifications k xs) == (Comb.setPartitionNumbers !! k ++ repeat 0) !! length (xs::String))+ DocTest.printPrefix "Combinatorics:471: "+{-# LINE 471 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 471 "src/Combinatorics.hs" #-}+ (equalFuncList2 Comb.surjectiveMappingNumber Comb.surjectiveMappingNumbers 20)+ DocTest.printPrefix "Combinatorics:525: "+{-# LINE 525 "src/Combinatorics.hs" #-}+ DocTest.property+{-# LINE 525 "src/Combinatorics.hs" #-}+ (equalFuncList Comb.fibonacciNumber Comb.fibonacciNumbers 10000)
+ test/Test/Combinatorics/BellNumbers.hs view
@@ -0,0 +1,18 @@+-- Do not edit! Automatically created with doctest-extract from src/Combinatorics/BellNumbers.hs+{-# LINE 8 "src/Combinatorics/BellNumbers.hs" #-}++module Test.Combinatorics.BellNumbers where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 9 "src/Combinatorics/BellNumbers.hs" #-}+import qualified Combinatorics.BellNumbers as Bell+import Test.Utility (equalFuncList)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Combinatorics.BellNumbers:23: "+{-# LINE 23 "src/Combinatorics/BellNumbers.hs" #-}+ DocTest.property+{-# LINE 23 "src/Combinatorics/BellNumbers.hs" #-}+ (equalFuncList (\k -> round (Bell.bellSeries (fromInteger k) :: Double)) (Bell.bellRec :: [Integer]) 20)
+ test/Test/Combinatorics/CardPairs.hs view
@@ -0,0 +1,33 @@+-- Do not edit! Automatically created with doctest-extract from src/Combinatorics/CardPairs.hs+{-# LINE 40 "src/Combinatorics/CardPairs.hs" #-}++module Test.Combinatorics.CardPairs where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 41 "src/Combinatorics/CardPairs.hs" #-}+import qualified Combinatorics.CardPairs as CardPairs+import Combinatorics.CardPairs (CardCount(CardCount))++import qualified Test.QuickCheck as QC+import Control.Applicative (liftA3)+import Data.List.HT (allEqual)+import Data.Array ((!))++genCardCount :: QC.Gen (CardPairs.CardCount Int)+genCardCount =+ liftA3 CardPairs.CardCount+ (QC.choose (0,5)) (QC.choose (0,5)) (QC.choose (0,5))++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Combinatorics.CardPairs:184: "+{-# LINE 184 "src/Combinatorics/CardPairs.hs" #-}+ DocTest.property+{-# LINE 184 "src/Combinatorics/CardPairs.hs" #-}+ (allEqual [CardPairs.possibilitiesCardsBorderNaive (CardCount 2 3 5), CardPairs.possibilitiesCardsBorderDynamic (CardCount 5 5 5) ! (CardCount 2 3 5), CardPairs.possibilitiesCardsBorder2Dynamic (CardCount 5 5 5) ! (CardCount 2 3 5)])+ DocTest.printPrefix "Combinatorics.CardPairs:185: "+{-# LINE 185 "src/Combinatorics/CardPairs.hs" #-}+ DocTest.property+{-# LINE 185 "src/Combinatorics/CardPairs.hs" #-}+ (QC.forAll genCardCount $ \cc -> allEqual [CardPairs.possibilitiesCardsBorderNaive cc, CardPairs.possibilitiesCardsBorderDynamic cc ! cc, CardPairs.possibilitiesCardsBorder2Dynamic cc ! cc])
+ test/Test/Combinatorics/Mastermind.hs view
@@ -0,0 +1,41 @@+-- Do not edit! Automatically created with doctest-extract from src/Combinatorics/Mastermind.hs+{-# LINE 22 "src/Combinatorics/Mastermind.hs" #-}++module Test.Combinatorics.Mastermind where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 23 "src/Combinatorics/Mastermind.hs" #-}+import qualified Combinatorics.Mastermind as Mastermind+import qualified Combinatorics as Comb+import qualified Test.QuickCheck as QC+import Control.Monad (replicateM)+import Data.List (genericLength)++genMastermindDistinct :: QC.Gen (Int, Int, Int, Int)+genMastermindDistinct = do+ n <- QC.choose (0,12)+ k <- QC.choose (0, min 5 n)+ b <- QC.choose (0,k)+ w <- QC.choose (0,k-b)+ return (n,k,b,w)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Combinatorics.Mastermind:48: "+{-# LINE 48 "src/Combinatorics/Mastermind.hs" #-}+ DocTest.example+{-# LINE 48 "src/Combinatorics/Mastermind.hs" #-}+ (filter ((Mastermind.Eval 2 0 ==) . Mastermind.evaluate "aabbb") $ replicateM 5 ['a'..'c'])+ [ExpectedLine [LineChunk "[\"aaaaa\",\"aaaac\",\"aaaca\",\"aaacc\",\"aacaa\",\"aacac\",\"aacca\",\"aaccc\",\"acbcc\",\"accbc\",\"acccb\",\"cabcc\",\"cacbc\",\"caccb\",\"ccbbc\",\"ccbcb\",\"cccbb\"]"]]+ DocTest.printPrefix "Combinatorics.Mastermind:86: "+{-# LINE 86 "src/Combinatorics/Mastermind.hs" #-}+ DocTest.property+{-# LINE 86 "src/Combinatorics/Mastermind.hs" #-}+ (QC.forAll genMastermindDistinct $ \(n,k,b,w) -> let alphabet = take n ['a'..]; code = take k alphabet in Mastermind.numberDistinct n k b w == (genericLength $ filter ((Mastermind.Eval b w ==) . Mastermind.evaluate code) $ Comb.variate k alphabet))+ DocTest.printPrefix "Combinatorics.Mastermind:95: "+{-# LINE 95 "src/Combinatorics/Mastermind.hs" #-}+ DocTest.property+{-# LINE 95 "src/Combinatorics/Mastermind.hs" #-}+ (QC.forAll genMastermindDistinct $ \(n,k,_b,w) -> Mastermind.numberDistinctWhite n k w == Mastermind.numberDistinct n k 0 w)
+ test/Test/Combinatorics/Partitions.hs view
@@ -0,0 +1,45 @@+-- Do not edit! Automatically created with doctest-extract from src/Combinatorics/Partitions.hs+{-# LINE 18 "src/Combinatorics/Partitions.hs" #-}++module Test.Combinatorics.Partitions where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 19 "src/Combinatorics/Partitions.hs" #-}+import qualified Combinatorics.Partitions as Parts+import qualified Test.QuickCheck as QC+import Data.List (genericLength)+import Data.Eq.HT (equating)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Combinatorics.Partitions:59: "+{-# LINE 59 "src/Combinatorics/Partitions.hs" #-}+ DocTest.property+{-# LINE 59 "src/Combinatorics/Partitions.hs" #-}+ (QC.forAll (QC.choose (0,100)) Parts.propInfProdLinearFactors)+ DocTest.printPrefix "Combinatorics.Partitions:84: "+{-# LINE 84 "src/Combinatorics/Partitions.hs" #-}+ DocTest.property+{-# LINE 84 "src/Combinatorics/Partitions.hs" #-}+ (Parts.propPentagonalsDifP 10000)+ DocTest.printPrefix "Combinatorics.Partitions:92: "+{-# LINE 92 "src/Combinatorics/Partitions.hs" #-}+ DocTest.property+{-# LINE 92 "src/Combinatorics/Partitions.hs" #-}+ (Parts.propPentagonalsDifN 10000)+ DocTest.printPrefix "Combinatorics.Partitions:137: "+{-# LINE 137 "src/Combinatorics/Partitions.hs" #-}+ DocTest.property+{-# LINE 137 "src/Combinatorics/Partitions.hs" #-}+ (Parts.propPentagonalPowerSeries 1000)+ DocTest.printPrefix "Combinatorics.Partitions:170: "+{-# LINE 170 "src/Combinatorics/Partitions.hs" #-}+ DocTest.property+{-# LINE 170 "src/Combinatorics/Partitions.hs" #-}+ (QC.forAll (QC.choose (1,10)) $ \k -> QC.forAll (QC.choose (0,50)) $ \n -> Parts.partitionsInc k n == Parts.allPartitionsInc !! k !! n)+ DocTest.printPrefix "Combinatorics.Partitions:171: "+{-# LINE 171 "src/Combinatorics/Partitions.hs" #-}+ DocTest.property+{-# LINE 171 "src/Combinatorics/Partitions.hs" #-}+ (equating (take 30) (map genericLength (Parts.allPartitionsInc !! 1)) Parts.numPartitions)
+ test/Test/Combinatorics/Permutation/WithoutSomeFixpoints.hs view
@@ -0,0 +1,37 @@+-- Do not edit! Automatically created with doctest-extract from src/Combinatorics/Permutation/WithoutSomeFixpoints.hs+{-# LINE 5 "src/Combinatorics/Permutation/WithoutSomeFixpoints.hs" #-}++module Test.Combinatorics.Permutation.WithoutSomeFixpoints where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 6 "src/Combinatorics/Permutation/WithoutSomeFixpoints.hs" #-}+import qualified Combinatorics.Permutation.WithoutSomeFixpoints as PermWOFP+import qualified Combinatorics as Comb+import qualified Test.QuickCheck as QC+import Control.Applicative ((<$>))+import Data.List (nub)++genPermutationWOFP :: QC.Gen (Int, String)+genPermutationWOFP = do+ xs <- take 6 . nub <$> QC.arbitrary+ k <- QC.choose (0, length xs)+ return (k,xs)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Combinatorics.Permutation.WithoutSomeFixpoints:34: "+{-# LINE 34 "src/Combinatorics/Permutation/WithoutSomeFixpoints.hs" #-}+ DocTest.property+{-# LINE 34 "src/Combinatorics/Permutation/WithoutSomeFixpoints.hs" #-}+ (QC.forAll genPermutationWOFP $ \(k,xs) -> PermWOFP.numbers !! length xs !! k == length (PermWOFP.enumerate k xs))+ DocTest.printPrefix "Combinatorics.Permutation.WithoutSomeFixpoints:35: "+{-# LINE 35 "src/Combinatorics/Permutation/WithoutSomeFixpoints.hs" #-}+ DocTest.property+{-# LINE 35 "src/Combinatorics/Permutation/WithoutSomeFixpoints.hs" #-}+ (QC.forAll (QC.choose (0,100)) $ \k -> Comb.factorial (toInteger k) == PermWOFP.numbers !! k !! 0)+ DocTest.printPrefix "Combinatorics.Permutation.WithoutSomeFixpoints:36: "+{-# LINE 36 "src/Combinatorics/Permutation/WithoutSomeFixpoints.hs" #-}+ DocTest.property+{-# LINE 36 "src/Combinatorics/Permutation/WithoutSomeFixpoints.hs" #-}+ (QC.forAll (QC.choose (0,100)) $ \k -> Comb.derangementNumber (toInteger k) == PermWOFP.numbers !! k !! k)
+ test/Test/Combinatorics/Private.hs view
@@ -0,0 +1,75 @@+-- Do not edit! Automatically created with doctest-extract from src/Combinatorics/Private.hs+{-# LINE 18 "src/Combinatorics/Private.hs" #-}++module Test.Combinatorics.Private where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 19 "src/Combinatorics/Private.hs" #-}+import qualified Combinatorics.Private as CombPriv+import Test.Combinatorics (genPermuteRep, genVariate, genChooseIndex)++import qualified Test.QuickCheck as QC+import Control.Applicative ((<$>))+import Data.List.HT (allEqual)+import Data.Eq.HT (equating)++genChoose :: QC.Gen (Int, Int)+genChoose = do+ n <- QC.choose (0,15)+ k <- QC.choose (-2,n)+ return (n,k)++genTuples :: QC.Gen (Int, [Char])+genTuples = do+ xs <- take 16 <$> QC.arbitrary+ n <- QC.choose (-1, length xs + 1)+ return (n,xs)++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Combinatorics.Private:46: "+{-# LINE 46 "src/Combinatorics/Private.hs" #-}+ DocTest.property+{-# LINE 46 "src/Combinatorics/Private.hs" #-}+ (QC.forAll (take 6 <$> QC.arbitrary) $ \xs -> CombPriv.permuteRec xs == CombPriv.permuteMSL (xs::[Int]))+ DocTest.printPrefix "Combinatorics.Private:67: "+{-# LINE 67 "src/Combinatorics/Private.hs" #-}+ DocTest.property+{-# LINE 67 "src/Combinatorics/Private.hs" #-}+ (QC.forAll (genPermuteRep 10) $ \xs -> CombPriv.permuteRep xs == CombPriv.permuteRepM xs)+ DocTest.printPrefix "Combinatorics.Private:98: "+{-# LINE 98 "src/Combinatorics/Private.hs" #-}+ DocTest.property+{-# LINE 98 "src/Combinatorics/Private.hs" #-}+ (QC.forAll genChoose $ \(n,k) -> allEqual $ CombPriv.chooseRec n k : CombPriv.chooseMSL n k : CombPriv.chooseMSL0 n k : [])+ DocTest.printPrefix "Combinatorics.Private:132: "+{-# LINE 132 "src/Combinatorics/Private.hs" #-}+ DocTest.property+{-# LINE 132 "src/Combinatorics/Private.hs" #-}+ (QC.forAll (QC.choose (-1,7)) $ \n -> QC.forAll genVariate $ \xs -> CombPriv.variateRep n xs == CombPriv.variateRepM n xs)+ DocTest.printPrefix "Combinatorics.Private:143: "+{-# LINE 143 "src/Combinatorics/Private.hs" #-}+ DocTest.property+{-# LINE 143 "src/Combinatorics/Private.hs" #-}+ (QC.forAll (QC.choose (-1,7)) $ \n -> QC.forAll genVariate $ \xs -> CombPriv.variateRec n xs == CombPriv.variateMSL n xs)+ DocTest.printPrefix "Combinatorics.Private:160: "+{-# LINE 160 "src/Combinatorics/Private.hs" #-}+ DocTest.property+{-# LINE 160 "src/Combinatorics/Private.hs" #-}+ (QC.forAll genTuples $ \(n,xs) -> allEqual $ CombPriv.tuplesRec n xs : CombPriv.tuplesRec0 n xs : CombPriv.tuplesMSL n xs : CombPriv.tuplesMSL0 n xs : [])+ DocTest.printPrefix "Combinatorics.Private:199: "+{-# LINE 199 "src/Combinatorics/Private.hs" #-}+ DocTest.property+{-# LINE 199 "src/Combinatorics/Private.hs" #-}+ (QC.forAll genChooseIndex $ \(n,k,i) -> CombPriv.chooseUnrankRec n k i == CombPriv.chooseUnrankList n k i)+ DocTest.printPrefix "Combinatorics.Private:264: "+{-# LINE 264 "src/Combinatorics/Private.hs" #-}+ DocTest.property+{-# LINE 264 "src/Combinatorics/Private.hs" #-}+ (allEqual $ map (take 1000) (CombPriv.derangementNumbersPS0 : CombPriv.derangementNumbersPS1 : CombPriv.derangementNumbersInclExcl : [] :: [[Integer]]))+ DocTest.printPrefix "Combinatorics.Private:295: "+{-# LINE 295 "src/Combinatorics/Private.hs" #-}+ DocTest.property+{-# LINE 295 "src/Combinatorics/Private.hs" #-}+ (equating (take 20) CombPriv.surjectiveMappingNumbersPS (CombPriv.surjectiveMappingNumbersStirling :: [[Integer]]))
+ test/Test/Utility.hs view
@@ -0,0 +1,13 @@+module Test.Utility where++import qualified Data.List as List+import Data.Eq.HT (equating)+++equalFuncList :: (Integer -> Integer) -> [Integer] -> Int -> Bool+equalFuncList f xs n =+ equating (take n) xs (map f $ iterate (1+) 0)++equalFuncList2 :: (Integer -> Integer -> Integer) -> [[Integer]] -> Int -> Bool+equalFuncList2 f xs n =+ equating (take n) xs (zipWith (map . f) [0..] $ tail $ List.inits [0..])