combinatorial 0.0 → 0.1

raw patch · 10 files changed

+466/−276 lines, 10 filesdep −combinatorialdep ~arraydep ~containersdep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies removed: combinatorial

Dependency ranges changed: array, containers, transformers

API changes (from Hackage documentation)

Files

• Changes.md +10/−0
• combinatorial.cabal +8/−4
• src/Combinatorics.hs +33/−222
• src/Combinatorics/CardPairs.hs +23/−1
• src/Combinatorics/MaxNim.hs +1/−1
• src/Combinatorics/PaperStripGame.hs +7/−3
• src/Combinatorics/Permutation/WithoutSomeFixpoints.hs +3/−1
• src/Combinatorics/Private.hs +254/−0
• src/Combinatorics/TreeDepth.hs +7/−1
• test/Test.hs +120/−43

@@ -1,5 +1,15 @@ # Change log for the `combinatorial` package +## 0.1++* added explicit export lists,+  thus hide some helper functions and alternative implementations++* use alternative implementations in tests++* `chooseToIndex` -> `chooseRank`,+  `chooseFromIndex -> chooseUnrank`+ ## 0.0  * Tests: replaced `(==>)` and custom cardinal types by `QC.forAll`.

@@ -1,5 +1,5 @@ Name:             combinatorial-Version:          0.0+Version:          0.1 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -30,7 +30,7 @@   Changes.md  Source-Repository this-  Tag:         0.0+  Tag:         0.1   Type:        darcs   Location:    http://hub.darcs.net/thielema/combinatorial/ @@ -62,16 +62,20 @@     Combinatorics.Permutation.WithoutSomeFixpoints   Other-Modules:     Combinatorics.Utility+    Combinatorics.Private     PowerSeries     Polynomial  Test-Suite combinatorial-test   Type: exitcode-stdio-1.0   Build-Depends:-    combinatorial,     QuickCheck >=2.5 && <3.0,+    containers,+    array,+    transformers,     utility-ht,     base-  Main-Is: test/Test.hs+  Main-Is: Test.hs+  Hs-Source-Dirs:   src, test   GHC-Options:      -Wall   Default-Language: Haskell98

