packages feed

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 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..])