packages feed

HaskellForMaths 0.1 → 0.1.1

raw patch · 3 files changed

+160/−3 lines, 3 files

Files

HaskellForMaths.cabal view
@@ -1,5 +1,5 @@    Name:                HaskellForMaths
-   Version:             0.1
+   Version:             0.1.1
    Description:         Math library - combinatorics, group theory, commutative algebra, non-commutative algebra
    License:             BSD3
    License-file:        license.txt
@@ -12,13 +12,17 @@    Library
      Build-Depends:     base >=3 && < 4, containers
      Exposed-modules:
-        Math.Algebra.LinearAlgebra, Math.Algebra.Commutative.MPoly, Math.Algebra.Commutative.GBasis,
+        Math.Algebra.LinearAlgebra,
+        Math.Algebra.Commutative.Monomial,
+        Math.Algebra.Commutative.MPoly, Math.Algebra.Commutative.GBasis,
         Math.Algebra.Field.Base, Math.Algebra.Field.Extension,
         Math.Algebra.Group.PermutationGroup, Math.Algebra.Group.SchreierSims, Math.Algebra.Group.StringRewriting,
         Math.Algebra.NonCommutative.NCPoly, Math.Algebra.NonCommutative.GSBasis, Math.Algebra.NonCommutative.TensorAlgebra,
         Math.Combinatorics.Graph, Math.Combinatorics.GraphAuts, Math.Combinatorics.StronglyRegularGraph,
         Math.Combinatorics.Design, Math.Combinatorics.FiniteGeometry, Math.Combinatorics.Hypergraph,
         Math.Common.IntegerAsType, Math.Common.ListSet,
-        Math.Projects.RootSystem, Math.Projects.ChevalleyGroup.Classical, Math.Projects.ChevalleyGroup.Exceptional,
+        Math.Projects.RootSystem,
+        Math.Projects.ChevalleyGroup.Classical, Math.Projects.ChevalleyGroup.Exceptional,
+        Math.Projects.KnotTheory.Braid,
         Math.Projects.KnotTheory.LaurentMPoly, Math.Projects.KnotTheory.TemperleyLieb, Math.Projects.KnotTheory.IwahoriHecke
      ghc-options:       -w