@@ -6,26 +6,17 @@    permute,    permuteFast,    permuteShare,-   permuteMSL,-   runPermuteRep,    permuteRep,-   permuteRepM,    choose,-   chooseMSL,    variateRep,-   variateRepMSL,    variate,-   variateMSL,    tuples,-   tuplesMSL,-   tuplesRec,    partitions,    rectifications,    setPartitions,-   chooseFromIndex,-   chooseFromIndexList,-   chooseFromIndexMaybe,-   chooseToIndex,+   chooseUnrank,+   chooseUnrankMaybe,+   chooseRank,    factorial,    binomial,    binomialSeq,@@ -38,30 +29,24 @@    catalanNumbers,    derangementNumber,    derangementNumbers,-   derangementNumbersAlt,-   derangementNumbersInclExcl,    setPartitionNumbers,    surjectiveMappingNumber,    surjectiveMappingNumbers,-   surjectiveMappingNumbersStirling,    fibonacciNumber,    fibonacciNumbers,    ) where  import qualified PowerSeries-import Combinatorics.Utility (scalarProduct, )+import qualified Combinatorics.Private as Comb  import Data.Function.HT (nest, ) import Data.Maybe.HT (toMaybe, )-import Data.Maybe (mapMaybe, catMaybes, ) import Data.Tuple.HT (mapFst, ) import qualified Data.List.Match as Match-import Data.List.HT (tails, partition, mapAdjacent, removeEach, splitEverywhere, viewL, )-import Data.List (mapAccumL, intersperse, genericIndex, genericReplicate, genericTake, )+import Data.List.HT (mapAdjacent, removeEach, )+import Data.List (genericIndex, ) -import qualified Control.Monad.Trans.Class as MT-import qualified Control.Monad.Trans.State as MS-import Control.Monad (liftM, liftM2, replicateM, forM, guard, )+import Control.Monad (liftM2, )   {-* Generate compositions from a list of elements. -}@@ -74,10 +59,7 @@ The list is sorted lexicographically. -} permute :: [a] -> [[a]]-permute [] = [[]]-permute x =-   concatMap (\(y, ys) -> map (y:) (permute ys))-             (removeEach x)+permute = Comb.permuteRec  {- | Generate list of all permutations of the input list.@@ -113,79 +95,13 @@       (mapFst (:perm))       (removeEach todo) -permuteMSL :: [a] -> [[a]]-permuteMSL xs =-   flip MS.evalStateT xs $ replicateM (length xs) $-   MS.StateT removeEach ----runPermuteRep :: ([(a,Int)] -> [[a]]) -> [(a,Int)] -> [[a]]-runPermuteRep f xs =-   let (ps,ns) = partition ((>0) . snd) xs-   in  if any ((<0) . snd) ns-         then []-         else f ps- permuteRep :: [(a,Int)] -> [[a]]-permuteRep = runPermuteRep permuteRepAux--permuteRepAux :: [(a,Int)] -> [[a]]-permuteRepAux [] = [[]]-permuteRepAux xs =-   concatMap (\(ys,(a,n),zs) ->-      let m = pred n-      in  map (a:) (permuteRepAux (ys ++ (m>0, (a, m)) ?: zs))) $-   filter (\(_,(_,n),_) -> n>0) $-   splitEverywhere xs--permuteRepM :: [(a,Int)] -> [[a]]-permuteRepM = runPermuteRep permuteRepMAux--permuteRepMAux :: [(a,Int)] -> [[a]]-permuteRepMAux [] = [[]]-permuteRepMAux xs =-   do (ys,(a,n),zs) <- splitEverywhere xs-      let m = pred n-      liftM (a:)-         (permuteRepMAux (ys ++ (m>0, (a, m)) ?: zs))---infixr 5 ?:--(?:) :: (Bool, a) -> [a] -> [a]-(True,a)  ?: xs = a:xs-(False,_) ?: xs = xs+permuteRep = Comb.permuteRep   choose :: Int -> Int -> [[Bool]]-choose n k =-   if k<0 || k>n-     then []-     else-       if n==0-         then [[]]-         else-           map (False:) (choose (pred n) k) ++-           map (True:)  (choose (pred n) (pred k))--chooseMSL :: Int -> Int -> [[Bool]]-chooseMSL n0 k0 =-   flip MS.evalStateT k0 $ fmap catMaybes $ sequence $-   intersperse (MS.StateT $ \k -> [(Just False, k), (Just True, pred k)]) $-   flip map [n0,n0-1..0] $ \n ->-   MS.gets (\k -> 0<=k && k<=n) >>= guard >> return Nothing--_chooseMSL :: Int -> Int -> [[Bool]]-_chooseMSL n0 k0 =-   flip MS.evalStateT k0 $ do-   count <--      forM [n0,n0-1..1] $ \n ->-      MS.StateT $ \k ->-      guard (0<=k && k<=n) >> [(False, k), (True, pred k)]-   MS.gets (0==) >>= guard-   return count+choose = Comb.chooseRec   {- |@@ -194,10 +110,7 @@ but I like it more than \"k-permutation\". -} variateRep :: Int -> [a] -> [[a]]-variateRep n x = nest n (\y -> concatMap (\z -> map (z:) y) x) [[]]--variateRepMSL :: Int -> [a] -> [[a]]-variateRepMSL = replicateM+variateRep = Comb.variateRep   {- |@@ -206,15 +119,7 @@    @ variate (length xs) xs == permute xs @ -} variate :: Int -> [a] -> [[a]]-variate 0 _ = [[]]-variate n x =-   concatMap (\(y, ys) -> map (y:) (variate (n-1) ys))-             (removeEach x)--variateMSL :: Int -> [a] -> [[a]]-variateMSL n xs =-   flip MS.evalStateT xs $ replicateM n $-   MS.StateT removeEach+variate = Comb.variateRec   {- |@@ -222,35 +127,7 @@ respecting the order in x and without repetitions. -} tuples :: Int -> [a] -> [[a]]-tuples 0 _  = [[]]-tuples r xs =-   concatMap (\(y:ys) -> map (y:) (tuples (r-1) ys))-             (init (tails xs))--tuplesMSL :: Int -> [a] -> [[a]]-tuplesMSL n xs =-   flip MS.evalStateT xs $ replicateM n $-   MS.StateT $ mapMaybe viewL . tails--_tuplesMSL :: Int -> [a] -> [[a]]-_tuplesMSL n xs =-   flip MS.evalStateT xs $-   replicateM n $ do-      yl <- MS.get-      (y:ys) <- MT.lift $ tails yl-      MS.put ys-      return y--tuplesRec :: Int -> [a] -> [[a]]-tuplesRec k xt =-   if k<0-     then []-     else-       case xt of-          [] -> guard (k==0) >> [[]]-          x:xs ->-             tuplesRec k xs ++-             map (x:) (tuplesRec (pred k) xs)+tuples = Comb.tuplesRec   partitions :: [a] -> [([a],[a])]@@ -316,49 +193,27 @@       return ((x:choosen) : part)  -{-* Compute the number of certain compositions from a number of elements. -}+{-* Rank and unrank combinatorial objects. -}  {- |-@chooseFromIndex n k i == choose n k !! i@+@chooseUnrank n k i == choose n k !! i@ -}-chooseFromIndex :: Integral a => a -> a -> a -> [Bool]-chooseFromIndex n 0 _ = genericReplicate n False-chooseFromIndex n k i =-   let n1 = pred n-       p = binomial n1 k-       b = i>=p-   in  b :-       if b-         then chooseFromIndex n1 (pred k) (i-p)-         else chooseFromIndex n1 k i--chooseFromIndexList :: Integral a => a -> a -> a -> [Bool]-chooseFromIndexList n k0 i0 =---   (\((0,0), xs) -> xs) $-   snd $-   mapAccumL-      (\(k,i) bins ->-          let p = genericIndex (bins++[0]) k-              b = i>=p-          in  (if b-                 then (pred k, i-p)-                 else (k, i),-               b))-      (k0,i0) $-   reverse $-   genericTake n binomials-+chooseUnrank :: Integral a => a -> a -> a -> [Bool]+chooseUnrank = Comb.chooseUnrankRec -chooseFromIndexMaybe :: Int -> Int -> Int -> Maybe [Bool]-chooseFromIndexMaybe n k i =+chooseUnrankMaybe :: Int -> Int -> Int -> Maybe [Bool]+chooseUnrankMaybe n k i =    toMaybe       (0 <= i && i < binomial n k)-      (chooseFromIndex n k i)--- error ("chooseFromIndex: out of range " ++ show (n, k, i))+      (chooseUnrank n k i)+-- error ("chooseUnrank: out of range " ++ show (n, k, i))  -chooseToIndex :: Integral a => [Bool] -> (a, a, a)-chooseToIndex =+{- |+<https://en.wikipedia.org/wiki/Combinatorial_number_system>+-}+chooseRank :: Integral a => [Bool] -> (a, a, a)+chooseRank =    foldl       (\(n,k0,i0) (bins,b) ->         let (k1,i1) = if b then (succ k0, i0 + genericIndex (bins++[0]) k1) else (k0,i0)@@ -375,22 +230,10 @@  {-| Pascal's triangle containing the binomial coefficients. -} binomial :: Integral a => a -> a -> a-binomial n k =-   let bino n' k' =-         if k'<0-           then 0-           else genericIndex (binomialSeq n') k'-   in  if n<2*k-         then bino n (n-k)-         else bino n k+binomial = Comb.binomial  binomialSeq :: Integral a => a -> [a]-binomialSeq n =-   {- this does not work because the corresponding numbers are not always divisible-    product (zipWith div [n', pred n' ..] [1..k'])-   -}-   scanl (\acc (num,den) -> div (acc*num) den) 1-         (zip [n, pred n ..] [1..n])+binomialSeq = Comb.binomialSeq   binomialGen :: (Integral a, Fractional b) => b -> a -> b@@ -410,7 +253,7 @@ {-* Generate complete lists of factorial numbers. -}  factorials :: Num a => [a]-factorials = scanl (*) 1 (iterate (+1) 1)+factorials = Comb.factorials  {-| Pascal's triangle containing the binomial coefficients.@@ -419,9 +262,7 @@ or even particular elements. -} binomials :: Num a => [[a]]-binomials =-   let conv11 x = zipWith (+) ([0]++x) (x++[0])-   in  iterate conv11 [1]+binomials = Comb.binomials   {- |@@ -455,28 +296,7 @@ <http://oeis.org/A000166> -} derangementNumbers :: Num a => [a]-derangementNumbers =-   -- OEIS-A166: a(n) = n·a(n-1)+(-1)^n-   -- y(x) = 1/(1+x) + x · (t -> y(t)·t)'(x)-   let xs = PowerSeries.add-               (cycle [1,-1])-               (0 : PowerSeries.differentiate (0 : xs))-   in  xs--derangementNumbersAlt :: Num a => [a]-derangementNumbersAlt =-   -- OEIS-A166: a(n) = (n-1)·(a(n-1)+a(n-2))-   -- y(x) = 1 + x^2 · (t -> y(t)·(1+t))'(x)-   let xs =-         1 : 0 :-             PowerSeries.differentiate-                (PowerSeries.add xs (0 : xs))-   in  xs--derangementNumbersInclExcl :: Num a => [a]-derangementNumbersInclExcl =-   let xs = zipWith (-) factorials (map (scalarProduct xs . init) binomials)-   in  xs+derangementNumbers = Comb.derangementNumbersPS0   -- generation of all possibilities and computation of their number should be in different modules@@ -486,9 +306,7 @@ Known as Stirling numbers <http://oeis.org/A048993>. -} setPartitionNumbers :: Num a => [[a]]-setPartitionNumbers =-   -- s_{n+1,k} = s_{n,k-1} + k·s_{n,k}-   iterate (\x -> 0 : PowerSeries.add x (PowerSeries.differentiate x)) [1]+setPartitionNumbers = Comb.setPartitionNumbers   {- |@@ -505,14 +323,7 @@       (binomialSeq k)  surjectiveMappingNumbers :: Num a => [[a]]-surjectiveMappingNumbers =-   iterate-      (\x -> 0 : PowerSeries.differentiate-                (PowerSeries.add x (0 : x))) [1]--surjectiveMappingNumbersStirling :: Num a => [[a]]-surjectiveMappingNumbersStirling =-   map (zipWith (*) factorials) setPartitionNumbers+surjectiveMappingNumbers = Comb.surjectiveMappingNumbersPS   {- |

@@ -2,7 +2,29 @@ Compute how often it happens that a Queen and a King are adjacent in a randomly ordered card set. -}-module Combinatorics.CardPairs where+module Combinatorics.CardPairs (+   -- * general+   Card(..), CardCount(..),+   charFromCard,+   allPossibilities,+   numberOfAllPossibilities,+   possibilitiesCardsNaive,+   possibilitiesCardsDynamic,+   possibilitiesCardsBorderNaive,+   possibilitiesCardsBorderDynamic,+   possibilitiesCardsBorder2Dynamic,+   -- * examples+   cardSetSizeSkat, numberOfPossibilitiesSkat, probabilitySkat,+   cardSetSizeRummy, numberOfPossibilitiesRummy, probabilityRummy,+   cardSetSizeRummyJK, numberOfPossibilitiesRummyJK, probabilityRummyJK,+   -- * tests+   testCardsBorderDynamic,+   exampleOutput,+   adjacentCouplesSmall,+   allPossibilitiesSmall,+   allPossibilitiesMedium,+   allPossibilitiesSkat,+   ) where  import qualified Combinatorics as Comb 

@@ -9,7 +9,7 @@  E-Mail by Daniel Beer from 2011-10-24. -}-module Combinatorics.MaxNim where+module Combinatorics.MaxNim (numberOfPossibilities) where  import qualified Data.Set as Set 

