HaskellForMaths 0.1.5 → 0.1.6

raw patch · 7 files changed

+140/−31 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• HaskellForMaths.cabal +1/−1
• Math/Algebra/Commutative/GBasis.hs +4/−0
• Math/Algebra/Commutative/MPoly.hs +13/−1
• Math/Algebra/Commutative/Monomial.hs +8/−0
• Math/Algebra/Group/PermutationGroup.hs +38/−7
• Math/Algebra/Group/SchreierSims.hs +17/−13
• Math/Combinatorics/Graph.hs +59/−9

@@ -1,5 +1,5 @@    Name:                HaskellForMaths
-   Version:             0.1.5
+   Version:             0.1.6
    Category:            Math
    Description:         Math library - combinatorics, group theory, commutative algebra, non-commutative algebra
    License:             BSD3

@@ -159,6 +159,10 @@ -- Giovini et al
 -- The point of sugar is, given fi, fj, to give an upper bound on the degree of sPoly fi fj without having to calculate it
 -- We can then select by preference pairs with lower sugar, expecting therefore that the s-polys will have lower degree
+
+-- |Given a list of polynomials over a field, return a Groebner basis for the ideal generated by the polynomials
+gb :: (Ord (Monomial ord), Fractional k, Ord k) =>
+     [MPoly ord k] -> [MPoly ord k]
 gb fs =
     -- let fs' = sort $ filter (/=0) fs
     let fs' = sort $ map toMonic $ filter (/=0) fs

@@ -15,6 +15,9 @@ 
 -- MULTIVARIATE POLYNOMIALS
 
+-- |Type for multivariate polynomials
+-- |ord is a phantom type defining how terms are ordered, r is the type of the ring we are working over
+-- |For example, a common choice will be MPoly Grevlex Q, meaning polynomials over Q with the grevlex term ordering
 newtype MPoly ord r = MP [(Monomial ord,r)] deriving (Eq)
 -- deriving instance (Ord (Monomial ord), Ord r) => Ord (MPoly ord r)
 -- standalone deriving supported from GHC 6.8
@@ -72,8 +75,12 @@     -- recip (MP [(m,c)]) | m == fromInteger 1 = MP [(m, recip c)]
     recip _ = error "MPoly.recip: only supported for (non-zero) constants or monomials"
 
-
+-- |Create a variable with the supplied name.
+-- |By convention, variable names should usually be a single letter followed by none, one or two digits
+var :: String -> MPoly Grevlex Q
 var v = MP [(Monomial $ M.singleton v 1, 1)] :: MPoly Grevlex Q
+
+a, b, c, d, s, t, u, v, w, x, y, z :: MPoly Grevlex Q
 a = var "a"
 b = var "b"
 c = var "c"
@@ -88,6 +95,8 @@ z = var "z"
 
 x_ i = var ("x" ++ show i)
+
+x0, x1, x2, x3 :: MPoly Grevlex Q
 x0 = x_ 0
 x1 = x_ 1
 x2 = x_ 2
