module Math.Algebra.Commutative.Monomial where
import qualified Data.Map as M
import Data.List as L
import Control.Arrow
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
fromInteger 1 = Monomial M.empty
instance Fractional (Monomial ord) where
recip (Monomial m) = Monomial $ M.map negate m
data Lex
data Glex
data Grevlex
data Elim
diffs a b = M.elems m where Monomial m = a/b
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
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
supportM :: Monomial ord -> [Monomial ord]
supportM (Monomial m) = [Monomial (M.singleton v 1) | v <- M.keys m]