@@ -2,7 +2,11 @@ Number of possible games as described in <http://projecteuler.net/problem=306>. -}-module Combinatorics.PaperStripGame where+module Combinatorics.PaperStripGame (+   numbersOfGames,+   numbersOfGamesSeries,+   treeOfGames,+   ) where  import qualified Combinatorics as Combi import qualified PowerSeries as PS@@ -17,8 +21,8 @@ representation: store the original position of every box -}-cutEverywhere0 :: [Int] -> [[Int]]-cutEverywhere0 xs = do+_cutEverywhere0 :: [Int] -> [[Int]]+_cutEverywhere0 xs = do    (ys, z0:z1:zs) <- zip (inits xs) (tails xs)    guard $ succ z0 == z1    return $ ys++zs

@@ -4,8 +4,10 @@  {- | @enumerate n xs@ list all permutations of @xs@-where the first @n@ elements do not keep there position+where the first @n@ elements do not keep their position (i.e. are no fixpoints).++This is a generalization of derangement.  Naive but comprehensible implementation. -}

@@ -0,0 +1,254 @@+module Combinatorics.Private where++import qualified PowerSeries+import Combinatorics.Utility (scalarProduct, )++import Data.Function.HT (nest, )+import Data.Maybe (mapMaybe, catMaybes, )+import Data.List.HT (tails, partition, removeEach, splitEverywhere, viewL, )+import Data.List+         (mapAccumL, intersperse, genericIndex, genericReplicate, genericTake, )++import qualified Control.Monad.Trans.Class as MT+import qualified Control.Monad.Trans.State as MS+import qualified Control.Monad.HT as Monad+import Control.Monad (MonadPlus, liftM, forM, guard, )+++replicateM :: (MonadPlus m) => Int -> m a -> m [a]+replicateM n m = guard (n>=0) >> Monad.replicate n m+++permuteRec :: [a] -> [[a]]+permuteRec =+   let go [] = [[]]+       go x = concatMap (\(y, ys) -> map (y:) (go ys)) (removeEach x)+   in  go++permuteMSL :: [a] -> [[a]]+permuteMSL xs = variateMSL (length xs) xs++++runPermuteRep :: ([(a,Int)] -> [[a]]) -> [(a,Int)] -> [[a]]+runPermuteRep f xs =+   let (ps,ns) = partition ((>0) . snd) xs+   in  if any ((<0) . snd) ns+         then []+         else f ps++permuteRep :: [(a,Int)] -> [[a]]+permuteRep =+   let go [] = [[]]+       go xs =+         concatMap (\(ys,(a,n),zs) ->+            let m = pred n+            in  map (a:) (go (ys ++ (m>0, (a, m)) ?: zs))) $+         filter (\(_,(_,n),_) -> n>0) $+         splitEverywhere xs+   in runPermuteRep go++permuteRepM :: [(a,Int)] -> [[a]]+permuteRepM =+   let go [] = [[]]+       go xs =+         do (ys,(a,n),zs) <- splitEverywhere xs+            let m = pred n+            liftM (a:) (go (ys ++ (m>0, (a, m)) ?: zs))+   in runPermuteRep go+++infixr 5 ?:++(?:) :: (Bool, a) -> [a] -> [a]+(True,a)  ?: xs = a:xs+(False,_) ?: xs = xs+++chooseRec :: Int -> Int -> [[Bool]]+chooseRec =+   let go n k =+         if k<0 || k>n+           then []+           else+             if n==0+               then [[]]+               else+                 map (False:) (go (pred n) k) +++                 map (True:)  (go (pred n) (pred k))+   in go++chooseMSL :: Int -> Int -> [[Bool]]+chooseMSL n0 k0 =+   flip MS.evalStateT k0 $ fmap catMaybes $ sequence $+   intersperse (MS.StateT $ \k -> [(Just False, k), (Just True, pred k)]) $+   flip map [n0,n0-1..0] $ \n ->+   MS.gets (\k -> 0<=k && k<=n) >>= guard >> return Nothing++chooseMSL0 :: Int -> Int -> [[Bool]]+chooseMSL0 n0 k0 =+   flip MS.evalStateT k0 $ do+   count <-+      forM [n0,n0-1..1] $ \n ->+      MS.StateT $ \k ->+      guard (0<=k && k<=n) >> [(False, k), (True, pred k)]+   MS.gets (0==) >>= guard+   return count+++variateRep :: Int -> [a] -> [[a]]+variateRep n x =+   if n<0 then [] else nest n (\y -> concatMap (\z -> map (z:) y) x) [[]]++variateRepM :: Int -> [a] -> [[a]]+variateRepM = replicateM+++variateRec :: Int -> [a] -> [[a]]+variateRec =+   let go n =+         case compare n 0 of+            LT -> const []+            EQ -> const [[]]+            GT -> concatMap (\(y, ys) -> map (y:) (go (n-1) ys)) . removeEach+   in  go++variateMSL :: Int -> [a] -> [[a]]+variateMSL n = MS.evalStateT $ replicateM n $ MS.StateT removeEach+++tuplesRec :: Int -> [a] -> [[a]]+tuplesRec =+   let go r =+         case compare r 0 of+            LT -> const []+            EQ -> const [[]]+            GT -> concatMap (\(y:ys) -> map (y:) (go (r-1) ys)) . init . tails+   in  go++tuplesRec0 :: Int -> [a] -> [[a]]+tuplesRec0 =+   let go k =+         if k<0+           then const []+           else+             \ xt ->+             case xt of+                [] -> guard (k==0) >> [[]]+                x:xs -> map (x:) (go (pred k) xs) ++ go k xs+   in go++tuplesMSL :: Int -> [a] -> [[a]]+tuplesMSL n xs =+   flip MS.evalStateT xs $ replicateM n $+   MS.StateT $ mapMaybe viewL . tails++tuplesMSL0 :: Int -> [a] -> [[a]]+tuplesMSL0 n xs =+   flip MS.evalStateT xs $+   replicateM n $ do+      yl <- MS.get+      (y:ys) <- MT.lift $ tails yl+      MS.put ys+      return y+++chooseUnrankRec :: Integral a => a -> a -> a -> [Bool]+chooseUnrankRec =+   let go n 0 _ = genericReplicate n False+       go n k i =+          let n1 = pred n+              p = binomial n1 k+              b = i>=p+              (k1,i1) = if b then (pred k, i-p) else (k,i)+          in  b : go n1 k1 i1+   in go++chooseUnrankList :: Integral a => a -> a -> a -> [Bool]+chooseUnrankList n k0 i0 =+--   (\((0,0), xs) -> xs) $+   snd $+   mapAccumL+      (\(k,i) bins ->+          let p = genericIndex (bins++[0]) k+              b = i>=p+          in  (if b+                 then (pred k, i-p)+                 else (k, i),+               b))+      (k0,i0) $+   reverse $+   genericTake n binomials+++binomial :: Integral a => a -> a -> a+binomial n k =+   let bino n' k' =+         if k'<0+           then 0+           else genericIndex (binomialSeq n') k'+   in  if n<2*k+         then bino n (n-k)+         else bino n k++binomialSeq :: Integral a => a -> [a]+binomialSeq n =+   {- this does not work because the corresponding numbers are not always divisible+    product (zipWith div [n', pred n' ..] [1..k'])+   -}+   scanl (\acc (num,den) -> div (acc*num) den) 1+         (zip [n, pred n ..] [1..n])+++factorials :: Num a => [a]+factorials = scanl (*) 1 (iterate (+1) 1)++{-|+Pascal's triangle containing the binomial coefficients.+Only efficient if a prefix of all rows is required.+It is not efficient for picking particular rows+or even particular elements.+-}+binomials :: Num a => [[a]]+binomials =+   let conv11 x = zipWith (+) ([0]++x) (x++[0])+   in  iterate conv11 [1]+++derangementNumbersPS0 :: Num a => [a]+derangementNumbersPS0 =+   -- OEIS-A166: a(n) = n·a(n-1)+(-1)^n+   -- y(x) = 1/(1+x) + x · (t -> y(t)·t)'(x)+   let xs = PowerSeries.add+               (cycle [1,-1])+               (0 : PowerSeries.differentiate (0 : xs))+   in  xs++derangementNumbersPS1 :: Num a => [a]+derangementNumbersPS1 =+   -- OEIS-A166: a(n) = (n-1)·(a(n-1)+a(n-2))+   -- y(x) = 1 + x^2 · (t -> y(t)·(1+t))'(x)+   let xs = 1 : 0 : PowerSeries.differentiate (PowerSeries.add xs (0 : xs))+   in  xs++derangementNumbersInclExcl :: Num a => [a]+derangementNumbersInclExcl =+   let xs = zipWith (-) factorials (map (scalarProduct xs . init) binomials)+   in  xs+++setPartitionNumbers :: Num a => [[a]]+setPartitionNumbers =+   -- s_{n+1,k} = s_{n,k-1} + k·s_{n,k}+   iterate (\x -> 0 : PowerSeries.add x (PowerSeries.differentiate x)) [1]+++surjectiveMappingNumbersPS :: Num a => [[a]]+surjectiveMappingNumbersPS =+   iterate+      (\x -> 0 : PowerSeries.differentiate (PowerSeries.add x (0 : x)))+      [1]++surjectiveMappingNumbersStirling :: Num a => [[a]]+surjectiveMappingNumbersStirling =+   map (zipWith (*) factorials) setPartitionNumbers

@@ -1,4 +1,10 @@-module Combinatorics.TreeDepth where+module Combinatorics.TreeDepth (+   treeDepth,+   treeDepthSeq,+   nodeDepth,+   nodeDegreeProb,+   nodeDegreeExpect,+   ) where  {- Date: Mon, 18 Apr 2005 18:00:22 +0200

@@ -2,19 +2,23 @@  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, replicateM, )+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, )@@ -36,21 +40,28 @@       Comb.permuteShare :       [] +permuteAlt :: Eq a => [a] -> Bool+permuteAlt xs = CombPriv.permuteRec xs == CombPriv.permuteMSL xs -genPermuteRep :: QC.Gen [(Char, Int)]-genPermuteRep = do-   xns <- QC.listOf $ liftM2 (,) QC.arbitrary $ QC.choose (0,10)-   return $ Match.take (takeWhile (<=10) $ scanl1 (+) $ map snd xns) xns +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 = Comb.permuteRep xs == Comb.permuteRepM xs+permuteRepM xs = CombPriv.permuteRep xs == CombPriv.permuteRepM xs  permuteRepNub :: Eq a => [(a, Int)] -> Bool-permuteRepNub xs' =-   let xs = Key.nub fst xs'-       perms = Comb.permuteRep xs+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 @@ -65,6 +76,20 @@       (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)@@ -72,23 +97,23 @@    i <- QC.choose (0, Comb.binomial n k - 1)    return (n,k,i) -chooseFromIndex :: Integer -> Integer -> Integer -> Bool-chooseFromIndex n k i =-   Comb.chooseFromIndex n k i  ==  Comb.chooseFromIndexList n k i+chooseUnrank :: Integer -> Integer -> Integer -> Bool+chooseUnrank n k i =+   CombPriv.chooseUnrankRec n k i  ==  CombPriv.chooseUnrankList n k i -chooseFromIndexSequence :: Int -> Int -> Bool-chooseFromIndexSequence n k =-   map (Comb.chooseFromIndex n k) [0 .. Comb.binomial n k - 1]+chooseUnrankSequence :: Int -> Int -> Bool+chooseUnrankSequence n k =+   map (Comb.chooseUnrank n k) [0 .. Comb.binomial n k - 1]      ==  Comb.choose n k -chooseToFromIndex :: Integer -> Integer -> Integer -> Bool-chooseToFromIndex n k i =-   Comb.chooseToIndex (Comb.chooseFromIndex n k i)  ==  (n, k, i)+chooseRankUnrank :: Integer -> Integer -> Integer -> Bool+chooseRankUnrank n k i =+   Comb.chooseRank (Comb.chooseUnrank n k i)  ==  (n, k, i) -chooseFromToIndex :: [Bool] -> Bool-chooseFromToIndex bs =-   uncurry3 Comb.chooseFromIndex-      (Comb.chooseToIndex bs :: (Integer, Integer, Integer))+chooseUnrankRank :: [Bool] -> Bool+chooseUnrankRank bs =+   uncurry3 Comb.chooseUnrank+      (Comb.chooseRank bs :: (Integer, Integer, Integer))      ==  bs  @@ -96,10 +121,14 @@ genVariate :: QC.Gen [Char] genVariate = take 7 <$> QC.arbitrary -variateRepMonad :: Eq a => Int -> [a] -> Bool-variateRepMonad n xs =-   Comb.variateRep n xs == replicateM n xs+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@@ -108,6 +137,24 @@ 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@@ -173,8 +220,8 @@ surjectiveMappingNumbers :: Int -> Bool surjectiveMappingNumbers n =    allEqual $ map (take n) $ (-      Comb.surjectiveMappingNumbers :-      Comb.surjectiveMappingNumbersStirling :+      CombPriv.surjectiveMappingNumbersPS :+      CombPriv.surjectiveMappingNumbersStirling :       [] :: [[[Integer]]])  @@ -204,9 +251,9 @@ derangementNumbers :: Int -> Bool derangementNumbers n =    allEqual $ map (take n) $ (-      Comb.derangementNumbers :-      Comb.derangementNumbersAlt :-      Comb.derangementNumbersInclExcl :+      CombPriv.derangementNumbersPS0 :+      CombPriv.derangementNumbersPS1 :+      CombPriv.derangementNumbersInclExcl :       [] :: [[Integer]])  @@ -236,6 +283,24 @@    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)@@ -265,33 +330,43 @@          (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 permuteRepM) :+         (QC.forAll (genPermuteRep 10) permuteRepM) :       testUnit "permuteRepNub"-         (QC.forAll genPermuteRep permuteRepNub) :+         (QC.forAll (genPermuteRep  7) permuteRepNub) :+      testUnit "permuteRepNubBig"+         (QC.forAll (genPermuteRep 10) permuteRepNubBig) :       testUnit "permuteRepMonotony"-         (QC.forAll genPermuteRep 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 "chooseFromIndex"-         (QC.forAll genChooseIndex $ uncurry3 chooseFromIndex) :-      testUnit "chooseFromIndexSequence"-         (QC.forAll (QC.choose (0,10)) chooseFromIndexSequence) :-      testUnit "chooseToFromIndex"-         (QC.forAll genChooseIndex $ uncurry3 chooseToFromIndex) :-      testUnit "chooseFromToIndex" chooseFromToIndex :+      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 (0,6)) $ \n ->-          QC.forAll genVariate $ variateRepMonad n) :+         (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 multinomialPermuteRep) :+         (QC.forAll (genPermuteRep 10) multinomialPermuteRep) :       testUnit "multinomial commutative"          (QC.forAll (QC.listOf $ QC.choose (0,300)) multinomialCommutative) :       testUnit "factorial vs. permute"@@ -335,6 +410,8 @@          (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) :