combinat 0.2.8.1 → 0.2.8.2

raw patch · 15 files changed

+1500/−25 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Math/Combinat/Numbers.hs +24/−9
• Math/Combinat/Partitions/Set.hs +10/−0
• Math/Combinat/Sets.hs +48/−12
• Math/Combinat/Sign.hs +29/−0
• combinat.cabal +13/−3
• test/Tests/Braid.hs +278/−0
• test/Tests/Common.hs +35/−0
• test/Tests/LatticePaths.hs +111/−0
• test/Tests/Partitions/Integer.hs +107/−0
• test/Tests/Partitions/Skew.hs +85/−0
• test/Tests/Permutations.hs +219/−0
• test/Tests/Series.hs +303/−0
• test/Tests/SkewTableaux.hs +103/−0
• test/Tests/Thompson.hs +134/−0

@@ -1,4 +1,4 @@-Copyright (c) 2008-2015, Balazs Komuves+Copyright (c) 2008-2016, Balazs Komuves All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -11,12 +11,7 @@ import Data.Array  import Math.Combinat.Helper ( sum' )-------------------------------------------------------------------------------------- | @(-1)^k@-paritySignValue :: Integral a => a -> Integer-paritySignValue k = if odd k then (-1) else 1+import Math.Combinat.Sign  -------------------------------------------------------------------------------- @@ -35,7 +30,7 @@   | odd n     = product [1,3..fromIntegral n]   | otherwise = product [2,4..fromIntegral n] --- | A007318.+-- | A007318. Note: This is zero for @n<0@ or @k<0@; see also 'signedBinomial' below. binomial :: Integral a => a -> a -> Integer binomial n k    | k > n = 0@@ -46,6 +41,26 @@     k' = fromIntegral k     n' = fromIntegral n +-- | The extension of the binomial function to negative inputs. This should satisfy the following properties:+--+-- > for n,k >=0 : signedBinomial n k == binomial n k+-- > for any n,k : signedBinomial n k == signedBinomial n (n-k) +-- > for k >= 0  : signedBinomial (-n) k == (-1)^k * signedBinomial (n+k-1) k+--+-- Note: This is compatible with Mathematica's @Binomial@ function.+--+signedBinomial :: Int -> Int -> Integer+signedBinomial n k+  | n >= 0     = binomial n k+  | k >= 0     = negateIfOdd    k  $ binomial (k-n-1)   k  +  | otherwise  = negateIfOdd (n+k) $ binomial (-k-1) (-n-1)++{-+test_signed_0 = [ signedBinomial ( n) k == signedBinomial ( n) ( n-k)                | n<-[-30..40] , k<-[-30..40] ]+test_signed_1 = [ signedBinomial (-n) k == signedBinomial (-n) (-n-k)                | n<-[-30..40] , k<-[-30..40] ]+test_signed_2 = [ signedBinomial (-n) k == negateIfOdd k $ signedBinomial (n+k-1) k  | n<-[-30..40] , k<-[0..30] ]+-}+ -- | A given row of the Pascal triangle; equivalent to a sequence of binomial  -- numbers, but much more efficient. You can also left-fold over it. --@@ -129,7 +144,7 @@   | k < 1        = 0   | k > n        = 0   | otherwise = sum xs `div` factorial k where-      xs = [ paritySignValue (k-i) * binomial k i * (fromIntegral i)^n | i<-[0..k] ]+      xs = [ negateIfOdd (k-i) $ binomial k i * (fromIntegral i)^n | i<-[0..k] ]  -------------------------------------------------------------------------------- -- * Bernoulli numbers@@ -144,7 +159,7 @@   | n == 1    = -1/2   | otherwise = sum [ f k | k<-[1..n] ]    where-    f k = toRational (paritySignValue (n+k) * factorial k * stirling2nd n k) +    f k = toRational (negateIfOdd (n+k) $ factorial k * stirling2nd n k)          / toRational (k+1)  --------------------------------------------------------------------------------

@@ -18,6 +18,7 @@ import Math.Combinat.Numbers import Math.Combinat.Helper import Math.Combinat.Classes+import Math.Combinat.Partitions.Integer  -------------------------------------------------------------------------------- -- * The type of set partitions@@ -48,6 +49,15 @@  instance HasNumberOfParts SetPartition where   numberOfParts (SetPartition p) = length p++--------------------------------------------------------------------------------+-- * Forgetting the set structure++-- | The \"shape\" of a set partition is the partition we get when we forget the+-- set structure, keeping only the cardinalities.+--+setPartitionShape :: SetPartition -> Partition+setPartitionShape (SetPartition pps) = mkPartition (map length pps)  -------------------------------------------------------------------------------- -- * Generating set partitions

@@ -4,18 +4,19 @@ {-# LANGUAGE BangPatterns, Rank2Types #-} module Math.Combinat.Sets    ( -    -- * choices-    choose , choose_+    -- * Choices+    choose_ , choose , choose' , choose'' , chooseTagged+    -- * Compositions   , combine , compose-    -- * tensor products+    -- * Tensor products   , tuplesFromList   , listTensor-    -- * sublists+    -- * Sublists   , kSublists   , sublists   , countKSublists   , countSublists-    -- * random choice+    -- * Random choice   , randomChoice   )    where@@ -39,12 +40,6 @@ -------------------------------------------------------------------------------- -- * choices --- | All possible ways to choose @k@ elements from a list, without--- repetitions. \"Antisymmetric power\" for lists. Synonym for 'kSublists'.-choose :: Int -> [a] -> [[a]]-choose 0 _  = [[]]-choose k [] = []-choose k (x:xs) = map (x:) (choose (k-1) xs) ++ choose k xs    -- | @choose_ k n@ returns all possible ways of choosing @k@ disjoint elements from @[1..n]@ --@@ -57,6 +52,47 @@     then []     else choose k [1..n] +-- | All possible ways to choose @k@ elements from a list, without+-- repetitions. \"Antisymmetric power\" for lists. Synonym for 'kSublists'.+choose :: Int -> [a] -> [[a]]+choose 0 _  = [[]]+choose k [] = []+choose k (x:xs) = map (x:) (choose (k-1) xs) ++ choose k xs  ++-- | A version of 'choose' which also returns the complementer sets.+--+-- > choose k = map fst . choose' k+--+choose' :: Int -> [a] -> [([a],[a])]+choose' 0 xs = [([],xs)]+choose' k [] = []+choose' k (x:xs) = map f (choose' (k-1) xs) ++ map g (choose' k xs) where+  f (as,bs) = (x:as ,   bs)+  g (as,bs) = (  as , x:bs)++-- | Another variation of 'choose''. This satisfies+--+-- > choose'' k == map (\(xs,ys) -> (map fst xs, map snd ys)) . choose' k+--+choose'' :: Int -> [(a,b)] -> [([a],[b])]+choose'' 0 xys = [([] , map snd xys)]+choose'' k []  = []+choose'' k ((x,y):xs) = map f (choose'' (k-1) xs) ++ map g (choose'' k xs) where+  f (as,bs) = (x:as ,   bs)+  g (as,bs) = (  as , y:bs)++-- | Another variation on 'choose' which tags the elements based on whether they are part of+-- the selected subset ('Right') or not ('Left'):+--+-- > choose k = map rights . chooseTagged k+--+chooseTagged :: Int -> [a] -> [[Either a a]]+chooseTagged 0 xs = [map Left xs]+chooseTagged k [] = []+chooseTagged k (x:xs) = map f (chooseTagged (k-1) xs) ++ map g (chooseTagged k xs) where+  f eis = Right x : eis+  g eis = Left  x : eis+ -- | All possible ways to choose @k@ elements from a list, /with repetitions/.  -- \"Symmetric power\" for lists. See also "Math.Combinat.Compositions". -- TODO: better name?@@ -94,7 +130,7 @@ -------------------------------------------------------------------------------- -- * sublists --- | Sublists of a list having given number of elements.+-- | Sublists of a list having given number of elements. Synonym for 'choose'. kSublists :: Int -> [a] -> [[a]] kSublists = choose 

@@ -29,15 +29,44 @@ isPlus  s = case s of { Plus  -> True ; _ -> False } isMinus s = case s of { Minus -> True ; _ -> False } +{-# SPECIALIZE signValue :: Sign -> Int     #-}+{-# SPECIALIZE signValue :: Sign -> Integer #-}+ -- | @+1@ or @-1@ signValue :: Num a => Sign -> a signValue s = case s of    Plus  ->  1    Minus -> -1  +{-# SPECIALIZE signed :: Sign -> Int     -> Int     #-}+{-# SPECIALIZE signed :: Sign -> Integer -> Integer #-}++-- | Negate the second argument if the first is 'Minus'+signed :: Num a => Sign -> a -> a+signed s y = case s of+  Plus  -> y+  Minus -> negate y++{-# SPECIALIZE paritySign :: Int     -> Sign #-}+{-# SPECIALIZE paritySign :: Integer -> Sign #-}+ -- | 'Plus' if even, 'Minus' if odd paritySign :: Integral a => a -> Sign paritySign x = if even x then Plus else Minus ++{-# SPECIALIZE paritySignValue :: Int     -> Integer #-}+{-# SPECIALIZE paritySignValue :: Integer -> Integer #-}++-- | @(-1)^k@+paritySignValue :: Integral a => a -> Integer+paritySignValue k = if odd k then (-1) else 1++{-# SPECIALIZE negateIfOdd :: Int     -> Int     -> Int     #-}+{-# SPECIALIZE negateIfOdd :: Int     -> Integer -> Integer #-}++-- | Negate the second argument if the first is odd+negateIfOdd :: (Integral a, Num b) => a -> b -> b+negateIfOdd k y = if even k then y else negate y  oppositeSign :: Sign -> Sign oppositeSign s = case s of

@@ -1,5 +1,5 @@ Name:                combinat-Version:             0.2.8.1+Version:             0.2.8.2 Synopsis:            Generate and manipulate various combinatorial objects. Description:         A collection of functions to generate, count, manipulate                      and visualize all kinds of combinatorial objects like @@ -8,12 +8,12 @@ License:             BSD3 License-file:        LICENSE Author:              Balazs Komuves-Copyright:           (c) 2008-2015 Balazs Komuves+Copyright:           (c) 2008-2016 Balazs Komuves Maintainer:          bkomuves (plus) hackage (at) gmail (dot) com Homepage:            http://code.haskell.org/~bkomuves/ Stability:           Experimental Category:            Math-Tested-With:         GHC == 7.10.2+Tested-With:         GHC == 7.10.3 Cabal-Version:       >= 1.18 Build-Type:          Simple @@ -80,6 +80,16 @@   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             TestSuite.hs+  +  other-modules:       Tests.Braid+                       Tests.Common+                       Tests.LatticePaths+                       Tests.Permutations+                       Tests.Series+                       Tests.SkewTableaux+                       Tests.Thompson+                       Tests.Partitions.Integer+                       Tests.Partitions.Skew    build-depends:       base >= 4 && < 5, array >= 0.5, containers, random, transformers,                        combinat,

@@ -0,0 +1,278 @@++-- | Tests for braids. ++{-# LANGUAGE +      CPP, BangPatterns, +      ScopedTypeVariables, ExistentialQuantification,+      DataKinds, KindSignatures, Rank2Types,+      TypeOperators, TypeFamilies,+      StandaloneDeriving #-}++module Tests.Braid where++--------------------------------------------------------------------------------++import Math.Combinat.Groups.Braid+import Math.Combinat.Groups.Braid.NF++import Tests.Permutations ()     -- arbitrary instance+import Tests.Common++import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck+import Test.QuickCheck.Gen++import Data.Proxy+import GHC.TypeLits++import Control.Monad++import Data.List ( mapAccumL , foldl' )++import Data.Array.Unboxed+import Data.Array.ST+import Data.Array.IArray+import Data.Array.MArray+import Data.Array.Unsafe+import Data.Array.Base++import Control.Monad.ST++import System.Random++import Math.Combinat.Sign+import Math.Combinat.Helper+import Math.Combinat.TypeLevel+import Math.Combinat.Numbers.Series++import Math.Combinat.Permutations ( Permutation(..) )+import qualified Math.Combinat.Permutations as P++--------------------------------------------------------------------------------+-- * Types and instances++maxBraidWordLen :: Int+maxBraidWordLen = 600++maxStrands :: Int+maxStrands = 18         -- normal forms are very slow for large ones++shrinkBraid :: KnownNat n => Braid n -> [Braid n]+shrinkBraid (Braid gens) = map Braid list where+  len  = length gens+  list = [ take i gens ++ drop (i+1) gens | i<-[0..len-1] ]++-- someRndBraid :: Int -> (forall (n :: Nat). KnownNat n => g -> (Braid n, g)) -> g -> (SomeBraid, g)+-- someRndBraid n f = \g -> let (x,g') = f g in (someBraid n x, g')++-- | equality as /braid words/+(=:=) :: Braid n -> Braid n -> Bool+(=:=) (Braid gens1) (Braid gens2) = (gens1 == gens2)++data UnreducedBraid   = forall n. KnownNat n => Unreduced (Braid n)              +data ReducedBraid     = forall n. KnownNat n => Reduced   (Braid n)              +data PositiveBraid    = forall n. KnownNat n => PositiveB (Braid n)              +data PerturbedBraid   = forall n. KnownNat n => Perturbed (Braid n)   (Braid n)  +data PermutationBraid = forall n. KnownNat n => PermBraid Permutation (Braid n)  +data TwoBraids        = forall n. KnownNat n => TwoBraids (Braid n)   (Braid n)  ++deriving instance Show UnreducedBraid+deriving instance Show ReducedBraid+deriving instance Show PositiveBraid+deriving instance Show PerturbedBraid+deriving instance Show PermutationBraid+deriving instance Show TwoBraids++instance KnownNat n => Random (Braid n) where+  randomR _ = random+  random g0 = (b, g2) where+    n = numberOfStrands b+    (l,g1) = randomR (0,maxBraidWordLen) g0+    (b,g2) = randomBraidWord l g1++instance Random UnreducedBraid where+  randomR _ = random+  random = runRand $ do+    n <- randChoose (2,maxStrands)+    l <- randChoose (0,maxBraidWordLen)+    withSelectedM Unreduced (rand $ randomBraidWord l) n++instance Random PositiveBraid where+  randomR _ = random+  random  = runRand $ do+    n <- randChoose (2,maxStrands)+    l <- randChoose (0,maxBraidWordLen)+    withSelectedM PositiveB (rand $ randomPositiveBraidWord l) n++instance Random PerturbedBraid where+  randomR _ = random+  random  = runRand $ do+    Unreduced b <- rand random+    k <- randChoose (20,1000)+    c <- rand $ randomPerturbBraidWord k b +    return (Perturbed b c)++instance KnownNat n => Arbitrary (Braid n) where+  arbitrary = choose_+  shrink    = shrinkBraid++instance Arbitrary UnreducedBraid where+  arbitrary = choose_+  shrink (Unreduced b) = map Unreduced (shrinkBraid b)++instance Arbitrary PositiveBraid where+  arbitrary = choose_+  shrink (PositiveB b) = map PositiveB (shrinkBraid b)++instance Arbitrary ReducedBraid where+  arbitrary = do+    Unreduced braid <- arbitrary+    return $ Reduced $ freeReduceBraidWord braid++instance Arbitrary PerturbedBraid where+  arbitrary = choose_+  shrink _  = []++instance Arbitrary TwoBraids where+  shrink _  = []+  arbitrary = do+    n <- choose (2::Int, maxStrands)+    let snat = case someNatVal (fromIntegral n :: Integer) of+          Just sn -> sn+          Nothing -> error "TwoBraids/arbitrary: shouldn't happen"+    case snat of +      SomeNat pxy -> do+        (braid1,braid2) <- choosePair_+        return $ TwoBraids (asProxyTypeOf1 braid1 pxy) (asProxyTypeOf1 braid2 pxy)++mkPermBraid :: Permutation -> PermutationBraid+mkPermBraid perm = +  case snat of    +    SomeNat pxy -> PermBraid perm (asProxyTypeOf1 (permutationBraid perm) pxy)+  where+    n = P.permutationSize perm+    Just snat = someNatVal (fromIntegral n :: Integer)++instance Arbitrary PermutationBraid where+  arbitrary = do+    perm <- arbitrary+    return $ mkPermBraid perm+  shrink (PermBraid x b) = [ PermBraid (braidPermutation s) s | s <- shrinkBraid b ]++--------------------------------------------------------------------------------+-- * test groups++testgroup_Braid :: Test+testgroup_Braid = testGroup "Braid"+  +  [ testProperty "linking matrix is invariant of reduction"    prop_link_reduce +  , testProperty "linking matrix is invariant of perturbation" prop_link_perturb+  +  , testProperty "tau^2 = identity"                    prop_tau_square+  , testProperty "tau commutes with braidPermutation"  prop_permTau_1++  , testProperty "braidPermutation . permutationBraid = identity"  prop_permBraid_perm+  , testProperty "permutation braid is indeed a permutation braid" prop_permBraid_valid+  , testProperty "multiplication commutes with braidPermutation" prop_braidPerm_comp++  , testProperty "positive braids have positive links" prop_link_positive+  , testProperty "definition of linking"               prop_linking++  ] ++--------------------------------------------------------------------------------++testgroup_Braid_NF :: Test+testgroup_Braid_NF = testGroup "Braid/NF"+  +  [ testProperty "NF with naive inverse elimination == less naive inverse elimination"  prop_braidnf_naive+  , testProperty "NF with reduction == NF without reduction"                            prop_braidnf_reduce++  , testProperty "NF = NF of representative word of NF"   prop_braidnf_reprs+  , testProperty "NF = NF of perturbed word"              prop_braidnf_perturb++  , testProperty "linking of word == linking of representative of NF"   prop_braidnf_link++  , testProperty "NF of positive word is positive"   prop_braidnf_pos++  , testProperty "Lemma 2.5"   prop_lemma_2_5++  , testProperty "permutationBraid and tau commutes, up to NF"   prop_permTau_2+  ]++--------------------------------------------------------------------------------+-- * braid properties++prop_link_reduce :: UnreducedBraid -> Bool+prop_link_reduce (Unreduced braid) = linkingMatrix braid == linkingMatrix braid' where+  braid' = freeReduceBraidWord braid++prop_link_perturb :: PerturbedBraid -> Bool+prop_link_perturb (Perturbed braid1 braid2) = linkingMatrix braid1 == linkingMatrix braid2 ++prop_tau_square :: ReducedBraid -> Bool+prop_tau_square (Reduced braid) = braidWord (tau (tau braid)) == braidWord braid++prop_permTau_1 :: PermutationBraid -> Bool+prop_permTau_1 (PermBraid perm braid) = tauPerm perm == braidPermutation (tau braid)++prop_permBraid_perm :: PermutationBraid -> Bool+prop_permBraid_perm (PermBraid perm braid) = (braidPermutation braid == perm)++prop_permBraid_valid :: PermutationBraid -> Bool+prop_permBraid_valid (PermBraid perm braid) = isPermutationBraid braid++prop_braidPerm_comp :: TwoBraids -> Bool+prop_braidPerm_comp (TwoBraids b1 b2) = (p == q) where+  p = braidPermutation (compose b1 b2) +  q = braidPermutation b1 `P.multiply` braidPermutation b2++prop_link_positive :: PositiveBraid -> Bool+prop_link_positive (PositiveB braid) = all (>=0) $ elems $ linkingMatrix braid++prop_linking :: UnreducedBraid -> Bool+prop_linking (Unreduced braid) = (linkingMatrix braid == matrix) where+  n = numberOfStrands braid+  matrix = array ((1,1),(n,n)) [ ((i,j),strandLinking braid i j) | i<-[1..n], j<-[1..n] ]++--------------------------------------------------------------------------------++prop_braidnf_naive :: UnreducedBraid -> Bool+prop_braidnf_naive (Unreduced braid) = (braidNormalFormNaive' braid == braidNormalForm' braid)++prop_braidnf_reduce :: UnreducedBraid -> Bool+prop_braidnf_reduce (Unreduced braid) = (braidNormalForm' braid == braidNormalForm braid)++prop_braidnf_reprs :: ReducedBraid -> Bool+prop_braidnf_reprs (Reduced braid) = (nf == nf') where+  nf  = braidNormalForm braid +  nf' = braidNormalForm braid'+  braid' = nfReprWord nf++prop_braidnf_perturb :: PerturbedBraid -> Bool+prop_braidnf_perturb (Perturbed braid1 braid2) = (braidNormalForm braid1 == braidNormalForm braid2)++prop_braidnf_link :: UnreducedBraid -> Bool+prop_braidnf_link (Unreduced braid) = (linkingMatrix braid == linkingMatrix braid') where+  nf  = braidNormalForm braid +  braid' = nfReprWord nf++prop_braidnf_pos :: PositiveBraid -> Bool+prop_braidnf_pos (PositiveB braid) = (_nfDeltaExp (braidNormalForm braid) >= 0)+ +prop_lemma_2_5 :: Permutation -> Bool+prop_lemma_2_5 p = and [ check i | i<-[1..n-1] ] where+  n = P.permutationSize p+  w = _permutationBraid p+  s = permWordStartingSet n w+  check i = _isPermutationBraid n (i:w) == (not $ elem i s)++prop_permTau_2 :: PermutationBraid -> Bool+prop_permTau_2 (PermBraid perm braid) = (nf1 == nf2) where+  nf1 = braidNormalForm $ permutationBraid (tauPerm perm)+  nf2 = braidNormalForm $ tau braid++--------------------------------------------------------------------------------++

@@ -0,0 +1,35 @@+
+-- | Helper routines for tests
+
+{-# LANGUAGE Rank2Types #-}
+module Tests.Common where
+
+--------------------------------------------------------------------------------
+
+import Test.QuickCheck
+import Test.QuickCheck.Gen
+
+import System.Random
+
+--------------------------------------------------------------------------------
+
+-- | Generates a random element.
+choose_ :: Random a => Gen a
+choose_ = MkGen (\r _ -> let (x,_) = random r in x)
+
+-- | Generates two random elements 
+choosePair_ :: Random a => Gen (a,a)
+choosePair_ = do
+  x <- choose_
+  y <- choose_
+  return (x,y)
+
+-- | Generates a random element.
+myMkGen :: (forall g. RandomGen g => g -> (a,g)) -> Gen a
+myMkGen fun = MkGen (\r _ -> let (x,_) = fun r in x)
+
+-- | Generates a random element.
+myMkSizedGen :: (forall g. RandomGen g => Int -> g -> (a,g)) -> Gen a
+myMkSizedGen fun = MkGen (\r siz -> let (x,_) = fun siz r in x)
+
+--------------------------------------------------------------------------------

@@ -0,0 +1,111 @@++-- | Tests for lattice paths +--++{-# LANGUAGE CPP, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleContexts #-}+module Tests.LatticePaths where++--------------------------------------------------------------------------------++import Math.Combinat.LatticePaths++import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck+import System.Random++import Control.Monad++import Data.List  ++import Math.Combinat.Classes+import Math.Combinat.Helper+import Math.Combinat.Sign+import Math.Combinat.Numbers ( factorial , binomial )++--------------------------------------------------------------------------------+-- * instances++-- | Half-length of a Dyck path+newtype Half = Half Int deriving (Eq,Show)++-- | First number is (usually) less or equal than the second+data HalfPair = HalfPair Int Int deriving (Eq,Show)++maxHalfSize :: Int+maxHalfSize = 11     -- number of paths grow exponentially++instance Arbitrary Half where+  arbitrary = liftM Half $ choose (0,maxHalfSize)    ++instance Arbitrary HalfPair where+  arbitrary = do+    n <- choose (0,maxHalfSize)     +    k <- choose (0,n+1)+    return (HalfPair k n)++fi :: Int -> Integer+fi = fromIntegral++--------------------------------------------------------------------------------+-- * test group++testgroup_LatticePaths :: Test+testgroup_LatticePaths = testGroup "Lattice paths"+  +  [ testProperty "dyck paths are in reverse lexicographic order"      prop_revlex+  , testProperty "naive Dyck path algorithm = less naive algorithm"   prop_dyck_naive+  , testProperty "counting Dyck paths"                                prop_count+  , testProperty "counting Lattice paths"                             prop_count_lattice++  , testProperty "bounded Dyck paths, def, v1"                        prop_bounded_1+  , testProperty "bounded Dyck paths, def, v2"                        prop_bounded_2+  , testProperty "bounded Dyck paths w/ high bound = all dyck paths"  prop_not_bounded++  , testProperty "zero-touching Dyck paths"              prop_touching+  , testProperty "Dyck paths w/ k peaks"                 prop_peaking++  ]++--------------------------------------------------------------------------------+-- * test properties         ++prop_revlex :: Bool+prop_revlex = and [ sort (dyckPaths m) == reverse (dyckPaths m) | m <- [0..maxHalfSize] ]++prop_dyck_naive :: Bool+prop_dyck_naive = and [ sort (dyckPathsNaive m) == sort (dyckPaths m) | m <- [0..maxHalfSize] ]++prop_count :: Bool+prop_count = and [ fi (length (dyckPaths m)) == countDyckPaths m | m <- [0..maxHalfSize] ]++prop_count_lattice :: HalfPair -> Bool+prop_count_lattice (HalfPair y x) = fi (length (latticePaths (x,y))) == countLatticePaths (x,y)++prop_bounded_1 :: HalfPair -> Bool+prop_bounded_1 (HalfPair h m) = (one == two) where+  one = sort (boundedDyckPaths h m ) +  two = sort [ p | p <- dyckPaths m  , pathHeight p <= h ]+  +prop_bounded_2 :: Half -> Half -> Bool+prop_bounded_2 (Half h) (Half m) = (one == two) where+  one = sort (boundedDyckPaths h  m ) +  two = sort [ p | p <- dyckPaths m  , pathHeight p <= h  ]++prop_not_bounded :: Bool+prop_not_bounded = and [ sort (boundedDyckPaths m m) == sort (dyckPaths m) | m <- [0..maxHalfSize] ]++prop_touching :: HalfPair -> Bool+prop_touching (HalfPair k m) = (one == two && fi (length one) == cnt) where+  one = sort (touchingDyckPaths k m) +  two = sort [ p | p <- dyckPaths m , pathNumberOfZeroTouches p == k ]+  cnt = countTouchingDyckPaths k m++prop_peaking :: HalfPair -> Bool+prop_peaking (HalfPair k m) = (one == two && fi (length one) == cnt) where+  one = sort (peakingDyckPaths k m) +  two = sort [ p | p <- dyckPaths m , pathNumberOfPeaks p == k ]+  cnt = countPeakingDyckPaths k m++--------------------------------------------------------------------------------+

@@ -0,0 +1,107 @@++-- | Tests for integer partitions.++{-# LANGUAGE CPP, BangPatterns #-}+module Tests.Partitions.Integer where++--------------------------------------------------------------------------------++import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck++import Tests.Common++import Math.Combinat.Partitions.Integer++import Data.List+import Control.Monad++-- import Data.Map (Map)+-- import qualified Data.Map as Map++import Math.Combinat.Classes+import Math.Combinat.Numbers ( factorial , binomial , multinomial )+import Math.Combinat.Helper++--------------------------------------------------------------------------------+-- * Types and instances++newtype PartitionWeight     = PartitionWeight     Int              deriving (Eq,Show)+data    PartitionWeightPair = PartitionWeightPair Int Int          deriving (Eq,Show)+data    PartitionIntPair    = PartitionIntPair    Partition Int    deriving (Eq,Show)++maxPartitionSize :: Int+maxPartitionSize = 44++instance Arbitrary Partition where+  arbitrary = do+    n <- choose (0,maxPartitionSize)+    myMkGen (randomPartition n)++instance Arbitrary PartitionWeight where+  arbitrary = liftM PartitionWeight $ choose (0,maxPartitionSize)++instance Arbitrary PartitionWeightPair where+  arbitrary = do+    n <- choose (0,maxPartitionSize)+    k <- choose (0,n+2)+    return (PartitionWeightPair n k)++instance Arbitrary PartitionIntPair where+  arbitrary = do+    part <- arbitrary+    k <- choose (0,partitionWeight part + 2)+    return (PartitionIntPair part k)++--------------------------------------------------------------------------------+-- * test group++testgroup_IntegerPartitions :: Test+testgroup_IntegerPartitions = testGroup "Integer Partitions"  ++  [ testProperty "partitions in a box"             prop_partitions_in_bigbox+  , testProperty "partitions with k parts"         prop_kparts+  , testProperty "odd partitions"                  prop_odd_partitions +  , testProperty "partitions with distinct parts"  prop_distinct_partitions  +  , testProperty "subpartitions"                   prop_subparts+  , testProperty "dual^2 is identity"              prop_dual_dual+  , testProperty "dominated partitions"            prop_dominated_list+  , testProperty "dominating partitions"           prop_dominating_list+  , testProperty "counting partitions"             prop_countParts+  ]++--------------------------------------------------------------------------------+-- * properties++prop_partitions_in_bigbox :: PartitionWeight -> Bool+prop_partitions_in_bigbox (PartitionWeight n) = (partitions n == partitions' (n,n) n)++prop_kparts :: PartitionWeightPair -> Bool+prop_kparts (PartitionWeightPair n k) = (partitionsWithKParts k n == [ mu | mu <- partitions n, numberOfParts mu == k ])++prop_odd_partitions :: PartitionWeight -> Bool+prop_odd_partitions (PartitionWeight n) = +  (partitionsWithOddParts n == [ mu | mu <- partitions n, and (map odd (fromPartition mu)) ])++prop_distinct_partitions :: PartitionWeight -> Bool+prop_distinct_partitions (PartitionWeight n) = +  (partitionsWithDistinctParts n == [ mu | mu <- partitions n, let xs = fromPartition mu, xs == nub xs ])++prop_subparts :: PartitionIntPair -> Bool+prop_subparts (PartitionIntPair lam d) = (subPartitions d lam) == sort [ p | p <- partitions d, isSubPartitionOf p lam ]++prop_dual_dual :: Partition -> Bool+prop_dual_dual lam = (lam == dualPartition (dualPartition lam))++prop_dominated_list :: Partition -> Bool+prop_dominated_list lam = (dominatedPartitions  lam == [ mu  | mu  <- partitions (weight lam), lam `dominates` mu ])++prop_dominating_list :: Partition -> Bool+prop_dominating_list mu  = (dominatingPartitions mu  == [ lam | lam <- partitions (weight mu ), lam `dominates` mu ])++prop_countParts :: Bool+prop_countParts = (take 50 partitionCountList == take 50 partitionCountListNaive)++--------------------------------------------------------------------------------+

@@ -0,0 +1,85 @@++-- | Tests for skew partitions.+--++{-# LANGUAGE CPP, BangPatterns #-}+module Tests.Partitions.Skew where++--------------------------------------------------------------------------------++import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck++import Tests.Common+import Tests.Partitions.Integer ()     -- Arbitrary instances++import Math.Combinat.Partitions.Integer+import Math.Combinat.Partitions.Skew++import Data.List++import Math.Combinat.Classes++--------------------------------------------------------------------------------+-- * instances++instance Arbitrary SkewPartition where+  arbitrary = do+    p <- arbitrary+    let n = partitionWeight p+    d <- choose (0,n)+    let qs = subPartitions d p+        ln = length qs+    k <- choose (0,ln-1)+    let q = qs !! k+    return $ mkSkewPartition (p,q) ++--------------------------------------------------------------------------------+-- * test group++testgroup_SkewPartitions :: Test+testgroup_SkewPartitions = testGroup "Skew Partitions"  ++  [ testProperty "dual^2 = identity"              prop_dual_dual+  , testProperty "dual vs. inner/outer dual"      prop_dual_from+  , testProperty "to . from = identity"           prop_from_to+  , testProperty "from . to = identity"           prop_to_from+  , testProperty "from . to . from = from"        prop_from_to_from+  , testProperty "weight vs. inner/outer weight"  prop_weight+  ]++--------------------------------------------------------------------------------+-- * properties++prop_dual_dual :: SkewPartition -> Bool+prop_dual_dual sp = (dualSkewPartition (dualSkewPartition sp) == sp)++prop_dual_from :: SkewPartition -> Bool+prop_dual_from sp = (p == dual p' && q == dual q') where+  (p,q)   = fromSkewPartition sp+  sp'     = dualSkewPartition sp+  (p',q') = fromSkewPartition sp'++prop_from_to :: SkewPartition -> Bool+prop_from_to sp = (mkSkewPartition (fromSkewPartition sp) == sp)++prop_to_from :: (Partition,Partition) -> Bool+prop_to_from (p,q) = +  case mb of+    Nothing -> True+    Just sp -> fromSkewPartition sp == (p,q)+  where+    mb = safeSkewPartition (p,q)++prop_from_to_from :: SkewPartition -> Bool+prop_from_to_from sp = (pq == pq') where+  pq  = fromSkewPartition sp+  sp' = mkSkewPartition pq+  pq' = fromSkewPartition sp'++prop_weight :: SkewPartition -> Bool+prop_weight sp = (skewPartitionWeight sp == weight p - weight q) where+  (p,q) = fromSkewPartition sp++--------------------------------------------------------------------------------

@@ -0,0 +1,219 @@++-- | Tests for permutations. +--++{-# LANGUAGE CPP, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleContexts #-}+module Tests.Permutations where++--------------------------------------------------------------------------------++import Math.Combinat.Permutations++import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck+import System.Random++import Control.Monad+import Control.Monad.ST++import Data.List hiding (permutations)++import Data.Array (Array)+import Data.Array.ST+import Data.Array.Unboxed+import Data.Array.IArray+import Data.Array.MArray+import Data.Array.Unsafe++import Math.Combinat.ASCII+import Math.Combinat.Classes+import Math.Combinat.Helper+import Math.Combinat.Sign+import Math.Combinat.Numbers (factorial,binomial)++--------------------------------------------------------------------------------+-- * generating permutations (random & arbitrary instances, spec types etc)++minPermSize = 1+maxPermSize = 123++newtype Elem = Elem Int deriving Eq+newtype Nat  = Nat { fromNat :: Int } deriving (Eq,Ord,Show,Num,Random)++naturalSet :: Permutation -> Array Int Elem+naturalSet perm = listArray (1,n) [ Elem i | i<-[1..n] ] where+  n = permutationSize perm++permInternalSet :: Permutation -> Array Int Elem+permInternalSet perm@(Permutation arr) = listArray (1,n) [ Elem (arr!i) | i<-[1..n] ] where+  n = permutationSize perm++sameSize :: Permutation ->  Permutation -> Bool+sameSize perm1 perm2 = ( permutationSize perm1 == permutationSize perm2)++newtype CyclicPermutation = Cyclic { fromCyclic :: Permutation } deriving Show++data SameSize = SameSize Permutation Permutation deriving Show++instance Random Permutation where+  random g = randomPermutation size g1 where+    (size,g1) = randomR (minPermSize,maxPermSize) g+  randomR _ = random++instance Random CyclicPermutation where+  random g = (Cyclic cycl,g2) where+    (size,g1) = randomR (minPermSize,maxPermSize) g+    (cycl,g2) = randomCyclicPermutation size g1+  randomR _ = random++instance Random DisjointCycles where+  random g = (disjcyc,g2) where+    (size,g1) = randomR (minPermSize,maxPermSize) g+    (perm,g2) = randomPermutation size g1+    disjcyc   = permutationToDisjointCycles perm+  randomR _ = random++instance Random SameSize where+  random g = (SameSize prm1 prm2, g3) where+    (size,g1) = randomR (minPermSize,maxPermSize) g+    (prm1,g2) = randomPermutation size g1 +    (prm2,g3) = randomPermutation size g2+  randomR _ = random++instance Arbitrary Nat where+  arbitrary = choose (Nat 0 , Nat 50)+     +instance Arbitrary Permutation       where arbitrary = choose undefined+instance Arbitrary CyclicPermutation where arbitrary = choose undefined+instance Arbitrary DisjointCycles    where arbitrary = choose undefined+instance Arbitrary SameSize          where arbitrary = choose undefined++--------------------------------------------------------------------------------+-- * test group++testgroup_Permutations :: Test+testgroup_Permutations = testGroup "Permutations"+  +  [ testProperty "disjoint cycles /1" prop_disjcyc_1+  , testProperty "disjoint cycles /2" prop_disjcyc_2 ++  , testProperty "disjoint cycles compatibility" prop_disjcyc_Mathematica++  , testProperty "random cyclic permutation is indeed cyclic" prop_randCyclic+  , testProperty "inverse^2 is identity"                      prop_inverse++  , testProperty "permutation action is group action"              prop_mulPerm+  , testProperty "left permutation action is left group action"    prop_mulPermLeft+  , testProperty "right permutation action is right group action"  prop_mulPermRight++  , testProperty "permutation action convetion"        prop_perm+  , testProperty "left permutation action convention"  prop_permLeft+  , testProperty "right permutation action convention" prop_permRight+  , testProperty "left/right permutation action convention" prop_permLeftRight++  , testProperty "cycle left"  prop_cycleLeft+  , testProperty "cycle right" prop_cycleRight++  , testProperty "sign of permutation is multiplicative"     prop_mulSign      +  , testProperty "inverse is compatible with multiplication" prop_invMul++  , testProperty "parity of cyclic permutaiton" prop_cyclSign+  , testProperty "random permutation is valid"  prop_permIsPerm+  , testProperty "definition of parity"         prop_isEven++  , testProperty "bubbleSort works"    prop_bubbleSort+  , testProperty "bubbleSort2 works"   prop_bubbleSort2+  , testProperty "number of inversions = steps in bubble sort"         prop_bubble_inversions+  , testProperty "number of inversions = actual number of inversions"  prop_number_inversions +  , testProperty "number of inversions is the same for the inverse permutation"  prop_ninversions_inverse+  , testProperty "merge sort algorithm = naive inversion count"                  prop_merge_inversions++  ]++--------------------------------------------------------------------------------+-- * test properties+          +prop_disjcyc_1 perm = ( perm == disjointCyclesToPermutation n (permutationToDisjointCycles perm) )+  where n = permutationSize perm++prop_disjcyc_2 k dcyc = ( dcyc == permutationToDisjointCycles (disjointCyclesToPermutation n dcyc) )+  where +    n = fromNat k + m +    m = case fromDisjointCycles dcyc of+      []  -> 1+      xxs -> maximum (concat xxs)++-- PermutationCycles[ { 12, 15, 5, 6, 2, 7, 17, 9, 20, 3, 11, 18, 22, 21, 8, 10, 4, 19, 14, 16, 23, 1, 13 } ]+-- Cycles           [ {{1, 12, 18, 19, 14, 21, 23, 13, 22}, {2, 15, 8, 9, 20, 16, 10, 3, 5}, {4, 6, 7, 17}} ]+prop_disjcyc_Mathematica = (permutationToDisjointCycles   perm == disjcyc) +                        && (disjointCyclesToPermutation n disjcyc == perm)+  where+    n       = permutationSize perm+    perm    = toPermutation  [ 12, 15, 5, 6, 2, 7, 17, 9, 20, 3, 11, 18, 22, 21, 8, 10, 4, 19, 14, 16, 23, 1, 13 ]+    disjcyc = DisjointCycles [ [1, 12, 18, 19, 14, 21, 23, 13, 22], [2, 15, 8, 9, 20, 16, 10, 3, 5], [4, 6, 7, 17] ]++xperm    = toPermutation  [ 12, 15, 5, 6, 2, 7, 17, 9, 20, 3, 11, 18, 22, 21, 8, 10, 4, 19, 14, 16, 23, 1, 13 ]+xdisjcyc = DisjointCycles [ [1, 12, 18, 19, 14, 21, 23, 13, 22], [2, 15, 8, 9, 20, 16, 10, 3, 5], [4, 6, 7, 17] ]++prop_randCyclic cycl = ( isCyclicPermutation (fromCyclic cycl) )++prop_inverse perm = ( perm == inverse (inverse perm) ) ++prop_mulPerm (SameSize perm1 perm2) = +    ( permute perm2 (permute perm1 set) == permute (perm1 `multiply` perm2) set ) +  where +    set = naturalSet perm1++prop_mulPermRight (SameSize perm1 perm2) = +    ( permuteRight perm2 (permuteRight perm1 set) == permuteRight (perm1 `multiply` perm2) set ) +  where +    set = naturalSet perm1++prop_mulPermLeft (SameSize perm1 perm2) = +    ( permuteLeft perm2 (permuteLeft perm1 set) == permuteLeft (perm2 `multiply` perm1) set ) +  where +    set = naturalSet perm1++prop_perm          perm = permute perm (naturalSet perm) == permInternalSet perm+prop_permLeft      perm = permuteLeft  perm (permInternalSet perm) == naturalSet perm+prop_permRight     perm = permuteRight perm (naturalSet perm) == permInternalSet perm+prop_permLeftRight perm = permuteLeft (inverse perm) (naturalSet perm) == permuteRight (perm) (naturalSet perm) ++prop_cycleLeft  = permuteList (cycleLeft  5) "abcde" == "bcdea"+prop_cycleRight = permuteList (cycleRight 5) "abcde" == "eabcd"++prop_mulSign (SameSize perm1 perm2) = +    ( sgn perm1 * sgn perm2 == sgn (perm1 `multiply` perm2) ) +  where +    sgn = signValue . signOfPermutation :: Permutation -> Int++prop_invMul (SameSize perm1 perm2) =   +  ( inverse perm2 `multiply` inverse perm1 == inverse (perm1 `multiply` perm2) ) ++prop_cyclSign cycl = ( isEvenPermutation perm == odd n ) where+  perm = fromCyclic cycl+  n = permutationSize perm+  +prop_permIsPerm perm = ( isPermutation (fromPermutation perm) ) ++prop_isEven perm = ( isEvenPermutation perm == isEvenAlternative perm ) where+  isEvenAlternative p = +    even $ sum $ map (\x->x-1) $ map length $ fromDisjointCycles $ permutationToDisjointCycles p++prop_bubbleSort perm = multiplyMany' n (map (adjacentTransposition n) $ bubbleSort perm) == perm where+  n = permutationSize perm++prop_bubbleSort2 perm = multiplyMany' n (map (transposition n) $ bubbleSort2 perm) == perm where+  n = permutationSize perm++prop_bubble_inversions perm = length (bubbleSort perm) == numberOfInversions perm++prop_number_inversions perm = length (inversions perm) == numberOfInversions perm++prop_ninversions_inverse perm = numberOfInversions perm == numberOfInversions (inverse perm)++prop_merge_inversions perm = (numberOfInversionsMerge perm == numberOfInversionsNaive perm)++--------------------------------------------------------------------------------+

@@ -0,0 +1,303 @@++-- | Tests for power series+--++{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}+module Tests.Series where++--------------------------------------------------------------------------------++import Math.Combinat.Numbers.Series++import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck+import System.Random++import Data.List++import Math.Combinat.Sign+import Math.Combinat.Numbers+import Math.Combinat.Partitions.Integer+import Math.Combinat.Helper++--------------------------------------------------------------------------------+-- * code used only for tests++-- | Expansion of @1 / (1-x^k)@. Included for completeness only; +-- it equals to @coinSeries [k]@, and for example+-- for @k=4@ it is simply+-- +-- > [1,0,0,0,1,0,0,0,1,0,0,0,1,0,0,0,1,0,0...]+--+pseries1 :: Int -> [Integer]+pseries1 k1 = convolveWithPSeries1 k1 unitSeries ++-- | The expansion of @1 / (1-x^k_1-x^k_2)@+pseries2 :: Int -> Int -> [Integer]+pseries2 k1 k2 = convolveWithPSeries2 k1 k2 unitSeries ++-- | The expansion of @1 / (1-x^k_1-x^k_2-x^k_3)@+pseries3 :: Int -> Int -> Int -> [Integer]+pseries3 k1 k2 k3 = convolveWithPSeries3 k1 k2 k3 unitSeries++--------------------------------------------------------------------------------++-- | Convolve with (the expansion of) @1 / (1-x^k1)@+convolveWithPSeries1 :: Int -> [Integer] -> [Integer]+convolveWithPSeries1 k1 series1 = xs where+  series = series1 ++ repeat 0 +  xs = zipWith (+) series ( replicate k1 0 ++ xs )++-- | Convolve with (the expansion of) @1 / (1-x^k1-x^k2)@+convolveWithPSeries2 :: Int -> Int -> [Integer] -> [Integer]+convolveWithPSeries2 k1 k2 series1 = xs where+  series = series1 ++ repeat 0 +  xs = zipWith3 (\x y z -> x + y + z)+    series+    ( replicate k1 0 ++ xs )+    ( replicate k2 0 ++ xs )+    +-- | Convolve with (the expansion of) @1 / (1-x^k_1-x^k_2-x^k_3)@+convolveWithPSeries3 :: Int -> Int -> Int -> [Integer] -> [Integer]+convolveWithPSeries3 k1 k2 k3 series1 = xs where+  series = series1 ++ repeat 0 +  xs = zipWith4 (\x y z w -> x + y + z + w)+    series+    ( replicate k1 0 ++ xs )+    ( replicate k2 0 ++ xs )+    ( replicate k3 0 ++ xs )++--------------------------------------------------------------------------------++-- | @1 / (1 - a*x^k)@. +-- For example, for @a=3@ and @k=2@ it is just+-- +-- > [1,0,3,0,9,0,27,0,81,0,243,0,729,0,2187,0,6561,0,19683,0...]+--+pseries1' :: Num a => (a,Int) -> [a]+pseries1' ak1 = convolveWithPSeries1' ak1 unitSeries++-- | @1 / (1 - a_1*x^k_1 - a_2*x^k_2)@+pseries2' :: Num a => (a,Int) -> (a,Int) -> [a]+pseries2' ak1 ak2 = convolveWithPSeries2' ak1 ak2 unitSeries++-- | @1 / (1 - a_1*x^k_1 - a_2*x^k_2 - a_3*x^k_3)@+pseries3' :: Num a => (a,Int) -> (a,Int) -> (a,Int) -> [a]+pseries3' ak1 ak2 ak3 = convolveWithPSeries3' ak1 ak2 ak3 unitSeries++--------------------------------------------------------------------------------++-- | Convolve with @1 / (1 - a*x^k)@. +convolveWithPSeries1' :: Num a => (a,Int) -> [a] -> [a]+convolveWithPSeries1' (a1,k1) series1 = xs where+  series = series1 ++ repeat 0 +  xs = zipWith (+)+    series+    ( replicate k1 0 ++ map (*a1) xs )++-- | Convolve with @1 / (1 - a_1*x^k_1 - a_2*x^k_2)@+convolveWithPSeries2' :: Num a => (a,Int) -> (a,Int) -> [a] -> [a]+convolveWithPSeries2' (a1,k1) (a2,k2) series1 = xs where+  series = series1 ++ repeat 0 +  xs = zipWith3 (\x y z -> x + y + z)+    series+    ( replicate k1 0 ++ map (*a1) xs )+    ( replicate k2 0 ++ map (*a2) xs )+    +-- | Convolve with @1 / (1 - a_1*x^k_1 - a_2*x^k_2 - a_3*x^k_3)@+convolveWithPSeries3' :: Num a => (a,Int) -> (a,Int) -> (a,Int) -> [a] -> [a]+convolveWithPSeries3' (a1,k1) (a2,k2) (a3,k3) series1 = xs where+  series = series1 ++ repeat 0 +  xs = zipWith4 (\x y z w -> x + y + z + w)+    series+    ( replicate k1 0 ++ map (*a1) xs )+    ( replicate k2 0 ++ map (*a2) xs )+    ( replicate k3 0 ++ map (*a3) xs )++--------------------------------------------------------------------------------+-- * Types and instances++{-+swap :: (a,b) -> (b,a)+swap (x,y) = (y,x)+-}++-- compare the first 500 elements of the infinite lists+(=!=) :: (Eq a, Num a) => [a] -> [a] -> Bool+(=!=) xs1 ys1 = (take m xs == take m ys) where +  m = 500+  xs = xs1 ++ repeat 0+  ys = ys1 ++ repeat 0++infix 4 =!=++newtype Nat = Nat { fromNat :: Int } deriving (Eq,Ord,Show,Num,Random)+newtype Ser = Ser { fromSer :: [Integer] } deriving (Eq,Ord,Show)+newtype Exp  = Exp  { fromExp  ::  Int  } deriving (Eq,Ord,Show,Num,Random)+newtype Exps = Exps { fromExps :: [Int] } deriving (Eq,Ord,Show)+newtype CoeffExp  = CoeffExp  { fromCoeffExp  ::  (Integer,Int)  } deriving (Eq,Ord,Show)+newtype CoeffExps = CoeffExps { fromCoeffExps :: [(Integer,Int)] } deriving (Eq,Ord,Show)++minSerSize = 0    :: Int+maxSerSize = 1000 :: Int++minSerValue = -10000 :: Int+maxSerValue =  10000 :: Int++rndList :: (RandomGen g, Random a) => Int -> (a, a) -> g -> ([a], g)+rndList n minmax g = swap $ mapAccumL f g [1..n] where+  f g _ = swap $ randomR minmax g ++instance Arbitrary Nat where+  arbitrary = choose (Nat 0 , Nat 750)++instance Arbitrary Exp where+  arbitrary = choose (Exp 1 , Exp 32)++instance Arbitrary CoeffExp where+  arbitrary = do+    coeff <- choose (minSerValue, maxSerValue) :: Gen Int+    exp   <- arbitrary :: Gen Exp+    return $ CoeffExp (fromIntegral coeff, fromExp exp)+   +instance Random Ser where+  random g = (Ser $ map fi list, g2) where+    (size,g1) = randomR (minSerSize,maxSerSize) g+    (list,g2) = rndList size (minSerValue,maxSerValue) g1+    fi :: Int -> Integer+    fi = fromIntegral +  randomR _ = random++instance Random Exps where+  random g = (Exps list, g2) where+    (size,g1) = randomR (0,10) g+    (list,g2) = rndList size (1,32) g1+  randomR _ = random++instance Random CoeffExps where+  random g = (CoeffExps (zip (map fromIntegral list2) list1), g3) where+    (size,g1) = randomR (0,10) g+    (list1,g2) = rndList size (1,32) g1+    (list2,g3) = rndList size (minSerValue,maxSerValue) g2+  randomR _ = random+  +instance Arbitrary Ser where+  arbitrary = choose undefined++instance Arbitrary Exps where+  arbitrary = choose undefined++instance Arbitrary CoeffExps where+  arbitrary = choose undefined++--------------------------------------------------------------------------------+-- * test group++testgroup_PowerSeries :: Test+testgroup_PowerSeries = testGroup "Power series"+  [ +    testProperty "convPSeries1 vs generic"     prop_conv1_vs_gen+  , testProperty "convPSeries2 vs generic"     prop_conv2_vs_gen+  , testProperty "convPSeries3 vs generic"     prop_conv3_vs_gen+  , testProperty "convPSeries1' vs generic"    prop_conv1_vs_gen'+  , testProperty "convPSeries2' vs generic"    prop_conv2_vs_gen'+  , testProperty "convPSeries3' vs generic"    prop_conv3_vs_gen'+  , testProperty "convolve_pseries"            prop_convolve_pseries +  , testProperty "convolve_pseries'"           prop_convolve_pseries' +  , testProperty "coinSeries vs pseries"       prop_coin_vs_pseries+  , testProperty "coinSeries vs pseries'"      prop_coin_vs_pseries'++    -- these are very slow, because random is slow+  , testProperty "leftIdentity"    prop_leftIdentity+  , testProperty "rightIdentity"   prop_rightIdentity+  , testProperty "commutativity"   prop_commutativity+  , testProperty "associativity"   prop_associativity+  ]++--------------------------------------------------------------------------------+-- * properties+     +prop_leftIdentity ser = ( xs =!= unitSeries `convolve` xs ) where +  xs = fromSer ser ++prop_rightIdentity ser = ( unitSeries `convolve` xs =!= xs ) where +  xs = fromSer ser ++prop_commutativity ser1 ser2 = ( xs `convolve` ys =!= ys `convolve` xs ) where +  xs = fromSer ser1+  ys = fromSer ser2++prop_associativity ser1 ser2 ser3 = ( one =!= two ) where+  one = (xs `convolve` ys) `convolve` zs+  two = xs `convolve` (ys `convolve` zs)+  xs = fromSer ser1+  ys = fromSer ser2+  zs = fromSer ser3+  +prop_conv1_vs_gen exp1 ser = ( one =!= two ) where+  one = convolveWithPSeries1 k1 xs +  two = convolveWithPSeries [k1] xs+  k1 = fromExp exp1+  xs = fromSer ser  ++prop_conv2_vs_gen exp1 exp2 ser = (one =!= two) where+  one = convolveWithPSeries2 k1 k2 xs +  two = convolveWithPSeries [k2,k1] xs+  k1 = fromExp exp1+  k2 = fromExp exp2+  xs = fromSer ser  ++prop_conv3_vs_gen exp1 exp2 exp3 ser = (one =!= two) where+  one = convolveWithPSeries3 k1 k2 k3 xs +  two = convolveWithPSeries [k2,k3,k1] xs+  k1 = fromExp exp1+  k2 = fromExp exp2+  k3 = fromExp exp3+  xs = fromSer ser  ++prop_conv1_vs_gen' exp1 ser = ( one =!= two ) where+  one = convolveWithPSeries1' ak1 xs +  two = convolveWithPSeries' [ak1] xs+  ak1 = fromCoeffExp exp1+  xs = fromSer ser  ++prop_conv2_vs_gen' exp1 exp2 ser = (one =!= two) where+  one = convolveWithPSeries2' ak1 ak2 xs +  two = convolveWithPSeries' [ak2,ak1] xs+  ak1 = fromCoeffExp exp1+  ak2 = fromCoeffExp exp2+  xs = fromSer ser  ++prop_conv3_vs_gen' exp1 exp2 exp3 ser = (one =!= two) where+  one = convolveWithPSeries3' ak1 ak2 ak3 xs +  two = convolveWithPSeries' [ak2,ak3,ak1] xs+  ak1 = fromCoeffExp exp1+  ak2 = fromCoeffExp exp2+  ak3 = fromCoeffExp exp3+  xs = fromSer ser  ++prop_convolve_pseries exps1 ser = (one =!= two) where+  one = convolveWithPSeries ks1 xs +  two = xs `convolve` pseries ks1 +  ks1 = fromExps exps1+  xs = fromSer ser  ++prop_convolve_pseries' cexps1 ser = (one =!= two) where+  one = convolveWithPSeries' aks1 xs +  two = xs `convolve` pseries' aks1 +  aks1 = fromCoeffExps cexps1+  xs = fromSer ser  ++prop_coin_vs_pseries exps1 = (one =!= two) where+  one = coinSeries ks1 +  two = convolveMany (map pseries1 ks1)+  ks1 = fromExps exps1++prop_coin_vs_pseries' cexps1 = (one =!= two) where+  one = coinSeries' aks1 +  two = convolveMany (map pseries1' aks1)+  aks1 = fromCoeffExps cexps1+    +--------------------------------------------------------------------------------+

@@ -0,0 +1,103 @@+
+-- | Tests for skew tableaux
+
+{-# LANGUAGE FlexibleInstances #-}
+module Tests.SkewTableaux where
+
+--------------------------------------------------------------------------------
+
+import Control.Monad
+
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+import Test.QuickCheck
+import Test.QuickCheck.Gen
+
+import Tests.Partitions.Integer ()
+import Tests.Partitions.Skew    ()      -- arbitrary instances
+
+import Math.Combinat.Tableaux
+import Math.Combinat.Tableaux.Skew
+import Math.Combinat.Partitions.Integer
+import Math.Combinat.Partitions.Skew
+
+--------------------------------------------------------------------------------
+-- * code
+
+numberOfNonEmptyRows :: SkewPartition -> Int
+numberOfNonEmptyRows (SkewPartition xys) = length [ True | (x,y) <- xys, y/=0 ]
+
+-- | Breaks a skew partition into disjoint parts
+disjointParts :: SkewPartition -> [SkewPartition]
+disjointParts (SkewPartition xys) = map normalizeSkewPartition list where
+
+  list = map SkewPartition $ filter (not . isEmpty) $ break xys
+
+  isEmpty :: [(Int,Int)] -> Bool
+  isEmpty xys = and [ y==0 | (x,y) <- xys ]
+
+  break :: [(Int,Int)] -> [[(Int,Int)]]
+  break []   = [[]]
+  break [xy] = [[xy]]
+  break ( xy@(x,y) : rest@((x',y'):_) ) = if x >= x'+y' 
+    then [xy] : break rest
+    else let (     xys  : rest' ) = break rest
+         in  ( (xy:xys) : rest' )
+  
+  
+
+
+--------------------------------------------------------------------------------
+-- * instances 
+
+instance Arbitrary (SkewTableau Int) where
+  arbitrary = do
+    shape <- arbitrary
+    let w = skewPartitionWeight shape
+    content <- replicateM w $ choose (1,1000)
+    return $ fillSkewPartitionWithRowWord shape content
+
+--------------------------------------------------------------------------------
+-- * test group
+
+testgroup_SkewTableaux :: Test
+testgroup_SkewTableaux = testGroup "Skew tableaux"
+  [ testProperty "dual^2 = identity"            prop_skew_dual_dual
+  , testProperty "fill . rowWord = identity"    prop_rowWord
+  , testProperty "fill . columnWord = identity" prop_columnWord
+  , testProperty "fill respectes the shape"     prop_fill_shape 
+  , testProperty "semistandard skew tableaux are indeed semistandard"   prop_semistandard 
+  ]
+
+--------------------------------------------------------------------------------
+-- * properties
+
+prop_skew_dual_dual :: SkewTableau Int -> Bool
+prop_skew_dual_dual st = (dualSkewTableau (dualSkewTableau st) == st)
+
+prop_rowWord :: SkewTableau Int -> Bool
+prop_rowWord st = (fillSkewPartitionWithRowWord shape content == st) where
+  shape   = skewTableauShape st
+  content = skewTableauRowWord st
+
+prop_columnWord :: SkewTableau Int -> Bool
+prop_columnWord st = (fillSkewPartitionWithColumnWord shape content == st) where
+  shape   = skewTableauShape st
+  content = skewTableauColumnWord st
+
+prop_fill_shape :: SkewPartition -> Bool
+prop_fill_shape shape = (shape == shape') where
+  tableau = fillSkewPartitionWithColumnWord shape [1..]
+  shape'  = skewTableauShape tableau
+
+prop_semistandard :: SkewPartition -> Bool
+prop_semistandard shape = and 
+  [ isSemiStandardSkewTableau st 
+  | n  <- [kk..nn] 
+  , st <- take 500 (semiStandardSkewTableaux n shape)         -- we only take the first 500 because impossibly slow otherwise
+  ]
+  where
+    nn = min (kk + 10) (skewPartitionWeight shape)
+    kk = maximum $ 0 : (map numberOfNonEmptyRows $ disjointParts shape)
+
+--------------------------------------------------------------------------------

@@ -0,0 +1,134 @@++-- | Tests for Thompson's group F+--++{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances, TypeSynonymInstances #-}+module Tests.Thompson where++--------------------------------------------------------------------------------++import Prelude hiding ( (**) )+import Control.Monad+import Data.List++import Math.Combinat.Groups.Thompson.F+import qualified Math.Combinat.Trees.Binary as B++import Tests.Common++import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck+import System.Random++import Math.Combinat.Helper+++--------------------------------------------------------------------------------+-- * code++(**) :: TDiag -> TDiag -> TDiag+(**) x y = x `compose` y++(//) :: TDiag -> TDiag -> TDiag+(//) x y = x `compose` (inverse y)++growth_n_sphere     = [1,4,12,36,108,314,906,2576,7280,20352] :: [Int]+growth_pos_n_sphere = [1,2, 4, 9, 20, 45,101, 227, 510, 1146] :: [Int]++--------------------------------------------------------------------------------+-- * instances++-- | A pair of trees with the same size+data TPair = TPair !T !T deriving (Eq,Show)++newtype Unreduced = Unreduced TDiag deriving (Eq,Show)++instance Arbitrary T where+  arbitrary = liftM fromBinTree $ myMkSizedGen B.randomBinaryTree++instance Arbitrary TPair where+  arbitrary = myMkSizedGen $ \siz -> runRand $ do+    t1 <- rand (B.randomBinaryTree siz)+    t2 <- rand (B.randomBinaryTree siz)+    return $ TPair (fromBinTree t1) (fromBinTree t2)++instance Arbitrary TDiag where+  arbitrary = do +    TPair t1 t2 <- arbitrary+    return $ mkTDiag t1 t2++instance Arbitrary Unreduced where+  arbitrary = do +    TPair t1 t2 <- arbitrary+    return $ Unreduced $ mkTDiagDontReduce t1 t2++--------------------------------------------------------------------------------+-- * test group++testgroup_ThompsonF :: Test+testgroup_ThompsonF = testGroup "Thompson's group F"+  [ testProperty "identity element"                    prop_identity+  , testProperty "associativity"                       prop_assoc+  , testProperty "standard relations"                  prop_relations+  , testProperty "quotient of positives"               prop_quot_positive+  , testProperty "telescopic product"                  prop_telescope+  , testProperty "cyclic telescopic product (3)"       prop_cyclic_product_3+  , testProperty "cyclic telescopic product (4)"       prop_cyclic_product_4+  , testProperty "positive diagrams form a monoid"     prop_positive_product+  , testProperty "composition commutes with reduction" prop_reduce_composition+  , testProperty "inverse commutes with reduction"     prop_reduce_inverse+  ]++--------------------------------------------------------------------------------+-- * properties+    +prop_relations :: Bool+prop_relations = and [ rel k n | n<-[1..30] , k<-[0..n-1] ] where+  rel k n = (inverse $ xk k) `compose` (xk n) `compose` (xk k) == xk (n+1)++prop_quot_positive :: TPair -> Bool+prop_quot_positive (TPair t1 t2) = (mkTDiag t1 t2) == (positive t1 // positive t2)++prop_identity :: TDiag -> Bool+prop_identity x = (x ** identity) == x && (identity ** x) == x++prop_assoc :: TDiag -> TDiag -> TDiag -> Bool+prop_assoc a b c = (p == q) where+  p = compose (compose a b) c+  q = compose a (compose b c)++prop_telescope :: TDiag -> TDiag -> TDiag -> TDiag -> Bool+prop_telescope u v w z = (a `compose` b `compose` c) == (u // z) where+  a = u // v+  b = v // w+  c = w // z++prop_cyclic_product_3 :: TDiag -> TDiag -> TDiag -> Bool+prop_cyclic_product_3 u v w = (a `compose` b `compose` c) == identity where+  a = u // v+  b = v // w+  c = w // u++prop_cyclic_product_4 :: TDiag -> TDiag -> TDiag -> TDiag -> Bool+prop_cyclic_product_4 u v w z = (a `compose` b `compose` c `compose` d) == identity where+  a = u // v+  b = v // w+  c = w // z+  d = z // u++prop_positive_product :: T -> T -> Bool+prop_positive_product x y = isPositive (positive x `compose` positive y)++prop_reduce_composition :: Unreduced -> Unreduced -> Bool+prop_reduce_composition (Unreduced x) (Unreduced y) = lhs == rhs where+  lhs = reduce (x `composeDontReduce` y)+  rhs = compose (reduce x) (reduce y)++prop_reduce_inverse :: Unreduced -> Bool+prop_reduce_inverse (Unreduced x) = lhs == rhs where+  lhs = reduce (inverse x)+  rhs = inverse (reduce x)++--------------------------------------------------------------------------------+