HaskellForMaths 0.4.8 → 0.4.9

raw patch · 10 files changed

+104/−20 lines, 10 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/AffinePlane.hs +2/−2
• Math/Algebras/Structures.hs +11/−0
• Math/Algebras/VectorSpace.hs +2/−1
• Math/Combinatorics/CombinatorialHopfAlgebra.hs +72/−5
• Math/Combinatorics/Digraph.hs +2/−2
• Math/Combinatorics/GraphAuts.hs +2/−2
• Math/Combinatorics/Poset.hs +3/−2
• Math/QuantumAlgebra/OrientedTangle.hs +2/−2
• Math/QuantumAlgebra/Tangle.hs +7/−3

@@ -1,5 +1,5 @@    Name:                HaskellForMaths
-   Version:             0.4.8
+   Version:             0.4.9
    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

@@ -83,8 +83,8 @@ instance HopfAlgebra Q (SL2 ABCD) where     antipode x = x `bind` antipode'         where antipode' A = d-              antipode' B = b-              antipode' C = c+              antipode' B = -b+              antipode' C = -c               antipode' D = a -- in the GL2 case we would need 1/det factor as well 

@@ -147,6 +147,17 @@     --        . (id `tf` assocL) . assocR . (comult `tf` comult)  +newtype Op b = Op b deriving (Eq, Ord, Show)++instance (Eq k, Num k, Ord b, Algebra k b) => Algebra k (Op b) where+    unit = fmap Op . unit+    mult = nf . fmap Op . mult . fmap (\(Op a, Op b) -> (b, a)) -- ie mult . twist++instance (Eq k, Num k, Ord b, Coalgebra k b) => Coalgebra k (Op b) where+    counit = counit . fmap (\(Op b) -> b)+    comult = nf . fmap (\(a, b) -> (Op b, Op a)) . comult . fmap (\(Op b) -> b) -- ie twist . comult++ -- The set coalgebra - can be defined on any set instance (Eq k, Num k) => Coalgebra k EBasis where     counit (V ts) = sum [x | (ei,x) <- ts]  -- trace

@@ -175,7 +175,8 @@ -- 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]+    -- V ts >>= f = V $ concat [ [(b,y*x) | let V us = f a, (b,y) <- us] | (a,x) <- ts]+    V ts >>= f = V $ [ (b,y*x) | (a,x) <- ts, let V us = f a, (b,y) <- us]     -- Note that as we can't assume Ord a in the Monad instance, we need to call "nf" afterwards  -- |A linear map between vector spaces A and B can be defined by giving its action on the basis elements of A.

