-- 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) -- |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 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]