diff --git a/HaskellForMaths.cabal b/HaskellForMaths.cabal --- a/HaskellForMaths.cabal +++ b/HaskellForMaths.cabal @@ -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 diff --git a/Math/Algebras/Structures.hs b/Math/Algebras/Structures.hs --- a/Math/Algebras/Structures.hs +++ b/Math/Algebras/Structures.hs @@ -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'))) + diff --git a/Math/Algebras/VectorSpace.hs b/Math/Algebras/VectorSpace.hs --- a/Math/Algebras/VectorSpace.hs +++ b/Math/Algebras/VectorSpace.hs @@ -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 diff --git a/Math/Combinatorics/CombinatorialHopfAlgebra.hs b/Math/Combinatorics/CombinatorialHopfAlgebra.hs --- a/Math/Combinatorics/CombinatorialHopfAlgebra.hs +++ b/Math/Combinatorics/CombinatorialHopfAlgebra.hs @@ -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 -> 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 -> is onto + diff --git a/Math/Combinatorics/Design.hs b/Math/Combinatorics/Design.hs --- a/Math/Combinatorics/Design.hs +++ b/Math/Combinatorics/Design.hs @@ -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 diff --git a/Math/Combinatorics/Graph.hs b/Math/Combinatorics/Graph.hs --- a/Math/Combinatorics/Graph.hs +++ b/Math/Combinatorics/Graph.hs @@ -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] diff --git a/Math/Combinatorics/StronglyRegularGraph.hs b/Math/Combinatorics/StronglyRegularGraph.hs --- a/Math/Combinatorics/StronglyRegularGraph.hs +++ b/Math/Combinatorics/StronglyRegularGraph.hs @@ -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 diff --git a/Math/CommutativeAlgebra/Polynomial.hs b/Math/CommutativeAlgebra/Polynomial.hs --- a/Math/CommutativeAlgebra/Polynomial.hs +++ b/Math/CommutativeAlgebra/Polynomial.hs @@ -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 (>>=). diff --git a/Math/Core/Utils.hs b/Math/Core/Utils.hs --- a/Math/Core/Utils.hs +++ b/Math/Core/Utils.hs @@ -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 diff --git a/Math/NumberTheory/Factor.hs b/Math/NumberTheory/Factor.hs --- a/Math/NumberTheory/Factor.hs +++ b/Math/NumberTheory/Factor.hs @@ -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) diff --git a/Math/Test/TAlgebras/TStructures.hs b/Math/Test/TAlgebras/TStructures.hs --- a/Math/Test/TAlgebras/TStructures.hs +++ b/Math/Test/TAlgebras/TStructures.hs @@ -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 diff --git a/Math/Test/TCombinatorics/TCombinatorialHopfAlgebra.hs b/Math/Test/TCombinatorics/TCombinatorialHopfAlgebra.hs --- a/Math/Test/TCombinatorics/TCombinatorialHopfAlgebra.hs +++ b/Math/Test/TCombinatorics/TCombinatorialHopfAlgebra.hs @@ -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 gives a map A -> B*, 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 ]