@@ -53,6 +53,33 @@ import Math.CommutativeAlgebra.Polynomial  ++class Graded b where+  grade :: b -> Int++instance Graded b => Graded (Dual b) where grade (Dual b) = grade b+++class (Eq k, Num k, Ord b, Graded b, HopfAlgebra k b) => CombinatorialHopfAlgebra k b where+    zeta :: Vect k b -> Vect k ()+++-- Hazewinkel et al, p155.+-- Given a graded, connected Hopf algebra, we can calculate the antipode recursively.+-- (A connected Hopf algebra means that the counit is projection onto the grade 0 part.)+-- Then we can calculate the antipode using mult . (id `tf` antipode) . comult == unit . counit+gradedConnectedAntipode+  :: (Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>+     Vect k b -> Vect k b+gradedConnectedAntipode = linear antipode' where+    antipode' b = if grade b == 0+                  then return b+                  else (negatev . mult . (id `tf` gradedConnectedAntipode) . removeLeftGradeZero . comult . return) b+    -- removeLeftGradeZero :: Graded b => Vect k (b,b) -> Vect k (b,b)+    removeLeftGradeZero (V ts) = V $ filter (\((l,r),_) -> grade l /= 0) ts+++ -- SHUFFLE ALGEBRA -- This is just the tensor algebra, but with shuffle product (and deconcatenation coproduct) @@ -61,6 +88,8 @@ -- deconcatenation coproduct, this leads to a Hopf algebra structure. newtype Shuffle a = Sh [a] deriving (Eq,Ord,Show) +instance Graded (Shuffle a) where grade (Sh xs) = length xs+ -- |Construct a basis element of the shuffle algebra sh :: [a] -> Vect Q (Shuffle a) sh = return . Sh@@ -105,6 +134,8 @@ instance Show SSymF where     show (SSymF xs) = "F " ++ show xs +instance Graded SSymF where grade (SSymF xs) = length xs+ -- |Construct a fundamental basis element in SSym. -- The list of ints must be a permutation of [1..n], eg [1,2], [3,4,2,1]. ssymF :: [Int] -> Vect Q SSymF@@ -143,11 +174,14 @@ instance (Eq k, Num k) => Bialgebra k SSymF where {}  instance (Eq k, Num k) => HopfAlgebra k SSymF where+    antipode = gradedConnectedAntipode+    {-     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. {- instance (Eq k, Num k) => HopfAlgebra k SSymF where@@ -180,6 +214,8 @@ instance Show SSymM where     show (SSymM xs) = "M " ++ show xs +instance Graded SSymM where grade (SSymM xs) = length xs+ -- |Construct a monomial basis element in SSym. -- The list of ints must be a permutation of [1..n], eg [1,2], [3,4,2,1]. ssymM :: [Int] -> Vect Q SSymM@@ -258,7 +294,8 @@ instance (Eq k, Num k) => Bialgebra k SSymM where {}  instance (Eq k, Num k) => HopfAlgebra k SSymM where-    antipode = ssymFtoM . antipode . ssymMtoF+    antipode = gradedConnectedAntipode+    -- antipode = ssymFtoM . antipode . ssymMtoF   -- Hazewinkel p265@@ -286,10 +323,13 @@ instance (Eq k, Num k) => Bialgebra k (Dual SSymF) where {}  instance (Eq k, Num k) => HopfAlgebra k (Dual SSymF) where+    antipode = gradedConnectedAntipode+    {-     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@@ -325,6 +365,8 @@ instance Show a => Show (YSymF a) where     show (YSymF t) = "F(" ++ show t ++ ")" +instance Graded (YSymF a) where grade (YSymF t) = nodecount t+ -- |Construct the element of YSym in the fundamental basis indexed by the given tree ysymF :: PBT a -> Vect Q (YSymF a) ysymF t = return (YSymF t)@@ -408,9 +450,12 @@ 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 = gradedConnectedAntipode+    {-     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.@@ -419,6 +464,8 @@ instance Show YSymM where     show (YSymM t) = "M(" ++ show t ++ ")" +instance Graded YSymM where grade (YSymM t) = nodecount t+ -- |Construct the element of YSym in the monomial basis indexed by the given tree ysymM :: PBT () -> Vect Q YSymM ysymM t = return (YSymM t)@@ -486,7 +533,8 @@ instance (Eq k, Num k) => Bialgebra k YSymM where {}  instance (Eq k, Num k) => HopfAlgebra k YSymM where-    antipode = ysymFtoM . antipode . ysymMtoF +    antipode = gradedConnectedAntipode+    -- antipode = ysymFtoM . antipode . ysymMtoF    -- QSYM: QUASI-SYMMETRIC FUNCTIONS@@ -522,6 +570,8 @@ instance Show QSymM where     show (QSymM xs) = "M " ++ show xs +instance Graded QSymM where grade (QSymM xs) = sum xs+ -- |Construct the element of QSym in the monomial basis indexed by the given composition qsymM :: [Int] -> Vect Q QSymM qsymM xs | all (>0) xs = return (QSymM xs)@@ -540,9 +590,12 @@ instance (Eq k, Num k) => Bialgebra k QSymM where {}  instance (Eq k, Num k) => HopfAlgebra k QSymM where+    antipode = gradedConnectedAntipode+    {-     antipode = linear antipode' where         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) = map (x1:) (coarsenings (x2:xs)) ++ coarsenings ((x1+x2):xs) coarsenings xs = [xs] -- for xs a singleton or null@@ -560,6 +613,8 @@ instance Show QSymF where     show (QSymF xs) = "F " ++ show xs +instance Graded QSymF where grade (QSymF xs) = sum xs+ -- |Construct the element of QSym in the fundamental basis indexed by the given composition qsymF :: [Int] -> Vect Q QSymF qsymF xs | all (>0) xs = return (QSymF xs)@@ -586,7 +641,8 @@ instance (Eq k, Num k) => Bialgebra k QSymF where {}  instance (Eq k, Num k) => HopfAlgebra k QSymF where-    antipode = qsymMtoF . antipode . qsymFtoM+    antipode = gradedConnectedAntipode+    -- antipode = qsymMtoF . antipode . qsymFtoM   -- QUASI-SYMMETRIC POLYNOMIALS@@ -612,6 +668,8 @@ instance Ord SymM where     compare (SymM xs) (SymM ys) = compare (sum xs, ys) (sum ys, xs) -- note the order reversal in snd +instance Graded SymM where grade (SymM xs) = sum xs+ -- |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)@@ -643,16 +701,20 @@ instance (Eq k, Num k) => Bialgebra k SymM where {}  instance (Eq k, Num k) => HopfAlgebra k SymM where+    antipode = gradedConnectedAntipode+    {-     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) +instance Graded SymE where grade (SymE xs) = sum xs+ symE :: [Int] -> Vect Q SymE symE xs | all (>0) xs = return (SymE $ sortDesc xs)         | otherwise = error "symE: not a partition"@@ -671,6 +733,8 @@  instance (Eq k, Num k) => Bialgebra k SymE where {} +-- TODO: HopfAlgebra instance?+ -- |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@@ -701,6 +765,8 @@  instance (Eq k, Num k) => Bialgebra k SymH where {} +-- TODO: HopfAlgebra instance?+ -- |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@@ -713,8 +779,9 @@ -- |A basis for NSym, the Hopf algebra of non-commutative symmetric functions, indexed by compositions newtype NSym = NSym [Int] deriving (Eq,Ord,Show) +instance Graded NSym where grade (NSym xs) = sum xs+ nsym :: [Int] -> Vect Q NSym-nsym xs = return (NSym xs) nsym xs | all (>0) xs = return (NSym xs)         | otherwise = error "nsym: not a composition" 

@@ -8,7 +8,7 @@ module Math.Combinatorics.Digraph where  import Data.List as L-import qualified Data.Map as M+import qualified Data.Map.Strict as M import qualified Data.Set as S  import Math.Core.Utils (picks, toSet)@@ -40,7 +40,7 @@ -- If a vertex has no predecessors (respectively successors), then it is left out of the relevant map adjLists (DG vs es) = adjLists' (M.empty, M.empty) es     where adjLists' (preds,succs) ((u,v):es) =-              adjLists' (M.insertWith' (flip (++)) v [u] preds, M.insertWith' (flip (++)) u [v] succs) es+              adjLists' (M.insertWith (flip (++)) v [u] preds, M.insertWith (flip (++)) u [v] succs) es           adjLists' (preds,succs) [] = (preds, succs)  

@@ -12,7 +12,7 @@ 
 import Data.Either (lefts, rights, partitionEithers)
 import qualified Data.List as L
-import qualified Data.Map as M
+import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import Data.Maybe
 import Data.Ord (comparing)
@@ -144,7 +144,7 @@ -- If a vertex has no neighbours then it is left out of the map
 adjLists (G vs es) = adjLists' M.empty es
     where adjLists' nbrs ([u,v]:es) =
-              adjLists' (M.insertWith' (flip (++)) v [u] $ M.insertWith' (flip (++)) u [v] nbrs) es
+              adjLists' (M.insertWith (flip (++)) v [u] $ M.insertWith (flip (++)) u [v] nbrs) es
           adjLists' nbrs [] = nbrs
 
 

@@ -153,8 +153,8 @@ isIPRefinement ys xs = dfs xs ys     where dfs (x:xs) (y:ys) | x < y = False                             | x == y = dfs xs ys-                            | otherwise = or [dfs xs' ys' | y' <- y:ys, let ys' = L.delete y' (y:ys),-                                                                        let xs' = insertDesc (x-y') xs]+                            | otherwise = or [dfs xs' ys' | (y', ys') <- picks (y:ys),+                                                            let xs' = insertDesc (x-y') xs]           dfs [] [] = True           insertDesc = L.insertBy (flip compare) @@ -256,6 +256,7 @@ -}  +-- This definition is incorrect. This is an order embedding. Order preserving only requires the rightward implication. isOrderPreserving :: (a -> b) -> Poset a -> Poset b -> Bool isOrderPreserving f (Poset (seta,poa)) (Poset (setb,pob)) =     and [ x `poa` y == f x `pob` f y | x <- seta, y <- seta ]

@@ -47,8 +47,8 @@     source (ParT as) = OT $ concatMap ((\(OT os) -> os) . source) as     source (SeqT as) = source (head as)     target (IdT os) = OT os-    target (CapT toR) = OT [Minus,Plus]-    target (CapT toL) = OT [Plus,Minus]+    target (CapT ToR) = OT [Minus,Plus]+    target (CapT ToL) = OT [Plus,Minus]     target (CupT _) = OT []     target XPlus = OT [Plus,Plus]     target XMinus = OT [Plus,Plus]

@@ -99,7 +99,7 @@  -- also called xminus over :: [Oriented] -> TangleRep [Oriented]-over [u, v] = q  *> do {[] <- cup [u, v]; cap []}+over [u, v] = q  *> do {_ <- cup [u, v]; cap []}           <+> q' *> return [u, v]  {-@@ -112,7 +112,7 @@ -} -- also called xplus under :: [Oriented] -> TangleRep [Oriented]-under [u, v] = q' *> do {[] <- cup [u, v]; cap []}+under [u, v] = q' *> do {_ <- cup [u, v]; cap []}            <+> q  *> return [u, v]  {-@@ -123,8 +123,11 @@                  LT -> q' *> (return (T j i) <+> (q^2 - q'^2) *> return (T i j))  -- +- -> q' -+ + (q-q^-3) -+                  GT -> q' *> return (T j i)                                       -- -+ -> q' +- -}-loop = nf $ do {[i, j] <- cap []; cup [i, j]}+loop = nf $ do {ij <- cap []; cup ij} +{-+-- The following doesn't work, because the pattern matches can fail, but Vect has no MonadFail instance.+-- Commented out for now, pending figuring out the best fix trefoil = nf $ do     [i, j] <- cap []     [k, l] <- cap []@@ -133,6 +136,7 @@     [r, s] <- over [n, l]     cup [p, s]     cup [q, r]+-}   -- KAUFFMAN BRACKET AS A REPRESENTATION FROM TANGLE TO VECT