+ Math/Algebra/Commutative/Monomial.hs view
@@ -0,0 +1,94 @@+-- Copyright (c) David Amos, 2008. All rights reserved.
+
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Math.Algebra.Commutative.Monomial where
+
+import qualified Data.Map as M
+import Data.List as L
+import Control.Arrow
+
+
+-- MONOMIAL
+
+newtype Monomial ord = Monomial (M.Map String Int) deriving (Eq)
+
+instance Show (Monomial ord) where
+    show (Monomial a) | M.null a = "1"
+                      | otherwise = concatMap showVar $ M.toList a
+                      where showVar (v,1) = v
+                            showVar (v,i) = v ++ "^" ++ show i
+
+instance Num (Monomial ord) where
+    Monomial a * Monomial b = Monomial $ M.filter (/=0) $ M.unionWith (+) a b
+    -- The filter (/=0) here means we can handle Laurent monomials, and isn't significantly slower
+    -- Monomial a * Monomial b = Monomial $ M.unionWith (+) a b
+    fromInteger 1 = Monomial M.empty
+
+instance Fractional (Monomial ord) where
+    recip (Monomial m) = Monomial $ M.map negate m
+    -- 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)
+
+data Lex
+data Glex
+data Grevlex
+data Elim -- a term order for elimination
+
+
+diffs a b = M.elems m where Monomial m = a/b
+-- note that we're guaranteed that all elts of diffs a b are non-zero
+
+instance Ord (Monomial Lex) where
+    compare a b = case diffs a b of
+                  [] -> EQ
+                  as -> if head as > 0 then GT else LT
+
+instance Ord (Monomial Glex) where
+    compare a b = let ds = diffs a b in
+                  case compare (sum ds) 0 of
+                  GT -> GT
+                  LT -> LT
+                  EQ -> if null ds then EQ else
+                        if head ds > 0 then GT else LT
+
+instance Ord (Monomial Grevlex) where
+    compare a b = let ds = diffs a b in
+                  case compare (sum ds) 0 of
+                  GT -> GT
+                  LT -> LT
+                  EQ -> if null ds then EQ else
+                        if last ds < 0 then GT else LT
+
+-- a monomial order for terms in x1,x2,..,y1,y2,..,z1,z2,.. etc
+-- in which it is grevlex separately on first the xs, then if they're equal, the ys, then if they're equal, the zs, etc
+instance Ord (Monomial Elim) where
+    compare a b = let Monomial m = a/b in
+                  case M.assocs m of
+                  [] -> EQ
+                  (l:s,i):vs -> grevlex $ i : map snd (takeWhile (\(l':_,_) -> l'==l) vs)
+                  where grevlex ds = case compare (sum ds) 0 of
+                                     GT -> GT
+                                     LT -> LT
+                                     EQ -> if last ds < 0 then GT else LT
+
+
+convertM :: Monomial a -> Monomial b
+convertM (Monomial x) = Monomial x
+
+
+degM (Monomial m) = sum $ M.elems m
+
+dividesM (Monomial a) (Monomial b) = M.isSubmapOfBy (<=) a b
+
+properlyDividesM a b = dividesM a b && a /= b
+
+lcmM (Monomial a) (Monomial b) = Monomial $ M.unionWith max a b
+
+gcdM (Monomial a) (Monomial b) = Monomial $ M.intersectionWith min a b
+
+coprimeM (Monomial a) (Monomial b) = M.null $ M.intersection a b
+
+-- the support of a monomial is the variables it contains
+supportM :: Monomial ord -> [Monomial ord] -- type signature needed to say that output has same term order as input
+supportM (Monomial m) = [Monomial (M.singleton v 1) | v <- M.keys m]
+ Math/Projects/KnotTheory/Braid.hs view
@@ -0,0 +1,59 @@+-- Copyright (c) David Amos, 2008. All rights reserved.
+
+{-# OPTIONS_GHC -XFlexibleInstances -XTypeSynonymInstances #-}
+
+module Math.Projects.KnotTheory.Braid where
+
+import Data.List ( (\\) )
+
+import Math.Algebra.Field.Base
+import Math.Algebra.NonCommutative.NCPoly
+
+import Math.Projects.KnotTheory.LaurentMPoly
+
+type LPQ = LaurentMPoly Q
+
+instance Invertible LPQ where
+    inv = recip
+
+
+-- BRAID ALGEBRA
+
+data BraidGens = S Int deriving (Eq,Ord)
+-- Inverse of S n is S (-n)
+
+instance Show BraidGens where
+    show (S i) | i > 0 = 's': show i
+               | i < 0 = 's': show (-i) ++ "'"
+
+s_ i = NP [(M [S i], 1)] :: NPoly LPQ BraidGens
+
+s1 = s_ 1
+s2 = s_ 2
+s3 = s_ 3
+s4 = s_ 4
+
+instance Invertible (NPoly LPQ BraidGens) where
+    inv (NP [(M [S i], 1)]) = s_ (-i)
+
+{-
+braidRelations n =
+    [s_ j * s_ i - s_ i * s_ j | i <- [1..n-1], j <- [i+2..n-1] ] ++
+    [s_ (i+1) * s_ i * s_ (i+1) - s_ i * s_ (i+1) * s_ i | i <- [1..n-2] ]
+-- !! need relations for the inverses too !!
+-- (but we're not intending to work in the braid algebra - we're intending to map into Temperley-Lieb or Iwahori-Hecke)
+-}
+
+-- The writhe of a braid == the sum of the signs of the crossings
+writhe (NP [(M xs,c)]) = sum [signum i | S i <- xs]
+
+
+
+
+-- Some knots - Lickorish p5, p27
+-- (Note: These knots/braids give the correct Homfly/Jones polynomials compared to Lickorish)
+-- (In general, that's not sufficient to prove that they are the claimed knots, although in these cases, they are.)
+k3_1 = s1^-3
+k4_1 = s2^-1 * s1 * s2^-1 * s1
+k5_1 = s1^-5
+k7_1 = s1^-7