@@ -97,12 +106,15 @@ -- convertMP :: Ord (Monomial ord') => MPoly ord k -> MPoly ord' k
 convertMP (MP ts) = MP $ sortBy cmpTerm $ map (first convertM) ts
 
+-- |Convert a polynomial to lex term ordering
 toLex :: MPoly ord k -> MPoly Lex k
 toLex = convertMP
 
+-- |Convert a polynomial to glex term ordering
 toGlex :: MPoly ord k -> MPoly Glex k
 toGlex = convertMP
 
+-- |Convert a polynomial to grevlex term ordering
 toGrevlex :: MPoly ord k -> MPoly Grevlex k
 toGrevlex = convertMP
 

@@ -30,9 +30,17 @@     -- can only do the above if (*) is doing filter (/=0)
     -- Monomial a / Monomial b = Monomial $ M.filter (/=0) $ M.unionWith (+) a (M.map negate b)
 
+-- |Phantom type representing lex term ordering
 data Lex
+
+-- |Phantom type representing glex term ordering
 data Glex
+
+-- |Phantom type representing grevlex term ordering
 data Grevlex
+
+-- |Phantom type for an elimination term ordering
+-- |In the ordering, xis come before yjs come before zks, but within the xis, or yjs, or zks, grevlex ordering is used 
 data Elim -- a term order for elimination
 
 

@@ -45,6 +45,7 @@     where fromCycle xs = zip xs (rotateL xs)
 
 -- |Construct a permutation from a list of cycles
+-- |For example, p [[1,2,3],[4,5]] returns the permutation that sends 1 to 2, 2 to 3, 3 to 1, 4 to 5, 5 to 4
 p :: (Ord a) => [[a]] -> Permutation a
 p cs = fromCycles cs
 -- can't specify in pointfree style because of monomorphism restriction
@@ -82,7 +83,8 @@ instance (Ord a, Show a) => Fractional (Permutation a) where
     recip = inverse
 
--- conjugation
+-- |g ~^ h returns the conjugate of g by h
+(~^) :: (Ord t, Show t) => Permutation t -> Permutation t -> Permutation t
 g ~^ h = h^-1 * g * h
 
 -- commutator
@@ -143,7 +145,8 @@ -- GROUPS
 -- Some standard sequences of groups, and constructions of new groups from old
 
--- |Generators for Cn, the cyclic group of order n
+-- |_C n returns generators for Cn, the cyclic group of order n
+_C :: (Integral a) => a -> [Permutation a]
 _C n | n >= 2 = [p [[1..n]]]
 
 -- D2n, dihedral group of order 2n, symmetry group of n-gon
@@ -155,14 +158,16 @@     b = p [[i,n+1-i] | i <- [1..n `div` 2]]   -- reflection
     -- b = fromPairs $ [(i,n+1-i) | i <- [1..n]] -- reflection
 
--- |Generators for Sn, the symmetric group on [1..n]
+-- |_S n returns generators for Sn, the symmetric group on [1..n]
+_S :: (Integral a) => a -> [Permutation a]
 _S n | n >= 3 = [s,t]
      | n == 2 = [t]
      | n == 1 = []
     where s = p [[1..n]]
           t = p [[1,2]]
 
--- |Generators for An, the alternating group on [1..n]
+-- |_A n returns generators for An, the alternating group on [1..n]
+_A :: (Integral a) => a -> [Permutation a]
 _A n | n > 3 = [s,t]
      | n == 3 = [t]
      | n == 2 = []
@@ -206,12 +211,16 @@ -- Most of these functions will only be efficient for small groups (say |G| < 10000)
 -- For larger groups we will need to use Schreier-Sims and associated algorithms
 
--- |Given generators for a group, return a (sorted) list of all elements of the group
+-- |Given generators for a group, return a (sorted) list of all elements of the group.
+-- |Implemented using a naive closure algorithm, so only suitable for small groups (|G| < 10000)
 elts :: (Num a, Ord a) => [a] -> [a]
 elts gs = closure [1] [ (*g) | g <- gs]
 
 eltsS gs = closureS [1] [ (*g) | g <- gs]
 
+-- |Given generators for a group, return the order of the group (the number of elements).
+-- |Implemented using a naive closure algorithm, so only suitable for small groups (|G| < 10000)
+order :: (Num a, Ord a) => [a] -> Int
 order gs = S.size $ eltsS gs -- length $ elts gs
 
 isMember gs h = h `S.member` eltsS gs -- h `elem` elts gs
@@ -221,15 +230,37 @@ -- The functions graphAuts2 and graphAuts3 return generating sets consisting of successive transversals
 -- In this case, we don't need to run Schreier-Sims to list elements or calculate order
 
+minsupp = head . supp
+
 -- calculate the order of the group, given a "transversal generating set"
 orderTGS tgs =
-    let transversals = map (1:) $ L.groupBy (\g h -> (head . supp) g == (head .supp) h) tgs
+    let transversals = map (1:) $ L.groupBy (\g h -> minsupp g == minsupp h) tgs
     in product $ map L.genericLength transversals
 
 -- list the elts of the group, given a "transversal generating set"
 eltsTGS tgs =
-    let transversals = map (1:) $ L.groupBy (\g h -> (head . supp) g == (head .supp) h) tgs
+    let transversals = map (1:) $ L.groupBy (\g h -> minsupp g == minsupp h) tgs
     in map product $ sequence transversals
+
+-- recover a transversal generating set from a strong generating set
+-- A strong generating set is a generating set gs such that <gs intersect si> = si
+-- ie, its intersection with each successive stabiliser in the chain generates the stabiliser
+tgsFromSgs sgs = concatMap transversal bs where
+    bs = toListSet $ map minsupp sgs
+    transversal b = closure b $ filter ( (b <=) . minsupp ) sgs
+    closure b gs = closure' M.empty (M.fromList [(b, 1)]) where
+        closure' interior boundary
+            | M.null boundary = filter (/=1) $ M.elems interior
+            | otherwise =
+                let interior' = M.union interior boundary
+                    boundary' = M.fromList [(x .^ g, h*g) | (x,h) <- M.toList boundary, g <- gs] M.\\ interior'
+                in closure' interior' boundary'
+-- For example, sgs (_A 5) == [[[1,2,3]],[[2,4,5]],[[3,4,5]]]
+-- So we need all three to generate the first transversal, then the last two to generate the second transversal, etc
+
+orderSGS sgs = product $ map (L.genericLength . fundamentalOrbit) bs where
+    bs = toListSet $ map minsupp sgs
+    fundamentalOrbit b = b .^^ filter ( (b <=) . minsupp ) sgs
 
 
 -- MORE INVESTIGATIONS

@@ -4,8 +4,10 @@ 
 import qualified Data.List as L
 import Data.Maybe (isNothing, isJust)
+import qualified Data.Set as S
 import qualified Data.Map as M
 import Math.Algebra.Group.PermutationGroup hiding (elts, order, gens, isMember, isSubgp, isNormal, reduceGens, normalClosure, commutatorGp, derivedSubgp)
+import Math.Common.ListSet (toListSet)
 
 
 -- COSET REPRESENTATIVES FOR STABILISER OF A POINT
@@ -68,10 +70,17 @@                      in ss (((b_,t'),s') : bad : bads) (tail goods)
 ss [] goods = goods
 -}
+
+
+-- strong generating set, with implied base from the Ord instance
+sgs gs = toListSet $ concatMap snd $ ss bs gs
+    where bs = toListSet $ concatMap supp gs
+
 -- Find base and strong generating set using Schreier-Sims algorithm
+-- !! This function is poorly named - it actually finds you a base and sets of transversals
 -- This version guarantees to use bases in order
 bsgs gs = bsgs' bs gs
-    where bs = (map head . L.group . L.sort) $ concatMap supp gs
+    where bs = toListSet $ concatMap supp gs
 
 -- This version lets you pass in bases in the order you want them (or [], and it will find its own)
 bsgs' bs gs = map fst $ ss bs gs
@@ -83,7 +92,7 @@ newLevel' b s = ((b,t),s) where t = cosetRepsGx s b
 
 ss bs gs = ss' bs' [level] []
-    where (bs',level) = newLevel bs gs
+    where (bs',level) = newLevel bs $ filter (/=1) gs
 
 ss' bs (bad@((b,t),s):bads) goods =
     let bts = map fst goods
@@ -127,11 +136,16 @@ 
 orderBSGS bts = product (map (toInteger . M.size . snd) bts)
 
-
+-- |Given generators for a group, determine whether a permutation is a member of the group, using Schreier-Sims algorithm
+isMember :: (Ord t, Show t) => [Permutation t] -> Permutation t -> Bool
 isMember gs h = isMemberBSGS (bsgs gs) h
 
+-- |Given generators for a group, return a (sorted) list of all elements of the group, using Schreier-Sims algorithm
+elts :: (Ord t, Show t) => [Permutation t] -> [Permutation t]
 elts gs = eltsBSGS $ bsgs gs
 
+-- |Given generators for a group, return the order of the group (the number of elements), using Schreier-Sims algorithm
+order :: (Ord t, Show t) => [Permutation t] -> Integer
 order [] = 1
 order gs = orderBSGS $ bsgs gs
 
@@ -143,16 +157,6 @@     where hs' = bsgs hs
 
 index gs hs = order gs `div` order hs
-
-
--- strong generating set
--- sgs gs = filter (/=1) $ concatMap (M.elems . snd) $ bsgs gs
--- sgs gs = concatMap snd $ ss [newLevel gs] []
-sgs gs = L.nub $ concatMap snd $ ss bs gs -- bs' [level] []
-    where bs = (map head . L.group . L.sort) $ concatMap supp gs
-          -- (bs',level) = newLevel bs gs
--- !! Note, not properly tested - results not in expected order
--- the sgs calculated during bsgs may be a smaller set (for example, the whole transversal could be powers of a single generator).
 
 
 -- given list of generators, try to find a shorter list

@@ -24,14 +24,19 @@ powerset [] = [[]]
 powerset (x:xs) = let p = powerset xs in p ++ map (x:) p
 
--- subsets of size k (returned in ascending order)
+-- |combinationsOf k xs returns the subsets of xs of size k
+-- |If xs is in ascending order, then the returned list is in ascending order
+combinationsOf :: (Integral t) => t -> [a] -> [[a]]
 combinationsOf 0 _ = [[]]
 combinationsOf _ [] = []
-combinationsOf k (x:xs) = map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs
+combinationsOf k (x:xs) | k > 0 = map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs
 
 
 -- GRAPH
 
+-- |Datatype for graphs, represented as a list of vertices and a list of edges
+-- |Both the list of vertices and the list of edges, and also the 2-element lists representing the edges,
+-- |are required to be in ascending order, without duplicates
 data Graph a = G [a] [[a]] deriving (Eq,Ord,Show)
 
 -- we require that vs, es, and each individual e are sorted
@@ -39,6 +44,8 @@ 
 isGraph vs es = isSetSystem vs es && all ( (==2) . length) es
 
+-- |Safe constructor for graph from lists of vertices and edges.
+-- |graph (vs,es) checks that vs and es are valid before returning the graph.
 graph (vs,es) | isGraph vs es = G vs es
 -- isValid g = g where g = G vs es
 
@@ -81,27 +88,31 @@ nullGraph :: Graph Int -- type signature needed
 nullGraph = G [] []
 
--- cyclic graph
+-- |The cyclic graph on n vertices
+c :: (Integral t) => t -> Graph t
 c n = graph (vs,es) where
     vs = [1..n]
     es = L.insert [1,n] [[i,i+1] | i <- [1..n-1]]
 -- automorphism group is D2n
 
--- complete graph
+-- |The complete graph on n vertices
+k :: (Integral t) => t -> Graph t
 k n = graph (vs,es) where
     vs = [1..n]
     es = [[i,j] | i <- [1..n-1], j <- [i+1..n]] -- == combinationsOf 2 [1..n]
 -- automorphism group is Sn
 
--- complete bipartite graph
+-- |The complete bipartite graph on m and n vertices
+-- kb :: (Integral t) => t -> t -> Graph t
 kb m n = to1n $ kb' m n
 
+-- |The complete bipartite graph on m left and n right vertices
+-- kb :: (Integral t) => t -> t -> Graph (Either t t)
 kb' m n = graph (vs,es) where
     vs = map Left [1..m] ++ map Right [1..n]
     es = [ [Left i, Right j] | i <- [1..m], j <- [1..n] ]
 -- automorphism group is Sm*Sn (plus a flip if m==n)
 
--- k-cube
 q' k = graph (vs,es) where
     vs = sequence $ replicate k [0,1] -- ptsAn k f2
     es = [ [u,v] | [u,v] <- combinationsOf 2 vs, hammingDistance u v == 1 ]
@@ -158,12 +169,23 @@     vs' = M.elems mapping
     es' = [map (mapping M.!) e | e <- es] -- the edges will already be sorted correctly by construction
 
+-- Given a graph with vertices which are lists of small integers, eg [1,2,3]
+-- return a graph with vertices which are the numbers obtained by interpreting these as digits, eg 123.
+-- The caller is responsible for ensuring that this makes sense (eg that the small integers are all < 10)
+fromDigits :: Integral a => Graph [a] -> Graph a
+fromDigits (G vs es) = graph (vs',es') where
+    vs' = map fromDigits' vs
+    es' = (map . map) fromDigits' es
 
+fromDigits' xs = f (reverse xs) where
+    f (x:xs) = x + 10 * f xs
+    f [] = 0
+
 -- this definition only in versions >0.1.3
 petersen = graph (vs,es) where
     vs = combinationsOf 2 [1..5]
-    es = [ [v1,v2] | v1 <- vs, v2 <- vs, v1 < v2, disjoint v1 v2]
--- == j 5 2 0
+    es = [ [v1,v2] | [v1,v2] <- combinationsOf 2 vs, disjoint v1 v2]
+-- == kneser 5 2 == j 5 2 0
 -- == complement $ lineGraph' $ k 5
 -- == complement $ t' 5
 
@@ -262,12 +284,40 @@ 
 
 -- Generalized Johnson graph, Godsil & Royle p9
+-- Also called generalised Kneser graph, http://en.wikipedia.org/wiki/Kneser_graph
 j v k i | v >= k && k >= i
     = graph (vs,es) where
         vs = combinationsOf k [1..v]
         es = [ [v1,v2] | [v1,v2] <- combinationsOf 2 vs, length (v1 `intersect` v2) == i ]
 -- j v k i is isomorphic to j v (v-k) (v-2k+i), so may as well have v >= 2k
 
-kneser v k | v >= 2*k = j v k 0
+-- kneser v k | v >= 2*k = j v k 0
+kneser n k | 2*k <= n = graph (vs,es) where
+    vs = combinationsOf k [1..n]
+    es = [ [v1,v2] | [v1,v2] <- combinationsOf 2 vs, disjoint v1 v2]
 
 johnson v k | v >= 2*k = j v k (k-1)
+
+
+bipartiteKneser n k | 2*k < n = graph (vs,es) where
+    vs = map Left (combinationsOf k [1..n])
+      ++ map Right (combinationsOf (n-k) [1..n])
+    es = [ [Left u, Right v] | u <- combinationsOf k [1..n], v <- combinationsOf (n-k) [1..n], u `isSubset` v]
+
+desargues1 = bipartiteKneser 5 2
+
+
+-- Generalised Petersen graphs
+-- http://en.wikipedia.org/wiki/Petersen_graph
+gp n k | 2*k < n = toGraph (vs,es) where
+    vs = map Left [0..n-1] ++ map Right [0..n-1]
+    es = (map . map) Left [ [i, (i+1) `mod` n] | i <- [0..n-1] ]
+      ++ [ [Left i, Right i] | i <- [0..n-1] ]
+      ++ (map . map) Right [ [i, (i+k) `mod` n] | i <- [0..n-1] ]
+
+petersen2 = gp 5 2
+prism n = gp n 1
+durer = gp 6 2
+mobiusKantor = gp 8 3
+dodecahedron2 = gp 10 2
+desargues2 = gp 10 3