{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, DeriveFunctor #-}
module Math.CommutativeAlgebra.Polynomial where
import Prelude hiding ( (*>) )
import Math.Core.Field
import Math.Core.Utils (toSet)
import Math.Algebras.VectorSpace
import Math.Algebras.TensorProduct
import Math.Algebras.Structures
class (Eq m, Show m, Mon m) => Monomial m where
mdivides :: m -> m -> Bool
mdiv :: m -> m -> m
mgcd :: m -> m -> m
mlcm :: m -> m -> m
mcoprime :: m -> m -> Bool
mdeg :: m -> Int
mproperlydivides :: m -> m -> Bool
mproperlydivides m1 :: m
m1 m2 :: m
m2 = m
m1 m -> m -> Bool
forall a. Eq a => a -> a -> Bool
/= m
m2 Bool -> Bool -> Bool
&& m -> m -> Bool
forall m. Monomial m => m -> m -> Bool
mdivides m
m1 m
m2
class MonomialConstructor m where
mvar :: v -> m v
mindices :: m v -> [(v,Int)]
var :: (Num k, MonomialConstructor m) => v -> Vect k (m v)
var :: v -> Vect k (m v)
var = m v -> Vect k (m v)
forall (m :: * -> *) a. Monad m => a -> m a
return (m v -> Vect k (m v)) -> (v -> m v) -> v -> Vect k (m v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> m v
forall (m :: * -> *) v. MonomialConstructor m => v -> m v
mvar
data MonImpl v = M Int [(v,Int)] deriving (MonImpl v -> MonImpl v -> Bool
(MonImpl v -> MonImpl v -> Bool)
-> (MonImpl v -> MonImpl v -> Bool) -> Eq (MonImpl v)
forall v. Eq v => MonImpl v -> MonImpl v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonImpl v -> MonImpl v -> Bool
$c/= :: forall v. Eq v => MonImpl v -> MonImpl v -> Bool
== :: MonImpl v -> MonImpl v -> Bool
$c== :: forall v. Eq v => MonImpl v -> MonImpl v -> Bool
Eq, a -> MonImpl b -> MonImpl a
(a -> b) -> MonImpl a -> MonImpl b
(forall a b. (a -> b) -> MonImpl a -> MonImpl b)
-> (forall a b. a -> MonImpl b -> MonImpl a) -> Functor MonImpl
forall a b. a -> MonImpl b -> MonImpl a
forall a b. (a -> b) -> MonImpl a -> MonImpl b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MonImpl b -> MonImpl a
$c<$ :: forall a b. a -> MonImpl b -> MonImpl a
fmap :: (a -> b) -> MonImpl a -> MonImpl b
$cfmap :: forall a b. (a -> b) -> MonImpl a -> MonImpl b
Functor)
instance Show v => Show (MonImpl v) where
show :: MonImpl v -> String
show (M _ []) = "1"
show (M _ xis :: [(v, Int)]
xis) = ((v, Int) -> String) -> [(v, Int)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(x :: v
x,i :: Int
i) -> if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==1 then v -> String
forall a. Show a => a -> String
showVar v
x else v -> String
forall a. Show a => a -> String
showVar v
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i) [(v, Int)]
xis
where showVar :: a -> String
showVar x :: a
x = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter ( Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '"' ) (a -> String
forall a. Show a => a -> String
show a
x)
instance (Ord v) => Mon (MonImpl v) where
munit :: MonImpl v
munit = Int -> [(v, Int)] -> MonImpl v
forall v. Int -> [(v, Int)] -> MonImpl v
M 0 []
mmult :: MonImpl v -> MonImpl v -> MonImpl v
mmult (M si :: Int
si xis :: [(v, Int)]
xis) (M sj :: Int
sj yjs :: [(v, Int)]
yjs) = Int -> [(v, Int)] -> MonImpl v
forall v. Int -> [(v, Int)] -> MonImpl v
M (Int
siInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sj) ([(v, Int)] -> MonImpl v) -> [(v, Int)] -> MonImpl v
forall a b. (a -> b) -> a -> b
$ [(v, Int)] -> [(v, Int)] -> [(v, Int)]
forall a b.
(Ord a, Num b, Eq b) =>
[(a, b)] -> [(a, b)] -> [(a, b)]
addmerge [(v, Int)]
xis [(v, Int)]
yjs
instance (Ord v, Show v) => Monomial (MonImpl v) where
mdivides :: MonImpl v -> MonImpl v -> Bool
mdivides (M si :: Int
si xis :: [(v, Int)]
xis) (M sj :: Int
sj yjs :: [(v, Int)]
yjs) = Int
si Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sj Bool -> Bool -> Bool
&& [(v, Int)] -> [(v, Int)] -> Bool
forall a a. (Ord a, Ord a) => [(a, a)] -> [(a, a)] -> Bool
mdivides' [(v, Int)]
xis [(v, Int)]
yjs where
mdivides' :: [(a, a)] -> [(a, a)] -> Bool
mdivides' ((x :: a
x,i :: a
i):xis :: [(a, a)]
xis) ((y :: a
y,j :: a
j):yjs :: [(a, a)]
yjs) =
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
LT -> Bool
False
GT -> [(a, a)] -> [(a, a)] -> Bool
mdivides' ((a
x,a
i)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
xis) [(a, a)]
yjs
EQ -> if a
ia -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
j then [(a, a)] -> [(a, a)] -> Bool
mdivides' [(a, a)]
xis [(a, a)]
yjs else Bool
False
mdivides' [] _ = Bool
True
mdivides' _ [] = Bool
False
mdiv :: MonImpl v -> MonImpl v -> MonImpl v
mdiv (M si :: Int
si xis :: [(v, Int)]
xis) (M sj :: Int
sj yjs :: [(v, Int)]
yjs) = Int -> [(v, Int)] -> MonImpl v
forall v. Int -> [(v, Int)] -> MonImpl v
M (Int
siInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sj) ([(v, Int)] -> MonImpl v) -> [(v, Int)] -> MonImpl v
forall a b. (a -> b) -> a -> b
$ [(v, Int)] -> [(v, Int)] -> [(v, Int)]
forall a b.
(Ord a, Num b, Eq b) =>
[(a, b)] -> [(a, b)] -> [(a, b)]
addmerge [(v, Int)]
xis ([(v, Int)] -> [(v, Int)]) -> [(v, Int)] -> [(v, Int)]
forall a b. (a -> b) -> a -> b
$ ((v, Int) -> (v, Int)) -> [(v, Int)] -> [(v, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(y :: v
y,j :: Int
j) -> (v
y,-Int
j)) [(v, Int)]
yjs
mgcd :: MonImpl v -> MonImpl v -> MonImpl v
mgcd (M _ xis :: [(v, Int)]
xis) (M _ yjs :: [(v, Int)]
yjs) = Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
forall v.
Ord v =>
Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mgcd' 0 [] [(v, Int)]
xis [(v, Int)]
yjs
where mgcd' :: Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mgcd' s :: Int
s zks :: [(v, Int)]
zks ((x :: v
x,i :: Int
i):xis :: [(v, Int)]
xis) ((y :: v
y,j :: Int
j):yjs :: [(v, Int)]
yjs) =
case v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
compare v
x v
y of
LT -> Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mgcd' Int
s [(v, Int)]
zks [(v, Int)]
xis ((v
y,Int
j)(v, Int) -> [(v, Int)] -> [(v, Int)]
forall a. a -> [a] -> [a]
:[(v, Int)]
yjs)
GT -> Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mgcd' Int
s [(v, Int)]
zks ((v
x,Int
i)(v, Int) -> [(v, Int)] -> [(v, Int)]
forall a. a -> [a] -> [a]
:[(v, Int)]
xis) [(v, Int)]
yjs
EQ -> let k :: Int
k = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i Int
j in Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mgcd' (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) ((v
x,Int
k)(v, Int) -> [(v, Int)] -> [(v, Int)]
forall a. a -> [a] -> [a]
:[(v, Int)]
zks) [(v, Int)]
xis [(v, Int)]
yjs
mgcd' s :: Int
s zks :: [(v, Int)]
zks _ _ = Int -> [(v, Int)] -> MonImpl v
forall v. Int -> [(v, Int)] -> MonImpl v
M Int
s ([(v, Int)] -> [(v, Int)]
forall a. [a] -> [a]
reverse [(v, Int)]
zks)
mlcm :: MonImpl v -> MonImpl v -> MonImpl v
mlcm (M si :: Int
si xis :: [(v, Int)]
xis) (M sj :: Int
sj yjs :: [(v, Int)]
yjs) = Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
forall v.
Ord v =>
Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mlcm' 0 [] [(v, Int)]
xis [(v, Int)]
yjs
where mlcm' :: Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mlcm' s :: Int
s zks :: [(v, Int)]
zks ((x :: v
x,i :: Int
i):xis :: [(v, Int)]
xis) ((y :: v
y,j :: Int
j):yjs :: [(v, Int)]
yjs) =
case v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
compare v
x v
y of
LT -> Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mlcm' (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) ((v
x,Int
i)(v, Int) -> [(v, Int)] -> [(v, Int)]
forall a. a -> [a] -> [a]
:[(v, Int)]
zks) [(v, Int)]
xis ((v
y,Int
j)(v, Int) -> [(v, Int)] -> [(v, Int)]
forall a. a -> [a] -> [a]
:[(v, Int)]
yjs)
GT -> Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mlcm' (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j) ((v
y,Int
j)(v, Int) -> [(v, Int)] -> [(v, Int)]
forall a. a -> [a] -> [a]
:[(v, Int)]
zks) ((v
x,Int
i)(v, Int) -> [(v, Int)] -> [(v, Int)]
forall a. a -> [a] -> [a]
:[(v, Int)]
xis) [(v, Int)]
yjs
EQ -> let k :: Int
k = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i Int
j in Int -> [(v, Int)] -> [(v, Int)] -> [(v, Int)] -> MonImpl v
mlcm' (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) ((v
x,Int
k)(v, Int) -> [(v, Int)] -> [(v, Int)]
forall a. a -> [a] -> [a]
:[(v, Int)]
zks) [(v, Int)]
xis [(v, Int)]
yjs
mlcm' s :: Int
s zks :: [(v, Int)]
zks xis :: [(v, Int)]
xis yjs :: [(v, Int)]
yjs = let zks' :: [(v, Int)]
zks' = [(v, Int)]
xis [(v, Int)] -> [(v, Int)] -> [(v, Int)]
forall a. [a] -> [a] -> [a]
++ [(v, Int)]
yjs; s' :: Int
s' = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((v, Int) -> Int) -> [(v, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (v, Int) -> Int
forall a b. (a, b) -> b
snd [(v, Int)]
zks')
in Int -> [(v, Int)] -> MonImpl v
forall v. Int -> [(v, Int)] -> MonImpl v
M (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s') ([(v, Int)] -> [(v, Int)]
forall a. [a] -> [a]
reverse [(v, Int)]
zks [(v, Int)] -> [(v, Int)] -> [(v, Int)]
forall a. [a] -> [a] -> [a]
++ [(v, Int)]
zks')
mcoprime :: MonImpl v -> MonImpl v -> Bool
mcoprime (M _ xis :: [(v, Int)]
xis) (M _ yjs :: [(v, Int)]
yjs) = [(v, Int)] -> [(v, Int)] -> Bool
forall a b b. Ord a => [(a, b)] -> [(a, b)] -> Bool
mcoprime' [(v, Int)]
xis [(v, Int)]
yjs
where mcoprime' :: [(a, b)] -> [(a, b)] -> Bool
mcoprime' ((x :: a
x,i :: b
i):xis :: [(a, b)]
xis) ((y :: a
y,j :: b
j):yjs :: [(a, b)]
yjs) =
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
LT -> [(a, b)] -> [(a, b)] -> Bool
mcoprime' [(a, b)]
xis ((a
y,b
j)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
yjs)
GT -> [(a, b)] -> [(a, b)] -> Bool
mcoprime' ((a
x,b
i)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
xis) [(a, b)]
yjs
EQ -> Bool
False
mcoprime' _ _ = Bool
True
mdeg :: MonImpl v -> Int
mdeg (M s :: Int
s _) = Int
s
instance MonomialConstructor MonImpl where
mvar :: v -> MonImpl v
mvar v :: v
v = Int -> [(v, Int)] -> MonImpl v
forall v. Int -> [(v, Int)] -> MonImpl v
M 1 [(v
v,1)]
mindices :: MonImpl v -> [(v, Int)]
mindices (M si :: Int
si xis :: [(v, Int)]
xis) = [(v, Int)]
xis
newtype Lex v = Lex (MonImpl v) deriving (Lex v -> Lex v -> Bool
(Lex v -> Lex v -> Bool) -> (Lex v -> Lex v -> Bool) -> Eq (Lex v)
forall v. Eq v => Lex v -> Lex v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lex v -> Lex v -> Bool
$c/= :: forall v. Eq v => Lex v -> Lex v -> Bool
== :: Lex v -> Lex v -> Bool
$c== :: forall v. Eq v => Lex v -> Lex v -> Bool
Eq, a -> Lex b -> Lex a
(a -> b) -> Lex a -> Lex b
(forall a b. (a -> b) -> Lex a -> Lex b)
-> (forall a b. a -> Lex b -> Lex a) -> Functor Lex
forall a b. a -> Lex b -> Lex a
forall a b. (a -> b) -> Lex a -> Lex b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Lex b -> Lex a
$c<$ :: forall a b. a -> Lex b -> Lex a
fmap :: (a -> b) -> Lex a -> Lex b
$cfmap :: forall a b. (a -> b) -> Lex a -> Lex b
Functor, Lex v
Lex v -> Lex v -> Lex v
Lex v -> (Lex v -> Lex v -> Lex v) -> Mon (Lex v)
forall m. m -> (m -> m -> m) -> Mon m
forall v. Ord v => Lex v
forall v. Ord v => Lex v -> Lex v -> Lex v
mmult :: Lex v -> Lex v -> Lex v
$cmmult :: forall v. Ord v => Lex v -> Lex v -> Lex v
munit :: Lex v
$cmunit :: forall v. Ord v => Lex v
Mon, Eq (Lex v)
Show (Lex v)
Mon (Lex v)
(Eq (Lex v), Show (Lex v), Mon (Lex v)) =>
(Lex v -> Lex v -> Bool)
-> (Lex v -> Lex v -> Lex v)
-> (Lex v -> Lex v -> Lex v)
-> (Lex v -> Lex v -> Lex v)
-> (Lex v -> Lex v -> Bool)
-> (Lex v -> Int)
-> Monomial (Lex v)
Lex v -> Int
Lex v -> Lex v -> Bool
Lex v -> Lex v -> Lex v
forall m.
(Eq m, Show m, Mon m) =>
(m -> m -> Bool)
-> (m -> m -> m)
-> (m -> m -> m)
-> (m -> m -> m)
-> (m -> m -> Bool)
-> (m -> Int)
-> Monomial m
forall v. (Ord v, Show v) => Eq (Lex v)
forall v. (Ord v, Show v) => Show (Lex v)
forall v. (Ord v, Show v) => Mon (Lex v)
forall v. (Ord v, Show v) => Lex v -> Int
forall v. (Ord v, Show v) => Lex v -> Lex v -> Bool
forall v. (Ord v, Show v) => Lex v -> Lex v -> Lex v
mdeg :: Lex v -> Int
$cmdeg :: forall v. (Ord v, Show v) => Lex v -> Int
mcoprime :: Lex v -> Lex v -> Bool
$cmcoprime :: forall v. (Ord v, Show v) => Lex v -> Lex v -> Bool
mlcm :: Lex v -> Lex v -> Lex v
$cmlcm :: forall v. (Ord v, Show v) => Lex v -> Lex v -> Lex v
mgcd :: Lex v -> Lex v -> Lex v
$cmgcd :: forall v. (Ord v, Show v) => Lex v -> Lex v -> Lex v
mdiv :: Lex v -> Lex v -> Lex v
$cmdiv :: forall v. (Ord v, Show v) => Lex v -> Lex v -> Lex v
mdivides :: Lex v -> Lex v -> Bool
$cmdivides :: forall v. (Ord v, Show v) => Lex v -> Lex v -> Bool
$cp3Monomial :: forall v. (Ord v, Show v) => Mon (Lex v)
$cp2Monomial :: forall v. (Ord v, Show v) => Show (Lex v)
$cp1Monomial :: forall v. (Ord v, Show v) => Eq (Lex v)
Monomial, v -> Lex v
Lex v -> [(v, Int)]
(forall v. v -> Lex v)
-> (forall v. Lex v -> [(v, Int)]) -> MonomialConstructor Lex
forall v. v -> Lex v
forall v. Lex v -> [(v, Int)]
forall (m :: * -> *).
(forall v. v -> m v)
-> (forall v. m v -> [(v, Int)]) -> MonomialConstructor m
mindices :: Lex v -> [(v, Int)]
$cmindices :: forall v. Lex v -> [(v, Int)]
mvar :: v -> Lex v
$cmvar :: forall v. v -> Lex v
MonomialConstructor)
instance Show v => Show (Lex v) where
show :: Lex v -> String
show (Lex m :: MonImpl v
m) = MonImpl v -> String
forall a. Show a => a -> String
show MonImpl v
m
instance Ord v => Ord (Lex v) where
compare :: Lex v -> Lex v -> Ordering
compare (Lex (M si :: Int
si xis :: [(v, Int)]
xis)) (Lex (M sj :: Int
sj yjs :: [(v, Int)]
yjs)) = [(v, Int)] -> [(v, Int)] -> Ordering
forall a a. (Ord a, Ord a) => [(a, a)] -> [(a, a)] -> Ordering
compare' [(v, Int)]
xis [(v, Int)]
yjs
where compare' :: [(a, a)] -> [(a, a)] -> Ordering
compare' ((x :: a
x,i :: a
i):xis :: [(a, a)]
xis) ((y :: a
y,j :: a
j):yjs :: [(a, a)]
yjs) =
case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
LT -> Ordering
LT
GT -> Ordering
GT
EQ -> case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
i a
j of
LT -> Ordering
GT
GT -> Ordering
LT
EQ -> [(a, a)] -> [(a, a)] -> Ordering
compare' [(a, a)]
xis [(a, a)]
yjs
compare' [] [] = Ordering
EQ
compare' _ [] = Ordering
LT
compare' [] _ = Ordering
GT
type LexPoly k v = Vect k (Lex v)
lexvar :: v -> LexPoly Q v
lexvar :: v -> LexPoly Q v
lexvar v :: v
v = Lex v -> LexPoly Q v
forall (m :: * -> *) a. Monad m => a -> m a
return (Lex v -> LexPoly Q v) -> Lex v -> LexPoly Q v
forall a b. (a -> b) -> a -> b
$ MonImpl v -> Lex v
forall v. MonImpl v -> Lex v
Lex (MonImpl v -> Lex v) -> MonImpl v -> Lex v
forall a b. (a -> b) -> a -> b
$ Int -> [(v, Int)] -> MonImpl v
forall v. Int -> [(v, Int)] -> MonImpl v
M 1 [(v
v,1)]
instance (Eq k, Num k, Ord v, Show v) => Algebra k (Lex v) where
unit :: k -> Vect k (Lex v)
unit x :: k
x = k
x k -> Vect k (Lex v) -> Vect k (Lex v)
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Lex v -> Vect k (Lex v)
forall (m :: * -> *) a. Monad m => a -> m a
return Lex v
forall m. Mon m => m
munit
mult :: Vect k (Tensor (Lex v) (Lex v)) -> Vect k (Lex v)
mult xy :: Vect k (Tensor (Lex v) (Lex v))
xy = Vect k (Lex v) -> Vect k (Lex v)
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k (Lex v) -> Vect k (Lex v))
-> Vect k (Lex v) -> Vect k (Lex v)
forall a b. (a -> b) -> a -> b
$ (Tensor (Lex v) (Lex v) -> Lex v)
-> Vect k (Tensor (Lex v) (Lex v)) -> Vect k (Lex v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a :: Lex v
a,b :: Lex v
b) -> Lex v
a Lex v -> Lex v -> Lex v
forall m. Mon m => m -> m -> m
`mmult` Lex v
b) Vect k (Tensor (Lex v) (Lex v))
xy
newtype Glex v = Glex (MonImpl v) deriving (Glex v -> Glex v -> Bool
(Glex v -> Glex v -> Bool)
-> (Glex v -> Glex v -> Bool) -> Eq (Glex v)
forall v. Eq v => Glex v -> Glex v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Glex v -> Glex v -> Bool
$c/= :: forall v. Eq v => Glex v -> Glex v -> Bool
== :: Glex v -> Glex v -> Bool
$c== :: forall v. Eq v => Glex v -> Glex v -> Bool
Eq, a -> Glex b -> Glex a
(a -> b) -> Glex a -> Glex b
(forall a b. (a -> b) -> Glex a -> Glex b)
-> (forall a b. a -> Glex b -> Glex a) -> Functor Glex
forall a b. a -> Glex b -> Glex a
forall a b. (a -> b) -> Glex a -> Glex b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Glex b -> Glex a
$c<$ :: forall a b. a -> Glex b -> Glex a
fmap :: (a -> b) -> Glex a -> Glex b
$cfmap :: forall a b. (a -> b) -> Glex a -> Glex b
Functor, Glex v
Glex v -> Glex v -> Glex v
Glex v -> (Glex v -> Glex v -> Glex v) -> Mon (Glex v)
forall m. m -> (m -> m -> m) -> Mon m
forall v. Ord v => Glex v
forall v. Ord v => Glex v -> Glex v -> Glex v
mmult :: Glex v -> Glex v -> Glex v
$cmmult :: forall v. Ord v => Glex v -> Glex v -> Glex v
munit :: Glex v
$cmunit :: forall v. Ord v => Glex v
Mon, Eq (Glex v)
Show (Glex v)
Mon (Glex v)
(Eq (Glex v), Show (Glex v), Mon (Glex v)) =>
(Glex v -> Glex v -> Bool)
-> (Glex v -> Glex v -> Glex v)
-> (Glex v -> Glex v -> Glex v)
-> (Glex v -> Glex v -> Glex v)
-> (Glex v -> Glex v -> Bool)
-> (Glex v -> Int)
-> Monomial (Glex v)
Glex v -> Int
Glex v -> Glex v -> Bool
Glex v -> Glex v -> Glex v
forall m.
(Eq m, Show m, Mon m) =>
(m -> m -> Bool)
-> (m -> m -> m)
-> (m -> m -> m)
-> (m -> m -> m)
-> (m -> m -> Bool)
-> (m -> Int)
-> Monomial m
forall v. (Ord v, Show v) => Eq (Glex v)
forall v. (Ord v, Show v) => Show (Glex v)
forall v. (Ord v, Show v) => Mon (Glex v)
forall v. (Ord v, Show v) => Glex v -> Int
forall v. (Ord v, Show v) => Glex v -> Glex v -> Bool
forall v. (Ord v, Show v) => Glex v -> Glex v -> Glex v
mdeg :: Glex v -> Int
$cmdeg :: forall v. (Ord v, Show v) => Glex v -> Int
mcoprime :: Glex v -> Glex v -> Bool
$cmcoprime :: forall v. (Ord v, Show v) => Glex v -> Glex v -> Bool
mlcm :: Glex v -> Glex v -> Glex v
$cmlcm :: forall v. (Ord v, Show v) => Glex v -> Glex v -> Glex v
mgcd :: Glex v -> Glex v -> Glex v
$cmgcd :: forall v. (Ord v, Show v) => Glex v -> Glex v -> Glex v
mdiv :: Glex v -> Glex v -> Glex v
$cmdiv :: forall v. (Ord v, Show v) => Glex v -> Glex v -> Glex v
mdivides :: Glex v -> Glex v -> Bool
$cmdivides :: forall v. (Ord v, Show v) => Glex v -> Glex v -> Bool
$cp3Monomial :: forall v. (Ord v, Show v) => Mon (Glex v)
$cp2Monomial :: forall v. (Ord v, Show v) => Show (Glex v)
$cp1Monomial :: forall v. (Ord v, Show v) => Eq (Glex v)
Monomial, v -> Glex v
Glex v -> [(v, Int)]
(forall v. v -> Glex v)
-> (forall v. Glex v -> [(v, Int)]) -> MonomialConstructor Glex
forall v. v -> Glex v
forall v. Glex v -> [(v, Int)]
forall (m :: * -> *).
(forall v. v -> m v)
-> (forall v. m v -> [(v, Int)]) -> MonomialConstructor m
mindices :: Glex v -> [(v, Int)]
$cmindices :: forall v. Glex v -> [(v, Int)]
mvar :: v -> Glex v
$cmvar :: forall v. v -> Glex v
MonomialConstructor)
instance Show v => Show (Glex v) where
show :: Glex v -> String
show (Glex m :: MonImpl v
m) = MonImpl v -> String
forall a. Show a => a -> String
show MonImpl v
m
instance Ord v => Ord (Glex v) where
compare :: Glex v -> Glex v -> Ordering
compare (Glex (M si :: Int
si xis :: [(v, Int)]
xis)) (Glex (M sj :: Int
sj yjs :: [(v, Int)]
yjs)) =
(Int, [(v, Int)]) -> (Int, [(v, Int)]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (-Int
si, [(v
x,-Int
i) | (x :: v
x,i :: Int
i) <- [(v, Int)]
xis]) (-Int
sj, [(v
y,-Int
j) | (y :: v
y,j :: Int
j) <- [(v, Int)]
yjs])
type GlexPoly k v = Vect k (Glex v)
glexvar :: v -> GlexPoly Q v
glexvar :: v -> GlexPoly Q v
glexvar v :: v
v = Glex v -> GlexPoly Q v
forall (m :: * -> *) a. Monad m => a -> m a
return (Glex v -> GlexPoly Q v) -> Glex v -> GlexPoly Q v
forall a b. (a -> b) -> a -> b
$ MonImpl v -> Glex v
forall v. MonImpl v -> Glex v
Glex (MonImpl v -> Glex v) -> MonImpl v -> Glex v
forall a b. (a -> b) -> a -> b
$ Int -> [(v, Int)] -> MonImpl v
forall v. Int -> [(v, Int)] -> MonImpl v
M 1 [(v
v,1)]
instance (Eq k, Num k, Ord v, Show v) => Algebra k (Glex v) where
unit :: k -> Vect k (Glex v)
unit x :: k
x = k
x k -> Vect k (Glex v) -> Vect k (Glex v)
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Glex v -> Vect k (Glex v)
forall (m :: * -> *) a. Monad m => a -> m a
return Glex v
forall m. Mon m => m
munit
mult :: Vect k (Tensor (Glex v) (Glex v)) -> Vect k (Glex v)
mult xy :: Vect k (Tensor (Glex v) (Glex v))
xy = Vect k (Glex v) -> Vect k (Glex v)
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k (Glex v) -> Vect k (Glex v))
-> Vect k (Glex v) -> Vect k (Glex v)
forall a b. (a -> b) -> a -> b
$ (Tensor (Glex v) (Glex v) -> Glex v)
-> Vect k (Tensor (Glex v) (Glex v)) -> Vect k (Glex v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a :: Glex v
a,b :: Glex v
b) -> Glex v
a Glex v -> Glex v -> Glex v
forall m. Mon m => m -> m -> m
`mmult` Glex v
b) Vect k (Tensor (Glex v) (Glex v))
xy
newtype Grevlex v = Grevlex (MonImpl v) deriving (Grevlex v -> Grevlex v -> Bool
(Grevlex v -> Grevlex v -> Bool)
-> (Grevlex v -> Grevlex v -> Bool) -> Eq (Grevlex v)
forall v. Eq v => Grevlex v -> Grevlex v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Grevlex v -> Grevlex v -> Bool
$c/= :: forall v. Eq v => Grevlex v -> Grevlex v -> Bool
== :: Grevlex v -> Grevlex v -> Bool
$c== :: forall v. Eq v => Grevlex v -> Grevlex v -> Bool
Eq, a -> Grevlex b -> Grevlex a
(a -> b) -> Grevlex a -> Grevlex b
(forall a b. (a -> b) -> Grevlex a -> Grevlex b)
-> (forall a b. a -> Grevlex b -> Grevlex a) -> Functor Grevlex
forall a b. a -> Grevlex b -> Grevlex a
forall a b. (a -> b) -> Grevlex a -> Grevlex b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Grevlex b -> Grevlex a
$c<$ :: forall a b. a -> Grevlex b -> Grevlex a
fmap :: (a -> b) -> Grevlex a -> Grevlex b
$cfmap :: forall a b. (a -> b) -> Grevlex a -> Grevlex b
Functor, Grevlex v
Grevlex v -> Grevlex v -> Grevlex v
Grevlex v
-> (Grevlex v -> Grevlex v -> Grevlex v) -> Mon (Grevlex v)
forall m. m -> (m -> m -> m) -> Mon m
forall v. Ord v => Grevlex v
forall v. Ord v => Grevlex v -> Grevlex v -> Grevlex v
mmult :: Grevlex v -> Grevlex v -> Grevlex v
$cmmult :: forall v. Ord v => Grevlex v -> Grevlex v -> Grevlex v
munit :: Grevlex v
$cmunit :: forall v. Ord v => Grevlex v
Mon, Eq (Grevlex v)
Show (Grevlex v)
Mon (Grevlex v)
(Eq (Grevlex v), Show (Grevlex v), Mon (Grevlex v)) =>
(Grevlex v -> Grevlex v -> Bool)
-> (Grevlex v -> Grevlex v -> Grevlex v)
-> (Grevlex v -> Grevlex v -> Grevlex v)
-> (Grevlex v -> Grevlex v -> Grevlex v)
-> (Grevlex v -> Grevlex v -> Bool)
-> (Grevlex v -> Int)
-> Monomial (Grevlex v)
Grevlex v -> Int
Grevlex v -> Grevlex v -> Bool
Grevlex v -> Grevlex v -> Grevlex v
forall m.
(Eq m, Show m, Mon m) =>
(m -> m -> Bool)
-> (m -> m -> m)
-> (m -> m -> m)
-> (m -> m -> m)
-> (m -> m -> Bool)
-> (m -> Int)
-> Monomial m
forall v. (Ord v, Show v) => Eq (Grevlex v)
forall v. (Ord v, Show v) => Show (Grevlex v)
forall v. (Ord v, Show v) => Mon (Grevlex v)
forall v. (Ord v, Show v) => Grevlex v -> Int
forall v. (Ord v, Show v) => Grevlex v -> Grevlex v -> Bool
forall v. (Ord v, Show v) => Grevlex v -> Grevlex v -> Grevlex v
mdeg :: Grevlex v -> Int
$cmdeg :: forall v. (Ord v, Show v) => Grevlex v -> Int
mcoprime :: Grevlex v -> Grevlex v -> Bool
$cmcoprime :: forall v. (Ord v, Show v) => Grevlex v -> Grevlex v -> Bool
mlcm :: Grevlex v -> Grevlex v -> Grevlex v
$cmlcm :: forall v. (Ord v, Show v) => Grevlex v -> Grevlex v -> Grevlex v
mgcd :: Grevlex v -> Grevlex v -> Grevlex v
$cmgcd :: forall v. (Ord v, Show v) => Grevlex v -> Grevlex v -> Grevlex v
mdiv :: Grevlex v -> Grevlex v -> Grevlex v
$cmdiv :: forall v. (Ord v, Show v) => Grevlex v -> Grevlex v -> Grevlex v
mdivides :: Grevlex v -> Grevlex v -> Bool
$cmdivides :: forall v. (Ord v, Show v) => Grevlex v -> Grevlex v -> Bool
$cp3Monomial :: forall v. (Ord v, Show v) => Mon (Grevlex v)
$cp2Monomial :: forall v. (Ord v, Show v) => Show (Grevlex v)
$cp1Monomial :: forall v. (Ord v, Show v) => Eq (Grevlex v)
Monomial, v -> Grevlex v
Grevlex v -> [(v, Int)]
(forall v. v -> Grevlex v)
-> (forall v. Grevlex v -> [(v, Int)])
-> MonomialConstructor Grevlex
forall v. v -> Grevlex v
forall v. Grevlex v -> [(v, Int)]
forall (m :: * -> *).
(forall v. v -> m v)
-> (forall v. m v -> [(v, Int)]) -> MonomialConstructor m
mindices :: Grevlex v -> [(v, Int)]
$cmindices :: forall v. Grevlex v -> [(v, Int)]
mvar :: v -> Grevlex v
$cmvar :: forall v. v -> Grevlex v
MonomialConstructor)
instance Show v => Show (Grevlex v) where
show :: Grevlex v -> String
show (Grevlex m :: MonImpl v
m) = MonImpl v -> String
forall a. Show a => a -> String
show MonImpl v
m
instance Ord v => Ord (Grevlex v) where
compare :: Grevlex v -> Grevlex v -> Ordering
compare (Grevlex (M si :: Int
si xis :: [(v, Int)]
xis)) (Grevlex (M sj :: Int
sj yjs :: [(v, Int)]
yjs)) =
(Int, [(v, Int)]) -> (Int, [(v, Int)]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (-Int
si, [(v, Int)] -> [(v, Int)]
forall a. [a] -> [a]
reverse [(v, Int)]
xis) (-Int
sj, [(v, Int)] -> [(v, Int)]
forall a. [a] -> [a]
reverse [(v, Int)]
yjs)
type GrevlexPoly k v = Vect k (Grevlex v)
grevlexvar :: v -> GrevlexPoly Q v
grevlexvar :: v -> GrevlexPoly Q v
grevlexvar v :: v
v = Grevlex v -> GrevlexPoly Q v
forall (m :: * -> *) a. Monad m => a -> m a
return (Grevlex v -> GrevlexPoly Q v) -> Grevlex v -> GrevlexPoly Q v
forall a b. (a -> b) -> a -> b
$ MonImpl v -> Grevlex v
forall v. MonImpl v -> Grevlex v
Grevlex (MonImpl v -> Grevlex v) -> MonImpl v -> Grevlex v
forall a b. (a -> b) -> a -> b
$ Int -> [(v, Int)] -> MonImpl v
forall v. Int -> [(v, Int)] -> MonImpl v
M 1 [(v
v,1)]
instance (Eq k, Num k, Ord v, Show v) => Algebra k (Grevlex v) where
unit :: k -> Vect k (Grevlex v)
unit x :: k
x = k
x k -> Vect k (Grevlex v) -> Vect k (Grevlex v)
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Grevlex v -> Vect k (Grevlex v)
forall (m :: * -> *) a. Monad m => a -> m a
return Grevlex v
forall m. Mon m => m
munit
mult :: Vect k (Tensor (Grevlex v) (Grevlex v)) -> Vect k (Grevlex v)
mult xy :: Vect k (Tensor (Grevlex v) (Grevlex v))
xy = Vect k (Grevlex v) -> Vect k (Grevlex v)
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k (Grevlex v) -> Vect k (Grevlex v))
-> Vect k (Grevlex v) -> Vect k (Grevlex v)
forall a b. (a -> b) -> a -> b
$ (Tensor (Grevlex v) (Grevlex v) -> Grevlex v)
-> Vect k (Tensor (Grevlex v) (Grevlex v)) -> Vect k (Grevlex v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a :: Grevlex v
a,b :: Grevlex v
b) -> Grevlex v
a Grevlex v -> Grevlex v -> Grevlex v
forall m. Mon m => m -> m -> m
`mmult` Grevlex v
b) Vect k (Tensor (Grevlex v) (Grevlex v))
xy
data Elim2 a b = Elim2 !a !b deriving (Elim2 a b -> Elim2 a b -> Bool
(Elim2 a b -> Elim2 a b -> Bool)
-> (Elim2 a b -> Elim2 a b -> Bool) -> Eq (Elim2 a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Elim2 a b -> Elim2 a b -> Bool
/= :: Elim2 a b -> Elim2 a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Elim2 a b -> Elim2 a b -> Bool
== :: Elim2 a b -> Elim2 a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Elim2 a b -> Elim2 a b -> Bool
Eq, a -> Elim2 a b -> Elim2 a a
(a -> b) -> Elim2 a a -> Elim2 a b
(forall a b. (a -> b) -> Elim2 a a -> Elim2 a b)
-> (forall a b. a -> Elim2 a b -> Elim2 a a) -> Functor (Elim2 a)
forall a b. a -> Elim2 a b -> Elim2 a a
forall a b. (a -> b) -> Elim2 a a -> Elim2 a b
forall a a b. a -> Elim2 a b -> Elim2 a a
forall a a b. (a -> b) -> Elim2 a a -> Elim2 a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Elim2 a b -> Elim2 a a
$c<$ :: forall a a b. a -> Elim2 a b -> Elim2 a a
fmap :: (a -> b) -> Elim2 a a -> Elim2 a b
$cfmap :: forall a a b. (a -> b) -> Elim2 a a -> Elim2 a b
Functor)
instance (Ord a, Ord b) => Ord (Elim2 a b) where
compare :: Elim2 a b -> Elim2 a b -> Ordering
compare (Elim2 a1 :: a
a1 b1 :: b
b1) (Elim2 a2 :: a
a2 b2 :: b
b2) = (a, b) -> (a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a
a1,b
b1) (a
a2,b
b2)
instance (Show a, Show b) => Show (Elim2 a b) where
show :: Elim2 a b -> String
show (Elim2 ma :: a
ma mb :: b
mb) = case (a -> String
forall a. Show a => a -> String
show a
ma, b -> String
forall a. Show a => a -> String
show b
mb) of
("1","1") -> "1"
(ma' :: String
ma',"1") -> String
ma'
("1",mb' :: String
mb') -> String
mb'
(ma' :: String
ma',mb' :: String
mb') -> String
ma' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mb'
instance (Mon a, Mon b) => Mon (Elim2 a b) where
munit :: Elim2 a b
munit = a -> b -> Elim2 a b
forall a b. a -> b -> Elim2 a b
Elim2 a
forall m. Mon m => m
munit b
forall m. Mon m => m
munit
mmult :: Elim2 a b -> Elim2 a b -> Elim2 a b
mmult (Elim2 a1 :: a
a1 b1 :: b
b1) (Elim2 a2 :: a
a2 b2 :: b
b2) = a -> b -> Elim2 a b
forall a b. a -> b -> Elim2 a b
Elim2 (a -> a -> a
forall m. Mon m => m -> m -> m
mmult a
a1 a
a2) (b -> b -> b
forall m. Mon m => m -> m -> m
mmult b
b1 b
b2)
instance (Monomial a, Monomial b) => Monomial (Elim2 a b) where
mdivides :: Elim2 a b -> Elim2 a b -> Bool
mdivides (Elim2 a1 :: a
a1 b1 :: b
b1) (Elim2 a2 :: a
a2 b2 :: b
b2) = a -> a -> Bool
forall m. Monomial m => m -> m -> Bool
mdivides a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. Monomial m => m -> m -> Bool
mdivides b
b1 b
b2
mdiv :: Elim2 a b -> Elim2 a b -> Elim2 a b
mdiv (Elim2 a1 :: a
a1 b1 :: b
b1) (Elim2 a2 :: a
a2 b2 :: b
b2) = a -> b -> Elim2 a b
forall a b. a -> b -> Elim2 a b
Elim2 (a -> a -> a
forall m. Monomial m => m -> m -> m
mdiv a
a1 a
a2) (b -> b -> b
forall m. Monomial m => m -> m -> m
mdiv b
b1 b
b2)
mgcd :: Elim2 a b -> Elim2 a b -> Elim2 a b
mgcd (Elim2 a1 :: a
a1 b1 :: b
b1) (Elim2 a2 :: a
a2 b2 :: b
b2) = a -> b -> Elim2 a b
forall a b. a -> b -> Elim2 a b
Elim2 (a -> a -> a
forall m. Monomial m => m -> m -> m
mgcd a
a1 a
a2) (b -> b -> b
forall m. Monomial m => m -> m -> m
mgcd b
b1 b
b2)
mlcm :: Elim2 a b -> Elim2 a b -> Elim2 a b
mlcm (Elim2 a1 :: a
a1 b1 :: b
b1) (Elim2 a2 :: a
a2 b2 :: b
b2) = a -> b -> Elim2 a b
forall a b. a -> b -> Elim2 a b
Elim2 (a -> a -> a
forall m. Monomial m => m -> m -> m
mlcm a
a1 a
a2) (b -> b -> b
forall m. Monomial m => m -> m -> m
mlcm b
b1 b
b2)
mcoprime :: Elim2 a b -> Elim2 a b -> Bool
mcoprime (Elim2 a1 :: a
a1 b1 :: b
b1) (Elim2 a2 :: a
a2 b2 :: b
b2) = a -> a -> Bool
forall m. Monomial m => m -> m -> Bool
mcoprime a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. Monomial m => m -> m -> Bool
mcoprime b
b1 b
b2
mdeg :: Elim2 a b -> Int
mdeg (Elim2 a :: a
a b :: b
b) = a -> Int
forall m. Monomial m => m -> Int
mdeg a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall m. Monomial m => m -> Int
mdeg b
b
instance (Eq k, Num k, Ord a, Mon a, Ord b, Mon b) => Algebra k (Elim2 a b) where
unit :: k -> Vect k (Elim2 a b)
unit x :: k
x = k
x k -> Vect k (Elim2 a b) -> Vect k (Elim2 a b)
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Elim2 a b -> Vect k (Elim2 a b)
forall (m :: * -> *) a. Monad m => a -> m a
return Elim2 a b
forall m. Mon m => m
munit
mult :: Vect k (Tensor (Elim2 a b) (Elim2 a b)) -> Vect k (Elim2 a b)
mult xy :: Vect k (Tensor (Elim2 a b) (Elim2 a b))
xy = Vect k (Elim2 a b) -> Vect k (Elim2 a b)
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k (Elim2 a b) -> Vect k (Elim2 a b))
-> Vect k (Elim2 a b) -> Vect k (Elim2 a b)
forall a b. (a -> b) -> a -> b
$ (Tensor (Elim2 a b) (Elim2 a b) -> Elim2 a b)
-> Vect k (Tensor (Elim2 a b) (Elim2 a b)) -> Vect k (Elim2 a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a :: Elim2 a b
a,b :: Elim2 a b
b) -> Elim2 a b
a Elim2 a b -> Elim2 a b -> Elim2 a b
forall m. Mon m => m -> m -> m
`mmult` Elim2 a b
b) Vect k (Tensor (Elim2 a b) (Elim2 a b))
xy
bind :: (Eq k, Num k, MonomialConstructor m, Ord a, Show a, Algebra k a) =>
Vect k (m v) -> (v -> Vect k a) -> Vect k a
v :: Vect k (m v)
v bind :: Vect k (m v) -> (v -> Vect k a) -> Vect k a
`bind` f :: v -> Vect k a
f = (m v -> Vect k a) -> Vect k (m v) -> Vect k a
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear (\m :: m v
m -> [Vect k a] -> Vect k a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [v -> Vect k a
f v
x Vect k a -> Int -> Vect k a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i | (x :: v
x,i :: Int
i) <- m v -> [(v, Int)]
forall (m :: * -> *) v. MonomialConstructor m => m v -> [(v, Int)]
mindices m v
m]) Vect k (m v)
v
flipbind :: (t -> Vect k b) -> Vect k (m t) -> Vect k b
flipbind f :: t -> Vect k b
f = (m t -> Vect k b) -> Vect k (m t) -> Vect k b
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear (\m :: m t
m -> [Vect k b] -> Vect k b
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [t -> Vect k b
f t
x Vect k b -> Int -> Vect k b
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
i | (x :: t
x,i :: Int
i) <- m t -> [(t, Int)]
forall (m :: * -> *) v. MonomialConstructor m => m v -> [(v, Int)]
mindices m t
m])
eval :: (Eq k, Num k, MonomialConstructor m, Eq (m v), Show v) =>
Vect k (m v) -> [(Vect k (m v), k)] -> k
eval :: Vect k (m v) -> [(Vect k (m v), k)] -> k
eval f :: Vect k (m v)
f vs :: [(Vect k (m v), k)]
vs = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k) -> Vect k () -> k
forall a b. (a -> b) -> a -> b
$ Vect k (m v)
f Vect k (m v) -> (v -> Vect k ()) -> Vect k ()
forall k (m :: * -> *) a v.
(Eq k, Num k, MonomialConstructor m, Ord a, Show a, Algebra k a) =>
Vect k (m v) -> (v -> Vect k a) -> Vect k a
`bind` v -> Vect k ()
sub
where sub :: v -> Vect k ()
sub x :: v
x = case Vect k (m v) -> [(Vect k (m v), k)] -> Maybe k
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (v -> Vect k (m v)
forall k (m :: * -> *) v.
(Num k, MonomialConstructor m) =>
v -> Vect k (m v)
var v
x) [(Vect k (m v), k)]
vs of
Just xval :: k
xval -> k
xval k -> Vect k () -> Vect k ()
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> () -> Vect k ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Nothing -> String -> Vect k ()
forall a. HasCallStack => String -> a
error ("eval: no binding given for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> String
forall a. Show a => a -> String
show v
x)
subst :: (Eq k, Num k, MonomialConstructor m, Eq (m u), Show u, Ord (m v), Show (m v), Algebra k (m v)) =>
Vect k (m u) -> [(Vect k (m u), Vect k (m v))] -> Vect k (m v)
subst :: Vect k (m u) -> [(Vect k (m u), Vect k (m v))] -> Vect k (m v)
subst f :: Vect k (m u)
f vs :: [(Vect k (m u), Vect k (m v))]
vs = Vect k (m u)
f Vect k (m u) -> (u -> Vect k (m v)) -> Vect k (m v)
forall k (m :: * -> *) a v.
(Eq k, Num k, MonomialConstructor m, Ord a, Show a, Algebra k a) =>
Vect k (m v) -> (v -> Vect k a) -> Vect k a
`bind` u -> Vect k (m v)
sub
where sub :: u -> Vect k (m v)
sub x :: u
x = case Vect k (m u)
-> [(Vect k (m u), Vect k (m v))] -> Maybe (Vect k (m v))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (u -> Vect k (m u)
forall k (m :: * -> *) v.
(Num k, MonomialConstructor m) =>
v -> Vect k (m v)
var u
x) [(Vect k (m u), Vect k (m v))]
vs of
Just xsub :: Vect k (m v)
xsub -> Vect k (m v)
xsub
Nothing -> String -> Vect k (m v)
forall a. HasCallStack => String -> a
error ("eval: no binding given for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ u -> String
forall a. Show a => a -> String
show u
x)
vars :: (Num k, Ord k, MonomialConstructor m, Ord (m v)) =>
Vect k (m v) -> [Vect k (m v)]
vars :: Vect k (m v) -> [Vect k (m v)]
vars f :: Vect k (m v)
f = [Vect k (m v)] -> [Vect k (m v)]
forall a. Ord a => [a] -> [a]
toSet [ v -> Vect k (m v)
forall k (m :: * -> *) v.
(Num k, MonomialConstructor m) =>
v -> Vect k (m v)
var v
v | (m :: m v
m,_) <- Vect k (m v) -> [(m v, k)]
forall k b. Vect k b -> [(b, k)]
terms Vect k (m v)
f, v
v <- ((v, Int) -> v) -> [(v, Int)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, Int) -> v
forall a b. (a, b) -> a
fst (m v -> [(v, Int)]
forall (m :: * -> *) v. MonomialConstructor m => m v -> [(v, Int)]
mindices m v
m) ]
lt :: Vect k b -> (b, k)
lt (V (t :: (b, k)
t:ts :: [(b, k)]
ts)) = (b, k)
t
lm :: Vect b c -> c
lm = (c, b) -> c
forall a b. (a, b) -> a
fst ((c, b) -> c) -> (Vect b c -> (c, b)) -> Vect b c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect b c -> (c, b)
forall k b. Vect k b -> (b, k)
lt
lc :: Vect c a -> c
lc = (a, c) -> c
forall a b. (a, b) -> b
snd ((a, c) -> c) -> (Vect c a -> (a, c)) -> Vect c a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect c a -> (a, c)
forall k b. Vect k b -> (b, k)
lt
deg :: Vect k m -> Int
deg (V []) = -1
deg f :: Vect k m
f = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [m -> Int
forall m. Monomial m => m -> Int
mdeg m
m | (m :: m
m,c :: k
c) <- Vect k m -> [(m, k)]
forall k b. Vect k b -> [(b, k)]
terms Vect k m
f]
toMonic :: Vect k b -> Vect k b
toMonic 0 = 0
toMonic f :: Vect k b
f = (1 k -> k -> k
forall a. Fractional a => a -> a -> a
/ Vect k b -> k
forall c a. Vect c a -> c
lc Vect k b
f) k -> Vect k b -> Vect k b
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Vect k b
f
tdivides :: (m, b) -> (m, b) -> Bool
tdivides (m1 :: m
m1,x1 :: b
x1) (m2 :: m
m2,x2 :: b
x2) = m -> m -> Bool
forall m. Monomial m => m -> m -> Bool
mdivides m
m1 m
m2
tdiv :: (a, b) -> (a, b) -> (a, b)
tdiv (m1 :: a
m1,x1 :: b
x1) (m2 :: a
m2,x2 :: b
x2) = (a -> a -> a
forall m. Monomial m => m -> m -> m
mdiv a
m1 a
m2, b
x1b -> b -> b
forall a. Fractional a => a -> a -> a
/b
x2)
tgcd :: (a, b) -> (a, b) -> (a, b)
tgcd (m1 :: a
m1,_) (m2 :: a
m2,_) = (a -> a -> a
forall m. Monomial m => m -> m -> m
mgcd a
m1 a
m2, 1)
tmult :: (a, b) -> (a, b) -> (a, b)
tmult (m :: a
m,c :: b
c) (m' :: a
m',c' :: b
c') = (a -> a -> a
forall m. Mon m => m -> m -> m
mmult a
m a
m',b
cb -> b -> b
forall a. Num a => a -> a -> a
*b
c')
infixl 7 *->
t :: (b, k)
t *-> :: (b, k) -> Vect k b -> Vect k b
*-> V ts :: [(b, k)]
ts = [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V ([(b, k)] -> Vect k b) -> [(b, k)] -> Vect k b
forall a b. (a -> b) -> a -> b
$ ((b, k) -> (b, k)) -> [(b, k)] -> [(b, k)]
forall a b. (a -> b) -> [a] -> [b]
map ((b, k) -> (b, k) -> (b, k)
forall a b. (Mon a, Num b) => (a, b) -> (a, b) -> (a, b)
tmult (b, k)
t) [(b, k)]
ts
quotRemMP :: Vect b m -> [Vect b m] -> ([Vect b m], Vect b m)
quotRemMP f :: Vect b m
f gs :: [Vect b m]
gs = Vect b m -> ([Vect b m], Vect b m) -> ([Vect b m], Vect b m)
quotRemMP' Vect b m
f (Int -> Vect b m -> [Vect b m]
forall a. Int -> a -> [a]
replicate Int
n 0, 0) where
n :: Int
n = [Vect b m] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vect b m]
gs
quotRemMP' :: Vect b m -> ([Vect b m], Vect b m) -> ([Vect b m], Vect b m)
quotRemMP' 0 (us :: [Vect b m]
us,r :: Vect b m
r) = ([Vect b m]
us,Vect b m
r)
quotRemMP' h :: Vect b m
h (us :: [Vect b m]
us,r :: Vect b m
r) = Vect b m
-> ([Vect b m], [Vect b m], [Vect b m], Vect b m)
-> ([Vect b m], Vect b m)
divisionStep Vect b m
h ([Vect b m]
gs,[],[Vect b m]
us,Vect b m
r)
divisionStep :: Vect b m
-> ([Vect b m], [Vect b m], [Vect b m], Vect b m)
-> ([Vect b m], Vect b m)
divisionStep h :: Vect b m
h (g :: Vect b m
g:gs :: [Vect b m]
gs,us' :: [Vect b m]
us',u :: Vect b m
u:us :: [Vect b m]
us,r :: Vect b m
r) =
if Vect b m -> (m, b)
forall k b. Vect k b -> (b, k)
lt Vect b m
g (m, b) -> (m, b) -> Bool
forall m b b. Monomial m => (m, b) -> (m, b) -> Bool
`tdivides` Vect b m -> (m, b)
forall k b. Vect k b -> (b, k)
lt Vect b m
h
then let t :: Vect b m
t = [(m, b)] -> Vect b m
forall k b. [(b, k)] -> Vect k b
V [Vect b m -> (m, b)
forall k b. Vect k b -> (b, k)
lt Vect b m
h (m, b) -> (m, b) -> (m, b)
forall a b.
(Monomial a, Fractional b) =>
(a, b) -> (a, b) -> (a, b)
`tdiv` Vect b m -> (m, b)
forall k b. Vect k b -> (b, k)
lt Vect b m
g]
h' :: Vect b m
h' = Vect b m
h Vect b m -> Vect b m -> Vect b m
forall a. Num a => a -> a -> a
- Vect b m
tVect b m -> Vect b m -> Vect b m
forall a. Num a => a -> a -> a
*Vect b m
g
u' :: Vect b m
u' = Vect b m
uVect b m -> Vect b m -> Vect b m
forall a. Num a => a -> a -> a
+Vect b m
t
in Vect b m -> ([Vect b m], Vect b m) -> ([Vect b m], Vect b m)
quotRemMP' Vect b m
h' ([Vect b m] -> [Vect b m]
forall a. [a] -> [a]
reverse [Vect b m]
us' [Vect b m] -> [Vect b m] -> [Vect b m]
forall a. [a] -> [a] -> [a]
++ Vect b m
u'Vect b m -> [Vect b m] -> [Vect b m]
forall a. a -> [a] -> [a]
:[Vect b m]
us, Vect b m
r)
else Vect b m
-> ([Vect b m], [Vect b m], [Vect b m], Vect b m)
-> ([Vect b m], Vect b m)
divisionStep Vect b m
h ([Vect b m]
gs,Vect b m
uVect b m -> [Vect b m] -> [Vect b m]
forall a. a -> [a] -> [a]
:[Vect b m]
us',[Vect b m]
us,Vect b m
r)
divisionStep h :: Vect b m
h ([],us' :: [Vect b m]
us',[],r :: Vect b m
r) =
let (lth :: Vect b m
lth,h' :: Vect b m
h') = Vect b m -> (Vect b m, Vect b m)
forall k b. Vect k b -> (Vect k b, Vect k b)
splitlt Vect b m
h
in Vect b m -> ([Vect b m], Vect b m) -> ([Vect b m], Vect b m)
quotRemMP' Vect b m
h' ([Vect b m] -> [Vect b m]
forall a. [a] -> [a]
reverse [Vect b m]
us', Vect b m
rVect b m -> Vect b m -> Vect b m
forall a. Num a => a -> a -> a
+Vect b m
lth)
splitlt :: Vect k b -> (Vect k b, Vect k b)
splitlt (V (t :: (b, k)
t:ts :: [(b, k)]
ts)) = ([(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V [(b, k)
t], [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V [(b, k)]
ts)
rewrite :: Vect b m -> [Vect b m] -> Vect b m
rewrite f :: Vect b m
f gs :: [Vect b m]
gs = (Vect b m, Vect b m) -> [Vect b m] -> Vect b m
rewrite' (Vect b m
f,0) [Vect b m]
gs where
rewrite' :: (Vect b m, Vect b m) -> [Vect b m] -> Vect b m
rewrite' (0,r :: Vect b m
r) _ = Vect b m
r
rewrite' (l :: Vect b m
l,r :: Vect b m
r) (h :: Vect b m
h:hs :: [Vect b m]
hs) =
if Vect b m -> (m, b)
forall k b. Vect k b -> (b, k)
lt Vect b m
h (m, b) -> (m, b) -> Bool
forall m b b. Monomial m => (m, b) -> (m, b) -> Bool
`tdivides` Vect b m -> (m, b)
forall k b. Vect k b -> (b, k)
lt Vect b m
l
then let l' :: Vect b m
l' = Vect b m
l Vect b m -> Vect b m -> Vect b m
forall a. Num a => a -> a -> a
- [(m, b)] -> Vect b m
forall k b. [(b, k)] -> Vect k b
V [Vect b m -> (m, b)
forall k b. Vect k b -> (b, k)
lt Vect b m
l (m, b) -> (m, b) -> (m, b)
forall a b.
(Monomial a, Fractional b) =>
(a, b) -> (a, b) -> (a, b)
`tdiv` Vect b m -> (m, b)
forall k b. Vect k b -> (b, k)
lt Vect b m
h] Vect b m -> Vect b m -> Vect b m
forall a. Num a => a -> a -> a
* Vect b m
h
in (Vect b m, Vect b m) -> [Vect b m] -> Vect b m
rewrite' (Vect b m
l',Vect b m
r) [Vect b m]
gs
else (Vect b m, Vect b m) -> [Vect b m] -> Vect b m
rewrite' (Vect b m
l,Vect b m
r) [Vect b m]
hs
rewrite' (l :: Vect b m
l,r :: Vect b m
r) [] =
let (h :: Vect b m
h,t :: Vect b m
t) = Vect b m -> (Vect b m, Vect b m)
forall k b. Vect k b -> (Vect k b, Vect k b)
split Vect b m
l
in (Vect b m, Vect b m) -> [Vect b m] -> Vect b m
rewrite' (Vect b m
t, Vect b m
r Vect b m -> Vect b m -> Vect b m
forall a. Num a => a -> a -> a
+ Vect b m
h) [Vect b m]
gs
split :: Vect k b -> (Vect k b, Vect k b)
split (V (t :: (b, k)
t:ts :: [(b, k)]
ts)) = ([(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V [(b, k)
t], [(b, k)] -> Vect k b
forall k b. [(b, k)] -> Vect k b
V [(b, k)]
ts)
infixl 7 %%
(%%) :: (Eq k, Fractional k, Monomial m, Ord m, Algebra k m) =>
Vect k m -> [Vect k m] -> Vect k m
f :: Vect k m
f %% :: Vect k m -> [Vect k m] -> Vect k m
%% gs :: [Vect k m]
gs = Vect k m -> [Vect k m] -> Vect k m
forall b m.
(Eq b, Ord m, Algebra b m, Monomial m, Fractional b) =>
Vect b m -> [Vect b m] -> Vect b m
rewrite Vect k m
f [Vect k m]
gs
instance (Eq k, Fractional k, Monomial m, Ord m, Algebra k m) => Fractional (Vect k m) where
recip :: Vect k m -> Vect k m
recip (V [(m :: m
m,c :: k
c)]) | m
m m -> m -> Bool
forall a. Eq a => a -> a -> Bool
== m
forall m. Mon m => m
munit = [(m, k)] -> Vect k m
forall k b. [(b, k)] -> Vect k b
V [(m
m,1k -> k -> k
forall a. Fractional a => a -> a -> a
/k
c)]
| Bool
otherwise = String -> Vect k m
forall a. HasCallStack => String -> a
error "Polynomial recip: only defined for scalars"
fromRational :: Rational -> Vect k m
fromRational x :: Rational
x = [(m, k)] -> Vect k m
forall k b. [(b, k)] -> Vect k b
V [(m
forall m. Mon m => m
munit, Rational -> k
forall a. Fractional a => Rational -> a
fromRational Rational
x)]