HaskellForMaths 0.4.4 → 0.4.5

raw patch · 12 files changed

+640/−152 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• HaskellForMaths.cabal +1/−1
• Math/Algebras/Structures.hs +48/−17
• Math/Algebras/VectorSpace.hs +42/−4
• Math/Combinatorics/CombinatorialHopfAlgebra.hs +336/−78
• Math/Combinatorics/Design.hs +12/−2
• Math/Combinatorics/Graph.hs +1/−1
• Math/Combinatorics/StronglyRegularGraph.hs +7/−1
• Math/CommutativeAlgebra/Polynomial.hs +1/−1
• Math/Core/Utils.hs +16/−16
• Math/NumberTheory/Factor.hs +2/−1
• Math/Test/TAlgebras/TStructures.hs +38/−2
• Math/Test/TCombinatorics/TCombinatorialHopfAlgebra.hs +136/−28

@@ -1,5 +1,5 @@    Name:                HaskellForMaths
-   Version:             0.4.4
+   Version:             0.4.5
    Category:            Math
    Description:         A library of maths code in the areas of combinatorics, group theory, commutative algebra, and non-commutative algebra. The library is mainly intended as an educational resource, but does have efficient implementations of several fundamental algorithms.
    Synopsis:            Combinatorics, group theory, commutative algebra, non-commutative algebra

@@ -1,4 +1,4 @@--- Copyright (c) David Amos, 2010. All rights reserved.+-- Copyright (c) David Amos, 2010-2012. All rights reserved.  {-# LANGUAGE MultiParamTypeClasses, NoMonomorphismRestriction #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}@@ -29,12 +29,21 @@     unit :: k -> Vect k b     mult :: Vect k (Tensor b b) -> Vect k b +-- |Sometimes it is more convenient to work with this version of unit.+unit' :: (Eq k, Num k, Algebra k b) => Vect k () -> Vect k b+unit' = unit . unwrap -- where unwrap = counit :: Num k => Trivial k -> k+ -- |An instance declaration for Coalgebra k b is saying that the vector space Vect k b is a k-coalgebra. class Coalgebra k b where     counit :: Vect k b -> k     comult :: Vect k b -> Vect k (Tensor b b) +-- |Sometimes it is more convenient to work with this version of counit.+counit' :: (Eq k, Num k, Coalgebra k b) => Vect k b -> Vect k ()+counit' = wrap . counit -- where wrap = unit :: Num k => k -> Trivial k +-- unit' and counit' enable us to form tensors of these functions+ -- |A bialgebra is an algebra which is also a coalgebra, subject to the compatibility conditions -- that counit and comult must be algebra morphisms (or equivalently, that unit and mult must be coalgebra morphisms) class (Algebra k b, Coalgebra k b) => Bialgebra k b where {}@@ -70,7 +79,8 @@     unit = wrap     -- unit 0 = zero -- V []     -- unit x = V [( (),x)]-    mult = linear mult' where mult' ((),()) = return ()+    mult = fmap (\((),())->())+    -- mult = linear mult' where mult' ((),()) = return ()     -- mult (V [( ((),()), x)]) = V [( (),x)]     -- mult (V []) = zerov @@ -78,19 +88,12 @@     counit = unwrap     -- counit (V []) = 0     -- counit (V [( (),x)]) = x-    comult = linear comult' where comult' () = return ((),())+    comult = fmap (\()->((),()))+    -- comult = linear comult' where comult' () = return ((),())     -- comult (V [( (),x)]) = V [( ((),()), x)]     -- comult (V []) = zerov -unit' :: (Eq k, Num k, Algebra k b) => Trivial k -> Vect k b-unit' = unit . unwrap -- where unwrap = counit :: Num k => Trivial k -> k -counit' :: (Eq k, Num k, Coalgebra k b) => Vect k b -> Trivial k-counit' = wrap . counit -- where wrap = unit :: Num k => k -> Trivial k---- unit' and counit' enable us to form tensors of these functions-- -- Kassel p4 -- |The direct sum of k-algebras can itself be given the structure of a k-algebra. -- This is the product object in the category of k-algebras.@@ -126,16 +129,20 @@ instance (Eq k, Num k, Ord a, Ord b, Algebra k a, Algebra k b) => Algebra k (Tensor a b) where     -- unit 0 = V []     unit x = x *> (unit 1 `te` unit 1)-    mult = linear m where-        m ((a,b),(a',b')) = (mult $ return (a,a')) `te` (mult $ return (b,b'))+    mult = (mult `tf` mult) . fmap (\((a,b),(a',b')) -> ((a,a'),(b,b')) )+    -- mult = linear m where+    --     m ((a,b),(a',b')) = (mult $ return (a,a')) `te` (mult $ return (b,b'))  -- Kassel p42 -- |The tensor product of k-coalgebras can itself be given the structure of a k-coalgebra instance (Eq k, Num k, Ord a, Ord b, Coalgebra k a, Coalgebra k b) => Coalgebra k (Tensor a b) where-    counit = counit . (counit' `tf` counit')-    -- counit = counit . linear (\(T x y) -> counit' (return x) * counit' (return y))-    comult = assocL . (id `tf` assocR) . (id `tf` (twist `tf` id))-           . (id `tf` assocL) . assocR . (comult `tf` comult)+    counit = unwrap . linear counit'+        where counit' (a,b) = (wrap . counit . return) a * (wrap . counit . return) b -- (*) taking place in Vect k ()+    -- what this really says is that counit (a `tensor` b) = counit a * counit b+    -- counit = counit . linear (\(x,y) -> counit' (return x) * counit' (return y))+    comult = nf . fmap (\((a,a'),(b,b')) -> ((a,b),(a',b')) ) . (comult `tf` comult)+    -- comult = assocL . (id `tf` assocR) . (id `tf` (twist `tf` id))+    --        . (id `tf` assocL) . assocR . (comult `tf` comult)   -- The set coalgebra - can be defined on any set@@ -204,3 +211,27 @@          => Comodule k a (Tensor m n) where     coaction = (mult `tf` id) . twistm . (coaction `tf` coaction)         where twistm x = nf $ fmap ( \((h,m), (h',n)) -> ((h,h'), (m,n)) ) x+++-- PAIRINGS++-- |A pairing is a non-degenerate bilinear form U x V -> k.+-- We are typically interested in pairings having additional properties. For example:+--+-- * A bialgebra pairing is a pairing between bialgebras A and B such that the mult in A is adjoint to the comult in B, and vice versa, and the unit in A is adjoint to the counit in B, and vice versa.+--+-- * A Hopf pairing is a bialgebra pairing between Hopf algebras A and B such that the antipodes in A and B are adjoint.+class HasPairing k u v where+    pairing :: Vect k (Tensor u v) -> Vect k ()++-- |The pairing function with a more Haskellish type signature+pairing' :: (Num k, HasPairing k u v) => Vect k u -> Vect k v -> k+pairing' u v = unwrap (pairing (u `te` v))++instance (Eq k, Num k) => HasPairing k () () where+    pairing = mult++instance (Eq k, Num k, HasPairing k u v, HasPairing k u' v') => HasPairing k (Tensor u u') (Tensor v v') where+    pairing = mult . (pairing `tf` pairing) . fmap (\((u,u'),(v,v')) -> ((u,v),(u',v')))+    -- pairing = fmap (\((),()) -> ()) . (pairing `tf` pairing) . fmap (\((u,u'),(v,v')) -> ((u,v),(u',v')))+

@@ -1,6 +1,7 @@ -- Copyright (c) 2010, David Amos. All rights reserved.  {-# LANGUAGE NoMonomorphismRestriction #-}+{-# OPTIONS_HADDOCK prune #-}  -- |A module defining the type and operations of free k-vector spaces over a basis b (for a field k) module Math.Algebras.VectorSpace where@@ -13,8 +14,14 @@ infixl 6 <+>, <->  --- |Given a field type k (ie a Fractional instance), Vect k b is the type of the free k-vector space over the basis type b.--- Elements of Vect k b consist of k-linear combinations of elements of b.+-- |Given a field type k and a basis type b, Vect k b is the type of the free k-vector space over b.+-- Elements (values) of Vect k b consist of k-linear combinations of elements (values) of b.+--+-- In order for Vect k b to be a vector space, it is necessary that k is a field (that is, an instance of Fractional).+-- In practice, we often relax this condition, and require that k is a ring (that is, an instance of Num). In that case,+-- Vect k b should more correctly be called (the type of) the free k-module over b.+--+-- Most of the code requires that b is an instance of Ord. This is primarily to enable us to simplify to a normal form. newtype Vect k b = V [(b,k)] deriving (Eq,Ord)  instance (Show k, Eq k, Num k, Show b) => Show (Vect k b) where@@ -125,11 +132,36 @@     -- compareFst = curry ( uncurry compare . (fst *** fst) )  --- lift a function on the basis to a function on the vector space+-- |Given a field k, (Vect k) is a functor, the \"free k-vector space\" functor.+--+-- In the mathematical sense, this can be regarded as a functor from the category Set (of sets) to the category k-Vect+-- (of k-vector spaces). In Haskell, instead of Set we have Hask, the category of Haskell types. However, for our purposes+-- it is helpful to identify Hask with Set, but identifying a Haskell type with its set of inhabitants.+--+-- The type constructor (Vect k) gives the action of the functor on objects in the category,+-- taking a set (type) to a free k-vector space. fmap gives the action of the functor on arrows in the category,+-- taking a function between sets (types) to a linear map between vector spaces.+--+-- Note that if f is not order-preserving, then (fmap f) is not guaranteed to return results in normal form,+-- so it may be preferable to use (nf . fmap f). instance Functor (Vect k) where+    -- lift a function on the basis to a function on the vector space     fmap f (V ts) = V [(f b, x) | (b,x) <- ts] -- Note that if f is not order-preserving, then we need to call "nf" afterwards +-- |Given a field k, the type constructor (Vect k) is a monad, the \"free k-vector space monad\".+--+-- In order to understand this, it is probably easiest to think of a free k-vector space as a kind of container,+-- a bit like a list, except that order doesn't matter, and you're allowed arbitrary (even negative or fractional)+-- quantities of the basis elements in the container.+--+-- According to this way of thinking, return is the function that puts a basis element into the vector space (container).+--+-- Given a function f from the basis of one vector space to another vector space (a -> Vect k b),+-- bind (>>=) lifts it to a function (>>= f) from the first vector space to the second (Vect k a -> Vect k b).+--+-- Note that in general (>>= f) applied to a vector will not return a result in normal form,+-- so it is usually preferable to use (linear f) instead. instance Num k => Monad (Vect k) where     return a = V [(a,1)]     V ts >>= f = V $ concat [ [(b,y*x) | let V us = f a, (b,y) <- us] | (a,x) <- ts]@@ -159,15 +191,21 @@ -- but in the code, we need this if we want to be able to put k as one side of a tensor product. type Trivial k = Vect k () +-- |Wrap an element of the field k to an element of the trivial k-vector space wrap :: (Eq k, Num k) => k -> Vect k () wrap 0 = zero wrap x = V [( (),x)] +-- |Unwrap an element of the trivial k-vector space to an element of the field k unwrap :: Num k => Vect k () -> k unwrap (V []) = 0 unwrap (V [( (),x)]) = x --- |Given a finite vector space basis b, Dual b represents a basis for the dual vector space. (If b is infinite, then Dual b is only a sub-basis.)+-- |Given a finite vector space basis b, Dual b can be used to represent a basis for the dual vector space.+-- The intention is that for a given individual basis element b_i, (Dual b_i) represents the indicator function for b_i,+-- which takes b_i to 1 and all other basis elements to 0.+--+-- (Note that if the basis b is infinite, then Dual b may only represent a sub-basis of the dual vector space.) newtype Dual b = Dual b deriving (Eq,Ord)  instance Show basis => Show (Dual basis) where

@@ -4,13 +4,17 @@  -- |A module defining the following Combinatorial Hopf Algebras, together with coalgebra or Hopf algebra morphisms between them: --+-- * Sh, the Shuffle Hopf algebra+-- -- * SSym, the Malvenuto-Reutnenauer Hopf algebra of permutations -- -- * YSym, the (dual of the) Loday-Ronco Hopf algebra of binary trees -- -- * QSym, the Hopf algebra of quasi-symmetric functions (having a basis indexed by compositions) ----- * Sh, the Shuffle Hopf algebra+-- * Sym, the Hopf algebra of symmetric functions (having a basis indexed by integer partitions)+--+-- * NSym, the Hopf algebra of non-commutative symmetric functions module Math.Combinatorics.CombinatorialHopfAlgebra where  -- Sources:@@ -27,6 +31,8 @@ -- Stefan Forcey, Aaron Lauve and Frank Sottile -- http://www.math.tamu.edu/~sottile/research/pdf/MSym.pdf +-- Lie Algebras and Hopf Algebras+-- Michiel Hazewinkel, Nadiya Gubareni, V.V.Kirichenko  import Data.List as L import Data.Maybe (fromJust)@@ -63,15 +69,15 @@  instance (Eq k, Num k, Ord a) => Algebra k (Shuffle a) where     unit x = x *> return (Sh [])-    mult = linear mult'-        where mult' (Sh xs, Sh ys) = sumv [return (Sh zs) | zs <- shuffles xs ys]+    mult = linear mult' where+        mult' (Sh xs, Sh ys) = sumv [return (Sh zs) | zs <- shuffles xs ys]  deconcatenations xs = zip (inits xs) (tails xs)  instance (Eq k, Num k, Ord a) => Coalgebra k (Shuffle a) where     counit = unwrap . linear counit' where counit' (Sh xs) = if null xs then 1 else 0-    comult = linear comult'-        where comult' (Sh xs) = sumv [return (Sh us, Sh vs) | (us, vs) <- deconcatenations xs]+    comult = linear comult' where+        comult' (Sh xs) = sumv [return (Sh us, Sh vs) | (us, vs) <- deconcatenations xs]  instance (Eq k, Num k, Ord a) => Bialgebra k (Shuffle a) where {} @@ -82,7 +88,7 @@ -- SSYM: PERMUTATIONS -- (This is permutations considered as combinatorial objects rather than as algebraic objects) --- Permutations with shifted shuffle product+-- Permutations with shifted shuffle product and flattened deconcatenation coproduct -- This is the Malvenuto-Reutenauer Hopf algebra of permutations, SSym. -- It is neither commutative nor co-commutative @@ -116,10 +122,10 @@  instance (Eq k, Num k) => Algebra k SSymF where     unit x = x *> return (SSymF [])-    mult = linear mult'-        where mult' (SSymF xs, SSymF ys) =-                  let k = length xs-                  in sumv [return (SSymF zs) | zs <- shuffles xs (map (+k) ys)]+    mult = linear mult' where+        mult' (SSymF xs, SSymF ys) =+            let k = length xs+            in sumv [return (SSymF zs) | zs <- shuffles xs (map (+k) ys)]   -- standard permutation, also called flattening, eg [6,2,5] -> [3,1,2]@@ -135,9 +141,9 @@ instance (Eq k, Num k) => Bialgebra k SSymF where {}  instance (Eq k, Num k) => HopfAlgebra k SSymF where-    antipode = linear antipode'-        where antipode' (SSymF []) = return (SSymF [])-              antipode' x@(SSymF xs) = (negatev . mult . (id `tf` antipode) . removeTerm (SSymF [],x) . comult . return) x+    antipode = linear antipode' where+        antipode' (SSymF []) = return (SSymF [])+        antipode' x@(SSymF xs) = (negatev . mult . (id `tf` antipode) . removeTerm (SSymF [],x) . comult . return) x         -- This expression for antipode is derived from mult . (id `tf` antipode) . comult == unit . counit         -- It's possible because this is a graded, connected Hopf algebra. (connected means the counit is projection onto the grade 0 part) -- It would be nicer to have an explicit expression for antipode.@@ -149,6 +155,19 @@                          - length [s | s <- powerset [1..n-1],  even (length s), descentSet (w^-1 * v_s) `isSubset` s] -} +instance HasInverses SSymF where+    inverse (SSymF xs) = SSymF $ map snd $ L.sort $ map (\(s,t)->(t,s)) $ zip [1..] xs++-- Hazewinkel p267+-- |A pairing showing that SSym is self-adjoint+instance (Eq k, Num k) => HasPairing k SSymF SSymF where+    pairing = linear pairing' where+        pairing' (x,y) = delta x (inverse y)+-- Not entirely clear to me why this works+-- The pairing is *not* positive definite (Hazewinkel p267)+-- eg (\x -> pairing' x x >= 0) (ssymF [1,3,2] + ssymF [2,3,1] - ssymF [3,1,2]) == False++ -- |An alternative \"monomial\" basis for the Malvenuto-Reutenauer Hopf algebra of permutations, SSym. -- This basis is related to the fundamental basis by Mobius inversion in the poset of permutations with the weak order. newtype SSymM = SSymM [Int] deriving (Eq)@@ -169,6 +188,7 @@ inversions xs = let ixs = zip [1..] xs                 in [(i,j) | ((i,xi),(j,xj)) <- pairs ixs, xi > xj] +-- should really check that xs and ys have the same length, and perhaps insist also on same type weakOrder xs ys = inversions xs `isSubsetAsc` inversions ys  mu (set,po) x y = mu' x y where@@ -177,16 +197,16 @@             | otherwise = 0  -- |Convert an element of SSym represented in the monomial basis to the fundamental basis-toSSymF :: (Eq k, Num k) => Vect k SSymM -> Vect k SSymF-toSSymF = linear toSSymF'-    where toSSymF' (SSymM u) = sumv [mu (set,po) u v *> return (SSymF v) | v <- set, po u v]+ssymMtoF :: (Eq k, Num k) => Vect k SSymM -> Vect k SSymF+ssymMtoF = linear ssymMtoF'+    where ssymMtoF' (SSymM u) = sumv [mu (set,po) u v *> return (SSymF v) | v <- set, po u v]               where set = L.permutations u                     po = weakOrder  -- |Convert an element of SSym represented in the fundamental basis to the monomial basis-toSSymM :: (Eq k, Num k) => Vect k SSymF -> Vect k SSymM-toSSymM = linear toSSymM'-    where toSSymM' (SSymF u) = sumv [return (SSymM v) | v <- set, po u v]+ssymFtoM :: (Eq k, Num k) => Vect k SSymF -> Vect k SSymM+ssymFtoM = linear ssymFtoM'+    where ssymFtoM' (SSymF u) = sumv [return (SSymM v) | v <- set, po u v]               where set = L.permutations u                     po = weakOrder @@ -210,7 +230,7 @@  instance (Eq k, Num k) => Algebra k SSymM where     unit x = x *> return (SSymM [])-    mult = toSSymM . mult . (toSSymF `tf` toSSymF)+    mult = ssymFtoM . mult . (ssymMtoF `tf` ssymMtoF)  {- mult2 = linear mult'@@ -226,7 +246,7 @@  instance (Eq k, Num k) => Coalgebra k SSymM where     counit = unwrap . linear counit' where counit' (SSymM xs) = if null xs then 1 else 0-    -- comult = (toSSymM `tf` toSSymM) . comult . toSSymF+    -- comult = (ssymFtoM `tf` ssymFtoM) . comult . ssymMtoF     comult = linear comult'         where comult' (SSymM xs) = sumv [return (SSymM (flatten ys), SSymM (flatten zs))                                         | (ys,zs) <- deconcatenations xs,@@ -236,9 +256,50 @@ instance (Eq k, Num k) => Bialgebra k SSymM where {}  instance (Eq k, Num k) => HopfAlgebra k SSymM where-    antipode = toSSymM . antipode . toSSymF+    antipode = ssymFtoM . antipode . ssymMtoF  +-- Hazewinkel p265+instance (Eq k, Num k) => Algebra k (Dual SSymF) where+    unit x = x *> return (Dual (SSymF []))+    mult = linear mult' where+        mult' (Dual (SSymF xs), Dual (SSymF ys)) =+            sumv [(return . Dual . SSymF) (xs'' ++ ys'')+                 | xs' <- combinationsOf r [1..r+s], let ys' = diffAsc [1..r+s] xs',+                   xs'' <- L.permutations xs', flatten xs'' == xs,+                   ys'' <- L.permutations ys', flatten ys'' == ys ]+            where r = length xs; s = length ys+-- In other words, mult x y is the sum of those z whose comult (in SSymF) has an (x,y) term+-- So the matrix for mult is the transpose of the matrix for comult in SSymF++instance (Eq k, Num k) => Coalgebra k (Dual SSymF) where+    counit = unwrap . linear counit' where counit' (Dual (SSymF xs)) = if null xs then 1 else 0+    comult = linear comult' where+        comult' (Dual (SSymF xs)) =+            sumv [return (Dual (SSymF ys), Dual (SSymF (flatten zs))) | i <- [0..n], let (ys,zs) = L.partition (<=i) xs ]+            where n = length xs+-- In other words, comult x is the sum of those (y,z) whose mult (in SSymF) has a z term+-- So the matrix for comult is the transpose of the matrix for mult in SSymF++instance (Eq k, Num k) => Bialgebra k (Dual SSymF) where {}++instance (Eq k, Num k) => HopfAlgebra k (Dual SSymF) where+    antipode = linear antipode' where+        antipode' (Dual (SSymF [])) = return (Dual (SSymF []))+        antipode' x@(Dual (SSymF xs)) =+            (negatev . mult . (id `tf` antipode) . removeTerm (Dual (SSymF []),x) . comult . return) x++-- This pairing is positive definite (Hazewinkel p267)+instance (Eq k, Num k) => HasPairing k SSymF (Dual SSymF) where+    pairing = linear pairing' where+        pairing' (x, Dual y) = delta x y++-- |The isomorphism from SSym to its dual that takes a permutation in the fundamental basis to its inverse in the dual basis+ssymFtoDual :: (Eq k, Num k) => Vect k SSymF -> Vect k (Dual SSymF)+ssymFtoDual = nf . fmap (Dual . inverse)+-- This is theta on Hazewinkel p266 (though later he also uses theta for the inverse of this map)++ -- YSYM: PLANAR BINARY TREES -- These are really rooted planar binary trees. -- It's because they're planar that we can distinguish left and right child branches.@@ -338,19 +399,19 @@  instance (Eq k, Num k, Ord a) => Algebra k (YSymF a) where     unit x = x *> return (YSymF E)-    mult = linear mult'-        where mult' (YSymF t, YSymF u) = sumv [return (YSymF (graft ts u)) | ts <- multisplits (leafcount u) t]-              -- using sumv rather than sum to avoid requiring Show a+    mult = linear mult' where+        mult' (YSymF t, YSymF u) = sumv [return (YSymF (graft ts u)) | ts <- multisplits (leafcount u) t]+        -- using sumv rather than sum to avoid requiring Show a  instance (Eq k, Num k, Ord a) => Bialgebra k (YSymF a) where {}  instance (Eq k, Num k, Ord a) => HopfAlgebra k (YSymF a) where-    antipode = linear antipode'-        where antipode' (YSymF E) = return (YSymF E)-              antipode' x = (negatev . mult . (id `tf` antipode) . removeTerm (YSymF E,x) . comult . return) x+    antipode = linear antipode' where+        antipode' (YSymF E) = return (YSymF E)+        antipode' x = (negatev . mult . (id `tf` antipode) . removeTerm (YSymF E,x) . comult . return) x  --- |An alternative "monomial" basis for (the dual of) the Loday-Ronco Hopf algebra of binary trees, YSym.+-- |An alternative \"monomial\" basis for (the dual of) the Loday-Ronco Hopf algebra of binary trees, YSym. newtype YSymM = YSymM (PBT ()) deriving (Eq, Ord)  instance Show YSymM where@@ -360,68 +421,75 @@ ysymM :: PBT () -> Vect Q YSymM ysymM t = return (YSymM t) -+-- |List all trees with the given number of nodes+trees :: Int -> [PBT ()] trees 0 = [E] trees n = [T l () r | i <- [0..n-1], l <- trees (n-1-i), r <- trees i]  -- |The covering relation for the Tamari partial order on binary trees-covers E = []-covers (T t@(T u x v) y w) = [T t' y w | t' <- covers t]-                          ++ [T t y w' | w' <- covers w]-                          ++ [T u y (T v x w)]-                          -- Note that this preserves the descending property, and hence the bijection with permutations-                          -- If we were to swap x and y, we would preserve the binary search tree property instead (if our trees had it)-covers (T E x u) = [T E x u' | u' <- covers u]  +tamariCovers :: PBT a -> [PBT a]+tamariCovers E = []+tamariCovers (T t@(T u x v) y w) = [T t' y w | t' <- tamariCovers t]+                                ++ [T t y w' | w' <- tamariCovers w]+                                ++ [T u y (T v x w)]+                                -- Note that this preserves the descending property, and hence the bijection with permutations+                                -- If we were to swap x and y, we would preserve the binary search tree property instead (if our trees had it)+tamariCovers (T E x u) = [T E x u' | u' <- tamariCovers u]    -- |The up-set of a binary tree in the Tamari partial order+tamariUpSet :: Ord a => PBT a -> [PBT a] tamariUpSet t = upSet' [] [t]     where upSet' interior boundary =               if null boundary               then interior               else let interior' = setUnionAsc interior boundary-                       boundary' = toSet $ concatMap covers boundary+                       boundary' = toSet $ concatMap tamariCovers boundary                    in upSet' interior' boundary'  -- tamariOrder1 u v = v `elem` upSet u +-- |The Tamari partial order on binary trees.+-- This is only defined between trees of the same size (number of nodes).+-- The result between trees of different sizes is undefined (we don't check).+tamariOrder :: PBT a -> PBT a -> Bool tamariOrder u v = weakOrder (minPerm u) (minPerm v)--- It should be possible to unpack this to be a statement purely about trees, but probably not worth+-- It should be possible to unpack this to be a statement purely about trees, but probably not worth it  -- |Convert an element of YSym represented in the monomial basis to the fundamental basis-toYSymF :: (Eq k, Num k) => Vect k YSymM -> Vect k (YSymF ())-toYSymF = linear toYSymF'-    where toYSymF' (YSymM t) = sumv [mu (set,po) t s *> return (YSymF s) | s <- set]+ysymMtoF :: (Eq k, Num k) => Vect k YSymM -> Vect k (YSymF ())+ysymMtoF = linear ysymMtoF'+    where ysymMtoF' (YSymM t) = sumv [mu (set,po) t s *> return (YSymF s) | s <- set]               where po = tamariOrder                     set = tamariUpSet t -- [s | s <- trees (nodecount t), t `tamariOrder` s]  -- |Convert an element of YSym represented in the fundamental basis to the monomial basis-toYSymM :: (Eq k, Num k) => Vect k (YSymF ()) -> Vect k YSymM-toYSymM = linear toYSymM'-    where toYSymM' (YSymF t) = sumv [return (YSymM s) | s <- tamariUpSet t]+ysymFtoM :: (Eq k, Num k) => Vect k (YSymF ()) -> Vect k YSymM+ysymFtoM = linear ysymFtoM'+    where ysymFtoM' (YSymF t) = sumv [return (YSymM s) | s <- tamariUpSet t]                             -- sumv [return (YSymM s) | s <- trees (nodecount t), t `tamariOrder` s]   instance (Eq k, Num k) => Algebra k YSymM where     unit x = x *> return (YSymM E)-    mult = toYSymM . mult . (toYSymF `tf` toYSymF)+    mult = ysymFtoM . mult . (ysymMtoF `tf` ysymMtoF)  instance (Eq k, Num k) => Coalgebra k YSymM where     counit = unwrap . linear counit' where counit' (YSymM E) = 1; counit' (YSymM (T _ _ _)) = 0-    -- comult = (toYSymM `tf` toYSymM) . comult . toYSymF-    comult = linear comult'-        where comult' (YSymM t) = sumv [return (YSymM r, YSymM s) | (rs,ss) <- deconcatenations (underDecomposition t),-                                                                    let r = foldl under E rs, let s = foldl under E ss]+    -- comult = (ysymFtoM `tf` ysymFtoM) . comult . ysymMtoF+    comult = linear comult' where+        comult' (YSymM t) = sumv [return (YSymM r, YSymM s) | (rs,ss) <- deconcatenations (underDecomposition t),+                                                              let r = foldl under E rs, let s = foldl under E ss]   instance (Eq k, Num k) => Bialgebra k YSymM where {}  instance (Eq k, Num k) => HopfAlgebra k YSymM where-    antipode = toYSymM . antipode . toYSymF +    antipode = ysymFtoM . antipode . ysymMtoF    -- QSYM: QUASI-SYMMETRIC FUNCTIONS -- The following is the Hopf algebra QSym of quasi-symmetric functions--- using the monomial basis (indexed by compositions)+-- using the monomial and fundamental bases (indexed by compositions)  -- compositions in ascending order -- might be better to use bfs to get length order@@ -437,8 +505,8 @@ -- quasi shuffles of two compositions quasiShuffles :: [Int] -> [Int] -> [[Int]] quasiShuffles (x:xs) (y:ys) = map (x:) (quasiShuffles xs (y:ys)) ++-                              map (y:) (quasiShuffles (x:xs) ys) ++-                              map ((x+y):) (quasiShuffles xs ys)+                              map ((x+y):) (quasiShuffles xs ys) +++                              map (y:) (quasiShuffles (x:xs) ys) quasiShuffles xs [] = [xs] quasiShuffles [] ys = [ys] @@ -447,72 +515,76 @@ newtype QSymM = QSymM [Int] deriving (Eq)  instance Ord QSymM where-    compare (QSymM xs) (QSymM ys) = compare (length xs, xs) (length ys, ys)+    compare (QSymM xs) (QSymM ys) = compare (sum xs, xs) (sum ys, ys)  instance Show QSymM where     show (QSymM xs) = "M " ++ show xs  -- |Construct the element of QSym in the monomial basis indexed by the given composition qsymM :: [Int] -> Vect Q QSymM-qsymM = return . QSymM+qsymM xs | all (>0) xs = return (QSymM xs)+         | otherwise = error "qsymM: not a composition"  instance (Eq k, Num k) => Algebra k QSymM where     unit x = x *> return (QSymM [])-    mult = linear mult'-        where mult' (QSymM alpha, QSymM beta) = sum [return (QSymM gamma) | gamma <- quasiShuffles alpha beta]+    mult = linear mult' where+        mult' (QSymM alpha, QSymM beta) = sumv [return (QSymM gamma) | gamma <- quasiShuffles alpha beta]  instance (Eq k, Num k) => Coalgebra k QSymM where     counit = unwrap . linear counit' where counit' (QSymM alpha) = if null alpha then 1 else 0     comult = linear comult' where-        comult' (QSymM gamma) = sum [return (QSymM alpha, QSymM beta) | (alpha,beta) <- deconcatenations gamma]+        comult' (QSymM gamma) = sumv [return (QSymM alpha, QSymM beta) | (alpha,beta) <- deconcatenations gamma]  instance (Eq k, Num k) => Bialgebra k QSymM where {}  instance (Eq k, Num k) => HopfAlgebra k QSymM where     antipode = linear antipode' where-        antipode' (QSymM alpha) = (-1)^length alpha * sum [return (QSymM (reverse beta)) | beta <- coarsenings alpha]+        antipode' (QSymM alpha) = (-1)^length alpha * sumv [return (QSymM beta) | beta <- coarsenings (reverse alpha)]+        -- antipode' (QSymM alpha) = (-1)^length alpha * sumv [return (QSymM (reverse beta)) | beta <- coarsenings alpha] -coarsenings (x1:x2:xs) = coarsenings ((x1+x2):xs) ++ map (x1:) (coarsenings (x2:xs))+coarsenings (x1:x2:xs) = map (x1:) (coarsenings (x2:xs)) ++ coarsenings ((x1+x2):xs) coarsenings xs = [xs] -- for xs a singleton or null  refinements (x:xs) = [y++ys | y <- compositions x, ys <- refinements xs] refinements [] = [[]]  +-- |A type for the fundamental basis for the quasi-symmetric functions, indexed by compositions. newtype QSymF = QSymF [Int] deriving (Eq)  instance Ord QSymF where-    compare (QSymF xs) (QSymF ys) = compare (length xs, xs) (length ys, ys)+    compare (QSymF xs) (QSymF ys) = compare (sum xs, xs) (sum ys, ys)  instance Show QSymF where     show (QSymF xs) = "F " ++ show xs  -- |Construct the element of QSym in the fundamental basis indexed by the given composition qsymF :: [Int] -> Vect Q QSymF-qsymF = return . QSymF+qsymF xs | all (>0) xs = return (QSymF xs)+         | otherwise = error "qsymF: not a composition"  -- |Convert an element of QSym represented in the monomial basis to the fundamental basis-toQSymF :: (Eq k, Num k) => Vect k QSymM -> Vect k QSymF-toQSymF = linear toQSymF'-    where toQSymF' (QSymM alpha) = sumv [(-1) ^ (length beta - length alpha) *> return (QSymF beta) | beta <- refinements alpha]+qsymMtoF :: (Eq k, Num k) => Vect k QSymM -> Vect k QSymF+qsymMtoF = linear qsymMtoF'+    where qsymMtoF' (QSymM alpha) = sumv [(-1) ^ (length beta - length alpha) *> return (QSymF beta) | beta <- refinements alpha]  -- |Convert an element of QSym represented in the fundamental basis to the monomial basis-toQSymM :: (Eq k, Num k) => Vect k QSymF -> Vect k QSymM-toQSymM = linear toQSymM'-    where toQSymM' (QSymF alpha) = sumv [return (QSymM beta) | beta <- refinements alpha] -- ie beta <- up-set of alpha+qsymFtoM :: (Eq k, Num k) => Vect k QSymF -> Vect k QSymM+qsymFtoM = linear qsymFtoM'+    where qsymFtoM' (QSymF alpha) = sumv [return (QSymM beta) | beta <- refinements alpha] -- ie beta <- up-set of alpha  instance (Eq k, Num k) => Algebra k QSymF where     unit x = x *> return (QSymF [])-    mult = toQSymF . mult . (toQSymM `tf` toQSymM)+    mult = qsymMtoF . mult . (qsymFtoM `tf` qsymFtoM)  instance (Eq k, Num k) => Coalgebra k QSymF where     counit = unwrap . linear counit' where counit' (QSymF xs) = if null xs then 1 else 0-    comult = (toQSymF `tf` toQSymF) . comult . toQSymM+    comult = (qsymMtoF `tf` qsymMtoF) . comult . qsymFtoM  instance (Eq k, Num k) => Bialgebra k QSymF where {}  instance (Eq k, Num k) => HopfAlgebra k QSymF where-    antipode = toQSymF . antipode . toQSymM+    antipode = qsymMtoF . antipode . qsymFtoM   -- QUASI-SYMMETRIC POLYNOMIALS@@ -522,12 +594,150 @@  xvars n = [glexvar ("x" ++ show i) | i <- [1..n] ] --- compare with Reynolds operator--- so a basis for quasi-symmetric functions over xvars n consists of [quasiSymM xs is | m <- [0..], is <- compositions m]-quasiSymM xs is = sum [product (zipWith (^) xs' is) | xs' <- combinationsOf r xs]-    where r = length is+-- |@qsymPoly n is@ is the quasi-symmetric polynomial in n variables for the indices is. (This corresponds to the+-- monomial basis for QSym.) For example, qsymPoly 3 [2,1] == x1^2*x2+x1^2*x3+x2^2*x3.+qsymPoly :: Int -> [Int] -> GlexPoly Q String+qsymPoly n is = sum [product (zipWith (^) xs' is) | xs' <- combinationsOf r xs]+    where xs = xvars n+          r = length is  +-- SYM, THE HOPF ALGEBRA OF SYMMETRIC FUNCTIONS++-- |A type for the monomial basis for Sym, the Hopf algebra of symmetric functions, indexed by integer partitions+newtype SymM = SymM [Int] deriving (Eq,Show)++instance Ord SymM where+    compare (SymM xs) (SymM ys) = compare (sum xs, ys) (sum ys, xs) -- note the order reversal in snd++-- |Construct the element of Sym in the monomial basis indexed by the given integer partition+symM :: [Int] -> Vect Q SymM+symM xs | all (>0) xs = return (SymM $ sortDesc xs)+        | otherwise = error "symM: not a partition"++instance (Eq k, Num k) => Algebra k SymM where+    unit x = x *> return (SymM [])+    mult = linear mult' where+        mult' (SymM lambda, SymM mu) = sumv [return (SymM nu) | nu <- symMult lambda mu]++-- multisetPermutations = toSet . L.permutations++-- compositionsFromPartition2 = foldl (\xss ys -> concatMap (shuffles ys) xss) [[]] . L.group+-- compositionsFromPartition2 = foldl (\ls r -> concat [shuffles l r | l <- ls]) [[]] . L.group++-- The partition must be in either ascending or descending order (so that L.group does as expected)+compositionsFromPartition = foldr (\l rs -> concatMap (shuffles l) rs) [[]] . L.group++-- In effect, we multiply in Sym by converting to QSym, multiplying there, and converting back.+-- It would be nice to find a more direct method.+symMult xs ys = filter isWeaklyDecreasing $ concat+    [quasiShuffles xs' ys' | xs' <- compositionsFromPartition xs, ys' <- compositionsFromPartition ys]++instance (Eq k, Num k) => Coalgebra k SymM where+    counit = unwrap . linear counit' where counit' (SymM lambda) = if null lambda then 1 else 0+    comult = linear comult' where+        comult' (SymM lambda) = sumv [return (SymM mu, SymM nu) | mu <- toSet (powersetdfs lambda), let nu = diffDesc lambda mu]++instance (Eq k, Num k) => Bialgebra k SymM where {}++instance (Eq k, Num k) => HopfAlgebra k SymM where+    antipode = linear antipode' where+        antipode' (SymM []) = return (SymM [])+        antipode' x = (negatev . mult . (id `tf` antipode) . removeTerm (SymM [],x) . comult . return) x+++-- |The elementary basis for Sym, the Hopf algebra of symmetric functions. Defined informally as+-- > symE [n] = symM (replicate n 1)+-- > symE lambda = product [symE [p] | p <- lambda]+newtype SymE = SymE [Int] deriving (Eq,Ord,Show)++symE :: [Int] -> Vect Q SymE+symE xs | all (>0) xs = return (SymE $ sortDesc xs)+        | otherwise = error "symE: not a partition"++instance (Eq k, Num k) => Algebra k SymE where+    unit x = x *> return (SymE [])+    mult = linear (\(SymE lambda, SymE mu) -> return $ SymE $ multisetSumDesc lambda mu)++instance (Eq k, Num k) => Coalgebra k SymE where+    counit = unwrap . linear counit' where counit' (SymE lambda) = if null lambda then 1 else 0+    comult = linear comult' where+        comult' (SymE [n]) = sumv [return (e i, e (n-i)) | i <- [0..n] ]+        comult' (SymE lambda) = product [comult' (SymE [n]) | n <- lambda]+        e 0 = SymE []+        e i = SymE [i]++instance (Eq k, Num k) => Bialgebra k SymE where {}++-- |Convert from the elementary to the monomial basis of Sym+symEtoM :: (Eq k, Num k) => Vect k SymE -> Vect k SymM+symEtoM = linear symEtoM' where+    symEtoM' (SymE [n]) = return (SymM (replicate n 1))+    symEtoM' (SymE lambda) = product [symEtoM' (SymE [p]) | p <- lambda]+++-- |The complete basis for Sym, the Hopf algebra of symmetric functions. Defined informally as+-- > symH [n] = sum [symM lambda | lambda <- integerPartitions n] -- == all monomials of weight n+-- > symH lambda = product [symH [p] | p <- lambda]+newtype SymH = SymH [Int] deriving (Eq,Ord,Show)++symH :: [Int] -> Vect Q SymH+symH xs | all (>0) xs = return (SymH $ sortDesc xs)+        | otherwise = error "symH: not a partition"++instance (Eq k, Num k) => Algebra k SymH where+    unit x = x *> return (SymH [])+    mult = linear (\(SymH lambda, SymH mu) -> return $ SymH $ multisetSumDesc lambda mu)++instance (Eq k, Num k) => Coalgebra k SymH where+    counit = unwrap . linear counit' where counit' (SymH lambda) = if null lambda then 1 else 0+    comult = linear comult' where+        comult' (SymH [n]) = sumv [return (h i, h (n-i)) | i <- [0..n] ]+        comult' (SymH lambda) = product [comult' (SymH [n]) | n <- lambda]+        h 0 = SymH []+        h i = SymH [i]++instance (Eq k, Num k) => Bialgebra k SymH where {}++-- |Convert from the complete to the monomial basis of Sym+symHtoM :: (Eq k, Num k) => Vect k SymH -> Vect k SymM+symHtoM = linear symHtoM' where+    symHtoM' (SymH [n]) = sumv [return (SymM mu) | mu <- integerPartitions n]+    symHtoM' (SymH lambda) = product [symHtoM' (SymH [p]) | p <- lambda]+++-- NSYM, THE HOPF ALGEBRA OF NON-COMMUTATIVE SYMMETRIC FUNCTIONS++-- |A basis for NSym, the Hopf algebra of non-commutative symmetric functions, indexed by compositions+newtype NSym = NSym [Int] deriving (Eq,Ord,Show)++nsym :: [Int] -> Vect Q NSym+nsym xs = return (NSym xs)+nsym xs | all (>0) xs = return (NSym xs)+        | otherwise = error "nsym: not a composition"++instance (Eq k, Num k) => Algebra k NSym where+    unit x = x *> return (NSym [])+    mult = linear mult' where+        mult' (NSym xs, NSym ys) = return $ NSym $ xs ++ ys++instance (Eq k, Num k) => Coalgebra k NSym where+    counit = unwrap . linear counit' where counit' (NSym zs) = if null zs then 1 else 0+    comult = linear comult' where+        comult' (NSym [n]) = sumv [return (z i, z (n-i)) | i <- [0..n] ]+        comult' (NSym zs) = product [comult' (NSym [n]) | n <- zs]+        z 0 = NSym []+        z i = NSym [i]++instance (Eq k, Num k) => Bialgebra k NSym where {}++-- Hazewinkel et al p233+instance (Eq k, Num k) => HopfAlgebra k NSym where+    antipode = linear antipode' where+        antipode' (NSym alpha) = sumv [(-1)^length beta *> return (NSym beta) | beta <- refinements (reverse alpha)]+++ -- MAPS BETWEEN (POSETS AND) HOPF ALGEBRAS  -- A descending tree is one in which a child is always less than a parent.@@ -544,7 +754,15 @@ -- This is the map called lambda in Loday.pdf  --- |A Hopf algebra morphism from SSymF to YSymF+-- |Given a permutation p of [1..n], we can construct a tree (the descending tree of p) as follows:+--+-- * Split the permutation as p = ls ++ [n] ++ rs+--+-- * Place n at the root of the tree, and recursively place the descending trees of ls and rs as the left and right children of the root+--+-- * To bottom out the recursion, the descending tree of the empty permutation is of course the empty tree+--+-- This map between bases SSymF -> YSymF turns out to induce a morphism of Hopf algebras. descendingTreeMap :: (Eq k, Num k) => Vect k SSymF -> Vect k (YSymF ()) descendingTreeMap = nf . fmap (YSymF . shape .  descendingTree')     where descendingTree' (SSymF xs) = descendingTree xs@@ -597,7 +815,10 @@                   (ls,r:rs) -> (length ls + 1) : dc rs                   (ls,[]) -> [length ls] --- |A Hopf algebra morphism from SSymF to QSymF+-- |Given a permutation of [1..n], its descents are those positions where the next number is less than the previous number.+-- For example, the permutation [2,3,5,1,6,4] has descents from 5 to 1 and from 6 to 4. The descents can be regarded as cutting+-- the permutation sequence into segments - 235-16-4 - and by counting the lengths of the segments, we get a composition 3+2+1.+-- This map between bases SSymF -> QSymF turns out to induce a morphism of Hopf algebras. descentMap :: (Eq k, Num k) => Vect k SSymF -> Vect k QSymF descentMap = nf . fmap (\(SSymF xs) -> QSymF (descentComposition xs)) -- descentMap == leftLeafCompositionMap . descendingTreeMap@@ -658,3 +879,40 @@ ssymmToSh = nf . fmap ssymmToSh'     where ssymmToSh' (SSymM xs) = (Sh . underDecomposition . shape . descendingTree) xs -}++-- |The injection of Sym into QSym (defined over the monomial basis)+symToQSymM :: (Eq k, Num k) => Vect k SymM -> Vect k QSymM+symToQSymM = linear symToQSymM' where+    symToQSymM' (SymM ps) = sumv [return (QSymM c) | c <- compositionsFromPartition ps]++-- We could equally well send NSym -> SymE, since the algebra and coalgebra definitions for SymE and SymH are exactly analogous.+-- However, NSym -> SymH is more natural, since it is consistent with the duality pairings below.+-- eg Hazewinkel 238ff+-- (Why do SymE and SymH have the same definitions? They're not dual bases. It's because of the Wronski relations.)+-- |A surjection of NSym onto Sym (defined over the complete basis)+nsymToSymH :: (Eq k, Num k) => Vect k NSym -> Vect k SymH+nsymToSymH = linear nsymToSym' where+    nsymToSym' (NSym zs) = return (SymH $ sortDesc zs)++-- The Hopf algebra morphism NSym -> Sym factors through NSym -> SSym -> YSym -> Sym (contained in QSym)+-- (?? This map NSym -> SSym is the dual of the descent map SSym -> QSym ??)+-- (Loday.pdf, p30)+-- (See also Hazewinkel p267-9)+nsymToSSym = linear nsymToSSym' where+    nsymToSSym' (NSym xs) = product [return (SSymF [1..n]) | n <- xs]+++-- |A duality pairing between the complete and monomial bases of Sym, showing that Sym is self-dual.+instance (Eq k, Num k) => HasPairing k SymH SymM where+    pairing = linear pairing' where+        pairing' (SymH alpha, SymM beta) = delta alpha beta -- Kronecker delta+-- Hazewinkel p178+-- Actually to show duality you would need to show that the map SymH -> SymM*, v -> <v,.> is onto++-- |A duality pairing between NSym and QSymM (monomial basis), showing that NSym and QSym are dual.+instance (Eq k, Num k) => HasPairing k NSym QSymM where+    pairing = linear pairing' where+        pairing' (NSym alpha, QSymM beta) = delta alpha beta -- Kronecker delta+-- Hazewinkel p236-7+-- Actually to show duality you would need to show that the map NSym -> QSymM*, v -> <v,.> is onto+

@@ -1,5 +1,13 @@ -- Copyright (c) 2008, David Amos. All rights reserved.
 
+-- |A module for constructing and working with combinatorial designs.
+--
+-- Given integers t \< k \< v and lambda > 0, a t-design or t-(v,k,lambda) design is an incidence structure of points X and blocks B,
+-- where X is a set of v points, B is a collection of k-subsets of X, with the property that any t points are contained
+-- in exactly lambda blocks. If lambda = 1 and t >= 2, then a t-design is also called a Steiner system S(t,k,v).
+--
+-- Many designs are highly symmetric structures, having large automorphism groups. In particular, the Mathieu groups,
+-- which were the first discovered sporadic finite simple groups, turn up as the automorphism groups of the Witt designs.
 module Math.Combinatorics.Design where
 
 import Data.Maybe (fromJust, isJust)
@@ -30,6 +38,7 @@ -- DESIGNS
 
 data Design a = D [a] [[a]] deriving (Eq,Ord,Show)
+-- Do we or should we insist on ordering of the xs or bs?
 
 design (xs,bs) | isValid d = d where d = D xs bs
 
@@ -112,14 +121,15 @@     vs = vertices graph
     es = edges graph
 
--- |The affine plane AG(2,Fq), a 2-(q^2,q,1) design
+-- |The affine plane AG(2,Fq), a 2-(q^2,q,1) design or Steiner system S(2,q,q^2).
 ag2 :: (FiniteField k, Ord k) => [k] -> Design [k]
 ag2 fq = design (points, lines) where
     points = ptsAG 2 fq
     lines = map line $ tail $ ptsPG 2 fq
     line [a,b,c] = [ [x,y] | [x,y] <- points, a*x+b*y+c==0 ]
 
--- |The projective plane PG(2,Fq), a square 2-(q^2+q+1,q+1,1) design
+-- |The projective plane PG(2,Fq), a square 2-(q^2+q+1,q+1,1) design or Steiner system S(2,q+1,q^2+q+1).
+-- For example, @pg2 f2@ is the Fano plane, a Steiner triple system S(2,3,7).
 pg2 :: (FiniteField k, Ord k) => [k] -> Design [k]
 pg2 fq = design (points, lines) where
     points = ptsPG 2 fq

@@ -330,7 +330,7 @@ 
 -- kneser v k | v >= 2*k = j v k 0
 -- |kneser n k returns the kneser graph KG n,k -
--- whose vertices are the k-element subsets of [1..n], with edges joining disjoint subsets
+-- whose vertices are the k-element subsets of [1..n], with edges between disjoint subsets
 kneser :: Int -> Int -> Graph [Int]
 kneser n k | 2*k <= n = graph (vs,es) where
     vs = combinationsOf k [1..n]

@@ -1,6 +1,12 @@ -- Copyright (c) 2008, David Amos. All rights reserved.
 
--- |A module defining various strongly regular graphs, including the Clebsch, Hoffman-Singleton, Higman-Sims, and McLaughlin graphs
+-- |A module defining various strongly regular graphs, including the Clebsch, Hoffman-Singleton, Higman-Sims, and McLaughlin graphs.
+--
+-- A strongly regular graph with parameters (n,k,lambda,mu) is a (simple) graph with n vertices,
+-- in which the number of common neighbours of x and y is k, lambda or mu according as whether
+-- x and y are equal, adjacent, or non-adjacent. (In particular, it is a k-regular graph.)
+--
+-- Strongly regular graphs are highly symmetric, and have large automorphism groups.
 module Math.Combinatorics.StronglyRegularGraph where
 
 import qualified Data.List as L

@@ -273,7 +273,7 @@ -- >     return = var -- >     (>>=) = bind ----- bind corresponds to variable substitution, so @v `bind` f@ returns the result of making the substitutions+-- bind corresponds to variable substitution, so @v \`bind\` f@ returns the result of making the substitutions -- encoded in f into v. -- -- Note that the type signature is slightly more general than that required by (>>=).

@@ -11,16 +11,11 @@  toSet = S.toList . S.fromList -{---- Merge two ordered listsets. Elements appearing in both inputs appear only once in the output-mergeSet (x:xs) (y:ys) =-    case compare x y of-    LT -> x : mergeSet xs (y:ys)-    EQ -> x : mergeSet xs ys-    GT -> y : mergeSet (x:xs) ys-mergeSet xs ys = xs ++ ys--}+sortDesc = L.sortBy (flip compare) +insertDesc = L.insertBy (flip compare)++ -- |The set union of two ascending lists. If both inputs are strictly increasing, then the output is their union -- and is strictly increasing. The code does not check that the lists are strictly increasing. setUnionAsc :: Ord a => [a] -> [a] -> [a]@@ -94,8 +89,9 @@   -- fold a comparison operator through a list-foldcmpl p (x1:x2:xs) = p x1 x2 && foldcmpl p (x2:xs)-foldcmpl _ _ = True+foldcmpl p xs = and $ zipWith p xs (tail xs)+-- foldcmpl p (x1:x2:xs) = p x1 x2 && foldcmpl p (x2:xs)+-- foldcmpl _ _ = True  -- foldcmpl _ [] = True -- foldcmpl p xs = and $ zipWith p xs (tail xs)@@ -106,6 +102,12 @@ isStrictlyIncreasing :: Ord t => [t] -> Bool isStrictlyIncreasing = foldcmpl (<) +isWeaklyDecreasing :: Ord t => [t] -> Bool+isWeaklyDecreasing = foldcmpl (>=)++isStrictlyDecreasing :: Ord t => [t] -> Bool+isStrictlyDecreasing = foldcmpl (>)+ -- for use with L.sortBy cmpfst x y = compare (fst x) (fst y) @@ -148,14 +150,12 @@     elts :: [x]  -- |A class representing algebraic structures having an inverse operation.--- Although strictly speaking the Num precondition means that we are requiring the structure--- also to be a ring, we do sometimes bend the rules (eg permutation groups).--- Note also that we don't insist that every element has an inverse.-class Num a => HasInverses a where+-- Note that in some cases not every element has an inverse.+class HasInverses a where     inverse :: a -> a  infix 8 ^-  -- |A trick: x^-1 returns the inverse of x-(^-) :: (HasInverses a, Integral b) => a -> b -> a+(^-) :: (Num a, HasInverses a, Integral b) => a -> b -> a x ^- n = inverse x ^ n

@@ -1,7 +1,8 @@ -- Copyright (c) 2006-2011, David Amos. All rights reserved.  -- |A module for finding prime factors.-module Math.NumberTheory.Factor (pfactors) where+module Math.NumberTheory.Factor (module Math.NumberTheory.Prime,+                                 pfactors) where  import Math.NumberTheory.Prime import Data.Either (lefts)

@@ -108,7 +108,7 @@   -- BIALGEBRAS-+{- prop_Bialgebra1 (x,y) =     let xy = x `te` y in     (comult . mult) xy ==@@ -117,6 +117,13 @@       (id `tf` (twist `tf` id)) .       (id `tf` assocL) . assocR .       (comult `tf` comult) ) xy+-}+prop_Bialgebra1 (x,y) =+    let xy = x `te` y in+    (comult . mult) xy ==+    ( (mult `tf` mult) .+      fmap (\((a,a'),(b,b')) -> ((a,b),(a',b')) ) .+      (comult `tf` comult) ) xy  prop_Bialgebra2 (k,xy) =     (comult . unit') k' + xy == ((unit' `tf` unit') . iso) k' + xy@@ -139,7 +146,15 @@     prop_Bialgebra3 (x,y) &&     prop_Bialgebra4 (k,x) +-- Claim that this is equivalent to the above, but much shorter because it piggy-backs on+-- the coalgebra instance for tensor product, and the algebra morphism definition+prop_BialgebraA (k,x,y) = prop_AlgebraMorphism (wrap . counit) (k,x,y) && prop_AlgebraMorphism comult (k,x,y) ++-- Need a way to force the result type of (unit . unwrap) to be the same as the type of x and y+-- prop_BialgebraC (k,x,y) = prop_CoalgebraMorphism (unit . unwrap) (wrap k) && prop_CoalgebraMorphism mult (x `te` y)++ prop_HopfAlgebra x =     (unit . counit) x == (mult . (antipode `tf` id) . comult) x &&     (unit . counit) x == (mult . (id `tf` antipode) . comult) x@@ -165,6 +180,28 @@ -}  +-- PAIRINGS++-- http://mathoverflow.net/questions/20666/is-a-bialgebra-pairing-of-hopf-algebras-automatically-a-hopf-pairing+-- Hazewinkel p155+-- Majid, Quantum Groups Primer, p12+prop_BialgebraPairing+  :: (Eq k, Num k, Ord a, Ord b, Show a, Show b, Bialgebra k a,+      Bialgebra k b, HasPairing k a b) =>+     (Vect k a, Vect k a, Vect k b, Vect k b) -> Bool+prop_BialgebraPairing (u,v,x,y) =+    pairing' (mult (u `te` v)) x == pairing' (u `te` v) (comult x) && -- mult in A is adjoint to comult in B+    pairing' (comult u) (x `te` y) == pairing' u (mult (x `te` y)) && -- comult in A is adjoint to mult in B+    pairing' (1+u-u) x == counit x && -- unit (ie 1) is adjoint to counit+    pairing' u (1+x-x) == counit u+-- The +x-x is to coerce the type of unit k+-- The same could probably be achieved with ScopedTypeVariables++prop_HopfPairing (u,v,x,y) =+    prop_BialgebraPairing (u,v,x,y) &&+    pairing' (antipode u) x == pairing' u (antipode x)++ -- ALTERNATIVE DEFINITION OF ALGEBRA  type TensorProd k u v =@@ -173,7 +210,6 @@ class Algebra2 k a where     unit2 :: k -> a     mult2 :: TensorProd k a a -> a-   -- FROBENIUS ALGEBRAS

@@ -7,8 +7,10 @@ import Data.List as L  import Math.Core.Field+import Math.Combinatorics.Poset (integerPartitions)  import Math.Algebras.VectorSpace hiding (E)+import Math.Algebras.TensorProduct -- for ghci import Math.Algebras.Structures  import Math.Combinatorics.CombinatorialHopfAlgebra@@ -28,6 +30,10 @@     quickCheckYSymM     quickCheckQSymM     quickCheckQSymF+    quickCheckSymM+    quickCheckSymE+    quickCheckSymH+    quickCheckNSym     quickCheckCHAIsomorphism     quickCheckCHAMorphism @@ -41,6 +47,7 @@     quickCheck (prop_Coalgebra :: Vect Q (Shuffle Int) -> Bool)     quickCheck (prop_Bialgebra :: (Q, Vect Q (Shuffle Int), Vect Q (Shuffle Int)) -> Bool) -- slow     quickCheck (prop_HopfAlgebra :: Vect Q (Shuffle Int) -> Bool)+    quickCheck (prop_Commutative :: (Vect Q (Shuffle Int), Vect Q (Shuffle Int)) -> Bool)   instance Arbitrary SSymF where@@ -67,9 +74,16 @@     -- quickCheck (prop_Bialgebra :: (Q, Vect Q SSymM, Vect Q SSymM) -> Bool) -- too slow     quickCheck (prop_HopfAlgebra :: Vect Q SSymM -> Bool) +quickCheckDualSSymF = do+    putStrLn "Checking Dual(SSymF)"+    -- quickCheck (prop_Algebra :: (Q, Vect Q (Dual SSymF), Vect Q (Dual SSymF), Vect Q (Dual SSymF)) -> Bool) -- too slow+    quickCheck (prop_Coalgebra :: Vect Q (Dual SSymF) -> Bool)+    quickCheck (prop_Bialgebra :: (Q, Vect Q (Dual SSymF), Vect Q (Dual SSymF)) -> Bool)+    quickCheck (prop_HopfAlgebra :: Vect Q (Dual SSymF) -> Bool)  instance Arbitrary (YSymF ()) where-    arbitrary = fmap (YSymF . shape . descendingTree . take 3) (arbitrary :: Gen [Int])+    arbitrary = fmap YSymF (elements (concatMap trees [0..3]))+    -- arbitrary = fmap (YSymF . shape . descendingTree . take 3) (arbitrary :: Gen [Int]) -- We use descendingTree because it can make trees of interesting shapes from a given list -- but we could equally have used other tree construction methods such as binary search tree @@ -79,7 +93,8 @@ -- rather than leaving the descendingTree labels  instance Arbitrary (YSymM) where-    arbitrary = fmap (YSymM . shape . descendingTree . take 3) (arbitrary :: Gen [Int])+    arbitrary = fmap YSymM (elements (concatMap trees [0..3]))+    -- arbitrary = fmap (YSymM . shape . descendingTree . take 3) (arbitrary :: Gen [Int])  quickCheckYSymF = do     putStrLn "Checking YSymF"@@ -112,6 +127,7 @@     quickCheck (prop_Coalgebra :: Vect Q QSymM -> Bool)     quickCheck (prop_Bialgebra :: (Q, Vect Q QSymM, Vect Q QSymM) -> Bool)     quickCheck (prop_HopfAlgebra :: (Vect Q QSymM) -> Bool)+    quickCheck (prop_Commutative :: (Vect Q QSymM, Vect Q QSymM) -> Bool)  quickCheckQSymF = do     putStrLn "Checking QSymF"@@ -119,38 +135,101 @@     quickCheck (prop_Coalgebra :: Vect Q QSymF -> Bool)     quickCheck (prop_Bialgebra :: (Q, Vect Q QSymF, Vect Q QSymF) -> Bool)     quickCheck (prop_HopfAlgebra :: (Vect Q QSymF) -> Bool)+    quickCheck (prop_Commutative :: (Vect Q QSymF, Vect Q QSymF) -> Bool) +instance Arbitrary SymM where+    arbitrary = do xs <- elements (concatMap integerPartitions [0..4])+                   return (SymM xs)++quickCheckSymM = do+    putStrLn "Checking SymM"+    quickCheck (prop_Algebra :: (Q, Vect Q SymM, Vect Q SymM, Vect Q SymM) -> Bool)+    quickCheck (prop_Coalgebra :: Vect Q SymM -> Bool)+    quickCheck (prop_Bialgebra :: (Q, Vect Q SymM, Vect Q SymM) -> Bool)+    quickCheck (prop_HopfAlgebra :: Vect Q SymM -> Bool)+    quickCheck (prop_Commutative :: (Vect Q SymM, Vect Q SymM) -> Bool)+    quickCheck (prop_Cocommutative :: Vect Q SymM -> Bool)++instance Arbitrary SymE where+    arbitrary = do xs <- elements (concatMap integerPartitions [0..4])+                   return (SymE xs)++quickCheckSymE = do+    putStrLn "Checking SymE"+    quickCheck (prop_Algebra :: (Q, Vect Q SymE, Vect Q SymE, Vect Q SymE) -> Bool)+    quickCheck (prop_Coalgebra :: Vect Q SymE -> Bool)+    quickCheck (prop_Bialgebra :: (Q, Vect Q SymE, Vect Q SymE) -> Bool)+    -- quickCheck (prop_HopfAlgebra :: Vect Q SymE -> Bool)+    quickCheck (prop_Commutative :: (Vect Q SymE, Vect Q SymE) -> Bool)+    quickCheck (prop_Cocommutative :: Vect Q SymE -> Bool)++instance Arbitrary SymH where+    arbitrary = do xs <- elements (concatMap integerPartitions [0..4])+                   return (SymH xs)++quickCheckSymH = do+    putStrLn "Checking SymH"+    quickCheck (prop_Algebra :: (Q, Vect Q SymH, Vect Q SymH, Vect Q SymH) -> Bool)+    quickCheck (prop_Coalgebra :: Vect Q SymH -> Bool)+    quickCheck (prop_Bialgebra :: (Q, Vect Q SymH, Vect Q SymH) -> Bool)+    -- quickCheck (prop_HopfAlgebra :: (Vect Q SymH) -> Bool)+    quickCheck (prop_Commutative :: (Vect Q SymH, Vect Q SymH) -> Bool)+    quickCheck (prop_Cocommutative :: Vect Q SymH -> Bool)++-- The basis isn't indexed by compositions, but using compositions is an easy way to ensure+-- that we have positive ints and that they're bounded (to keep the comult manageable)+instance Arbitrary NSym where+    arbitrary = do xs <- elements compositionsTo4+                   return (NSym xs)+        where compositionsTo4 = concatMap compositions [0..4]++quickCheckNSym = do+    putStrLn "Checking NSym"+    quickCheck (prop_Algebra :: (Q, Vect Q NSym, Vect Q NSym, Vect Q NSym) -> Bool)+    quickCheck (prop_Coalgebra :: Vect Q NSym -> Bool)+    quickCheck (prop_Bialgebra :: (Q, Vect Q NSym, Vect Q NSym) -> Bool)+    quickCheck (prop_HopfAlgebra :: Vect Q NSym -> Bool)++ quickCheckCHAIsomorphism = do     putStrLn "Checking CHA isomorphism (change of basis)"     putStrLn "Checking bijections"-    quickCheck (prop_Id (toSSymF . toSSymM) :: Vect Q SSymF -> Bool)-    quickCheck (prop_Id (toSSymM . toSSymF) :: Vect Q SSymM -> Bool)-    quickCheck (prop_Id (toYSymF . toYSymM) :: Vect Q (YSymF ()) -> Bool)-    quickCheck (prop_Id (toYSymM . toYSymF) :: Vect Q YSymM -> Bool)-    quickCheck (prop_Id (toQSymF . toQSymM) :: Vect Q QSymF -> Bool)-    quickCheck (prop_Id (toQSymM . toQSymF) :: Vect Q QSymM -> Bool)+    quickCheck (prop_Id (ssymMtoF . ssymFtoM) :: Vect Q SSymF -> Bool)+    quickCheck (prop_Id (ssymFtoM . ssymMtoF) :: Vect Q SSymM -> Bool)+    quickCheck (prop_Id (ysymMtoF . ysymFtoM) :: Vect Q (YSymF ()) -> Bool)+    quickCheck (prop_Id (ysymFtoM . ysymMtoF) :: Vect Q YSymM -> Bool)+    quickCheck (prop_Id (qsymMtoF . qsymFtoM) :: Vect Q QSymF -> Bool)+    quickCheck (prop_Id (qsymFtoM . qsymMtoF) :: Vect Q QSymM -> Bool)     putStrLn "Checking morphisms"     putStrLn "SSym"-    -- quickCheck (prop_AlgebraMorphism toSSymF :: (Q, Vect Q SSymM, Vect Q SSymM) -> Bool) -- too slow-    -- quickCheck (prop_AlgebraMorphism toSSymM :: (Q, Vect Q SSymF, Vect Q SSymF) -> Bool) -- too slow-    quickCheck (prop_CoalgebraMorphism toSSymF :: Vect Q SSymM -> Bool)-    quickCheck (prop_CoalgebraMorphism toSSymM :: Vect Q SSymF -> Bool)-    quickCheck (prop_HopfAlgebraMorphism toSSymM :: Vect Q SSymF -> Bool)-    quickCheck (prop_HopfAlgebraMorphism toSSymF :: Vect Q SSymM -> Bool)+    -- quickCheck (prop_AlgebraMorphism ssymMtoF :: (Q, Vect Q SSymM, Vect Q SSymM) -> Bool) -- too slow+    -- quickCheck (prop_AlgebraMorphism ssymFtoM :: (Q, Vect Q SSymF, Vect Q SSymF) -> Bool) -- too slow+    quickCheck (prop_CoalgebraMorphism ssymMtoF :: Vect Q SSymM -> Bool)+    quickCheck (prop_CoalgebraMorphism ssymFtoM :: Vect Q SSymF -> Bool)+    quickCheck (prop_HopfAlgebraMorphism ssymFtoM :: Vect Q SSymF -> Bool)+    quickCheck (prop_HopfAlgebraMorphism ssymMtoF :: Vect Q SSymM -> Bool)+    quickCheck (prop_AlgebraMorphism ssymFtoDual :: (Q, Vect Q SSymF, Vect Q SSymF) -> Bool)+    quickCheck (prop_CoalgebraMorphism ssymFtoDual :: Vect Q SSymF -> Bool)+    quickCheck (prop_HopfAlgebraMorphism ssymFtoDual :: Vect Q SSymF -> Bool)     putStrLn "YSym"-    -- quickCheck (prop_AlgebraMorphism toYSymF :: (Q, Vect Q YSymM, Vect Q YSymM) -> Bool) -- too slow-    quickCheck (prop_AlgebraMorphism toYSymM :: (Q, Vect Q (YSymF ()), Vect Q (YSymF ())) -> Bool)-    quickCheck (prop_CoalgebraMorphism toYSymF :: Vect Q YSymM -> Bool)-    quickCheck (prop_CoalgebraMorphism toYSymM :: Vect Q (YSymF ()) -> Bool)-    quickCheck (prop_HopfAlgebraMorphism toYSymF :: Vect Q YSymM -> Bool)-    quickCheck (prop_HopfAlgebraMorphism toYSymM :: Vect Q (YSymF ()) -> Bool)+    -- quickCheck (prop_AlgebraMorphism ysymMtoF :: (Q, Vect Q YSymM, Vect Q YSymM) -> Bool) -- too slow+    quickCheck (prop_AlgebraMorphism ysymFtoM :: (Q, Vect Q (YSymF ()), Vect Q (YSymF ())) -> Bool)+    quickCheck (prop_CoalgebraMorphism ysymMtoF :: Vect Q YSymM -> Bool)+    quickCheck (prop_CoalgebraMorphism ysymFtoM :: Vect Q (YSymF ()) -> Bool)+    quickCheck (prop_HopfAlgebraMorphism ysymMtoF :: Vect Q YSymM -> Bool)+    quickCheck (prop_HopfAlgebraMorphism ysymFtoM :: Vect Q (YSymF ()) -> Bool)     putStrLn "QSym"-    quickCheck (prop_AlgebraMorphism toQSymF :: (Q, Vect Q QSymM, Vect Q QSymM) -> Bool)-    quickCheck (prop_AlgebraMorphism toQSymM :: (Q, Vect Q QSymF, Vect Q QSymF) -> Bool)-    quickCheck (prop_CoalgebraMorphism toQSymF :: Vect Q QSymM -> Bool)-    quickCheck (prop_CoalgebraMorphism toQSymM :: Vect Q QSymF -> Bool)-    quickCheck (prop_HopfAlgebraMorphism toQSymM :: Vect Q QSymF -> Bool)-    quickCheck (prop_HopfAlgebraMorphism toQSymF :: Vect Q QSymM -> Bool)+    quickCheck (prop_AlgebraMorphism qsymMtoF :: (Q, Vect Q QSymM, Vect Q QSymM) -> Bool)+    quickCheck (prop_AlgebraMorphism qsymFtoM :: (Q, Vect Q QSymF, Vect Q QSymF) -> Bool)+    quickCheck (prop_CoalgebraMorphism qsymMtoF :: Vect Q QSymM -> Bool)+    quickCheck (prop_CoalgebraMorphism qsymFtoM :: Vect Q QSymF -> Bool)+    quickCheck (prop_HopfAlgebraMorphism qsymFtoM :: Vect Q QSymF -> Bool)+    quickCheck (prop_HopfAlgebraMorphism qsymMtoF :: Vect Q QSymM -> Bool)+    putStrLn "Sym"+    quickCheck (prop_AlgebraMorphism symEtoM :: (Q, Vect Q SymE, Vect Q SymE) -> Bool)+    quickCheck (prop_AlgebraMorphism symHtoM :: (Q, Vect Q SymH, Vect Q SymH) -> Bool)+    quickCheck (prop_CoalgebraMorphism symEtoM :: Vect Q SymE -> Bool)+    quickCheck (prop_CoalgebraMorphism symHtoM :: Vect Q SymH -> Bool)     where prop_Id f x = f x == x   quickCheckCHAMorphism = do@@ -165,14 +244,43 @@     quickCheck (prop_CoalgebraMorphism leftLeafCompositionMap :: Vect Q (YSymF ()) -> Bool)     quickCheck (prop_HopfAlgebraMorphism leftLeafCompositionMap :: Vect Q (YSymF ()) -> Bool)     quickCheck (\x -> descentMap x == (leftLeafCompositionMap . descendingTreeMap) (x :: Vect Q SSymF))+    quickCheck (prop_AlgebraMorphism symToQSymM :: (Q, Vect Q SymM, Vect Q SymM) -> Bool)+    quickCheck (prop_CoalgebraMorphism symToQSymM :: Vect Q SymM -> Bool)+    quickCheck (prop_HopfAlgebraMorphism symToQSymM :: Vect Q SymM -> Bool)+    -- quickCheck (prop_AlgebraMorphism nsymToSSym :: (Q, Vect Q NSym, Vect Q NSym) -> Bool) -- too slow+    quickCheck (prop_CoalgebraMorphism nsymToSSym :: Vect Q NSym -> Bool)+    quickCheck (prop_HopfAlgebraMorphism nsymToSSym :: Vect Q NSym -> Bool)+    quickCheck (prop_AlgebraMorphism nsymToSymH :: (Q, Vect Q NSym, Vect Q NSym) -> Bool)+    quickCheck (prop_CoalgebraMorphism nsymToSymH :: Vect Q NSym -> Bool)+    -- The map NSym -> Sym factors through the descent map SSym -> (YSym ->) QSym+    quickCheck (\x -> (symToQSymM . symHtoM . nsymToSymH) x == (qsymFtoM . descentMap . nsymToSSym) (x :: Vect Q NSym))     -- Coalgebra morphisms showing that various Hopf algebras are cofree     quickCheck (prop_CoalgebraMorphism ysymmToSh :: Vect Q YSymM -> Bool)+    -- Duality pairings+    quickCheck (prop_HopfPairing :: (Vect Q SSymF, Vect Q SSymF, Vect Q (Dual SSymF), Vect Q (Dual SSymF)) -> Bool)+    quickCheck (prop_HopfPairing :: (Vect Q SSymF, Vect Q SSymF, Vect Q SSymF, Vect Q SSymF) -> Bool)+    quickCheck (prop_BialgebraPairing :: (Vect Q SymH, Vect Q SymH, Vect Q SymM, Vect Q SymM) -> Bool)+    -- The above is in fact a Hopf pairing, but need to define a Hopf algebra instance for SymH+    quickCheck (prop_HopfPairing :: (Vect Q NSym, Vect Q NSym, Vect Q QSymM, Vect Q QSymM) -> Bool)+    -- A bialgebra pairing <A,B> gives a map A -> B*, u -> <u,.>+    -- However, require that the pairing is non-degenerate in order to be injective, and also need to prove surjective   testlistCHA = TestList [-    TestCase $ assertEqual "toYSymF" (toYSymF $ ysymM $ T (T E () E) () (T (T E () E) () E))+    TestCase $ assertEqual "ysymMtoF" (ysymMtoF $ ysymM $ T (T E () E) () (T (T E () E) () E))                ( ysymF (T (T E () E) () (T (T E () E) () E)) - ysymF (T (T E () E) () (T E () (T E () E)))                - ysymF (T E () (T E () (T (T E () E) () E))) + ysymF (T E () (T E () (T E () (T E () E)))) ), -- Loday.pdf, p10     TestCase $ assertEqual "leftLeafComposition" [2,3,2,1]-               (leftLeafComposition $ T (T (T E 1 E) 2 (T (T E 3 E) 4 E)) 5 (T (T E 6 E) 7 (T E 8 E))) -- Loday.pdf, p6+               (leftLeafComposition $ T (T (T E 1 E) 2 (T (T E 3 E) 4 E)) 5 (T (T E 6 E) 7 (T E 8 E))), -- Loday.pdf, p6+    TestCase $ assertEqual "mult QSymM" (qsymM [1,3] + qsymM [3,1] + qsymM [1,1,2] + qsymM [1,2,1] + qsymM [2,1,1])+                                        (qsymM [2] * qsymM [1,1]), -- SSym.pdf, p5+    TestCase $ assertEqual "mult QSymM" (qsymM [1,3] + qsymM [2,2] + 2*qsymM [1,1,2] + qsymM [1,2,1])+                                        (qsymM [1] * qsymM [1,2]), -- SSym.pdf, p31+    TestCase $ assertEqual "mult SSymF" (ssymM [1,2,4,3]+ssymM [1,3,4,2]+ssymM [1,4,2,3]+3*ssymM [1,4,3,2]+ssymM [2,3,4,1]+2*ssymM [2,4,3,1]+                                        +ssymM [3,4,2,1]+ssymM [4,1,2,3]+2*ssymM [4,1,3,2]+ssymM [4,2,3,1]+ssymM [4,3,1,2])+                                        (ssymM [1,2] * ssymM [2,1]), -- SSym.pdf, p15+    TestCase $ assertEqual "ssymMtoF" (ssymF [4,1,2,3] - ssymF [4,1,3,2] - ssymF [4,2,1,3] + ssymF [4,3,2,1])+                                     (ssymMtoF (ssymM [4,1,2,3])), -- SSym.pdf, p7+    TestCase $ assertEqual "antipode NSym" (- nsym [1,1,1] + nsym [1,2] + nsym [2,1] - nsym [3])+                                           (antipode $ nsym [3]) -- Hazewinkel p142     ]