module Math.Projects.KnotTheory.LaurentMPoly where
import qualified Data.Map as M
import Data.List as L
import Math.Algebra.Field.Base
newtype LaurentMonomial = LM (M.Map String Q) deriving (LaurentMonomial -> LaurentMonomial -> Bool
(LaurentMonomial -> LaurentMonomial -> Bool)
-> (LaurentMonomial -> LaurentMonomial -> Bool)
-> Eq LaurentMonomial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LaurentMonomial -> LaurentMonomial -> Bool
$c/= :: LaurentMonomial -> LaurentMonomial -> Bool
== :: LaurentMonomial -> LaurentMonomial -> Bool
$c== :: LaurentMonomial -> LaurentMonomial -> Bool
Eq)
degLM :: LaurentMonomial -> Q
degLM (LM m :: Map String Q
m) = [Q] -> Q
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Q] -> Q) -> [Q] -> Q
forall a b. (a -> b) -> a -> b
$ Map String Q -> [Q]
forall k a. Map k a -> [a]
M.elems Map String Q
m
instance Ord LaurentMonomial where
compare :: LaurentMonomial -> LaurentMonomial -> Ordering
compare a :: LaurentMonomial
a b :: LaurentMonomial
b = let ds :: [Q]
ds = Map String Q -> [Q]
forall k a. Map k a -> [a]
M.elems Map String Q
m where LM m :: Map String Q
m = LaurentMonomial
aLaurentMonomial -> LaurentMonomial -> LaurentMonomial
forall a. Fractional a => a -> a -> a
/LaurentMonomial
b in
case Q -> Q -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Q] -> Q
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Q]
ds) 0 of
GT -> Ordering
GT
LT -> Ordering
LT
EQ -> if [Q] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Q]
ds then Ordering
EQ else
if [Q] -> Q
forall a. [a] -> a
head [Q]
ds Q -> Q -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Ordering
GT else Ordering
LT
instance Show LaurentMonomial where
show :: LaurentMonomial -> String
show (LM a :: Map String Q
a) | Map String Q -> Bool
forall k a. Map k a -> Bool
M.null Map String Q
a = "1"
| Bool
otherwise = ((String, Q) -> String) -> [(String, Q)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, Q) -> String
forall a. (Eq a, Num a, Show a) => (String, a) -> String
showVar ([(String, Q)] -> String) -> [(String, Q)] -> String
forall a b. (a -> b) -> a -> b
$ Map String Q -> [(String, Q)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Q
a
where showVar :: (String, a) -> String
showVar (v :: String
v,1) = String
v
showVar (v :: String
v,i :: a
i) = String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ "^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
instance Num LaurentMonomial where
LM a :: Map String Q
a * :: LaurentMonomial -> LaurentMonomial -> LaurentMonomial
* LM b :: Map String Q
b = Map String Q -> LaurentMonomial
LM (Map String Q -> LaurentMonomial)
-> Map String Q -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ (Q -> Bool) -> Map String Q -> Map String Q
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Q -> Q -> Bool
forall a. Eq a => a -> a -> Bool
/=0) (Map String Q -> Map String Q) -> Map String Q -> Map String Q
forall a b. (a -> b) -> a -> b
$ (Q -> Q -> Q) -> Map String Q -> Map String Q -> Map String Q
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Q -> Q -> Q
forall a. Num a => a -> a -> a
(+) Map String Q
a Map String Q
b
fromInteger :: Integer -> LaurentMonomial
fromInteger 1 = Map String Q -> LaurentMonomial
LM Map String Q
forall k a. Map k a
M.empty
instance Fractional (LaurentMonomial) where
recip :: LaurentMonomial -> LaurentMonomial
recip (LM m :: Map String Q
m) = Map String Q -> LaurentMonomial
LM (Map String Q -> LaurentMonomial)
-> Map String Q -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ (Q -> Q) -> Map String Q -> Map String Q
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Q -> Q
forall a. Num a => a -> a
negate Map String Q
m
denominatorLM :: LaurentMonomial -> LaurentMonomial
denominatorLM (LM a :: Map String Q
a) = LaurentMonomial -> LaurentMonomial
forall a. Fractional a => a -> a
recip (LaurentMonomial -> LaurentMonomial)
-> LaurentMonomial -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ Map String Q -> LaurentMonomial
LM (Map String Q -> LaurentMonomial)
-> Map String Q -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ (Q -> Bool) -> Map String Q -> Map String Q
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Q -> Q -> Bool
forall a. Ord a => a -> a -> Bool
<0) Map String Q
a
lcmLM :: LaurentMonomial -> LaurentMonomial -> LaurentMonomial
lcmLM (LM a :: Map String Q
a) (LM b :: Map String Q
b) = Map String Q -> LaurentMonomial
LM (Map String Q -> LaurentMonomial)
-> Map String Q -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ (Q -> Q -> Q) -> Map String Q -> Map String Q -> Map String Q
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Q -> Q -> Q
forall a. Ord a => a -> a -> a
max Map String Q
a Map String Q
b
divLM :: LaurentMonomial -> LaurentMonomial -> Maybe LaurentMonomial
divLM a :: LaurentMonomial
a b :: LaurentMonomial
b = let LM c :: Map String Q
c = LaurentMonomial
aLaurentMonomial -> LaurentMonomial -> LaurentMonomial
forall a. Fractional a => a -> a -> a
/LaurentMonomial
b in if (Q -> Bool) -> [Q] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Q -> Q -> Bool
forall a. Ord a => a -> a -> Bool
>=0) (Map String Q -> [Q]
forall k a. Map k a -> [a]
M.elems Map String Q
c) then LaurentMonomial -> Maybe LaurentMonomial
forall a. a -> Maybe a
Just (Map String Q -> LaurentMonomial
LM Map String Q
c) else Maybe LaurentMonomial
forall a. Maybe a
Nothing
newtype LaurentMPoly r = LP [(LaurentMonomial,r)] deriving (LaurentMPoly r -> LaurentMPoly r -> Bool
(LaurentMPoly r -> LaurentMPoly r -> Bool)
-> (LaurentMPoly r -> LaurentMPoly r -> Bool)
-> Eq (LaurentMPoly r)
forall r. Eq r => LaurentMPoly r -> LaurentMPoly r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LaurentMPoly r -> LaurentMPoly r -> Bool
$c/= :: forall r. Eq r => LaurentMPoly r -> LaurentMPoly r -> Bool
== :: LaurentMPoly r -> LaurentMPoly r -> Bool
$c== :: forall r. Eq r => LaurentMPoly r -> LaurentMPoly r -> Bool
Eq,Eq (LaurentMPoly r)
Eq (LaurentMPoly r) =>
(LaurentMPoly r -> LaurentMPoly r -> Ordering)
-> (LaurentMPoly r -> LaurentMPoly r -> Bool)
-> (LaurentMPoly r -> LaurentMPoly r -> Bool)
-> (LaurentMPoly r -> LaurentMPoly r -> Bool)
-> (LaurentMPoly r -> LaurentMPoly r -> Bool)
-> (LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r)
-> (LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r)
-> Ord (LaurentMPoly r)
LaurentMPoly r -> LaurentMPoly r -> Bool
LaurentMPoly r -> LaurentMPoly r -> Ordering
LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall r. Ord r => Eq (LaurentMPoly r)
forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Ordering
forall r.
Ord r =>
LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
min :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
$cmin :: forall r.
Ord r =>
LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
max :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
$cmax :: forall r.
Ord r =>
LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
>= :: LaurentMPoly r -> LaurentMPoly r -> Bool
$c>= :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
> :: LaurentMPoly r -> LaurentMPoly r -> Bool
$c> :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
<= :: LaurentMPoly r -> LaurentMPoly r -> Bool
$c<= :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
< :: LaurentMPoly r -> LaurentMPoly r -> Bool
$c< :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Bool
compare :: LaurentMPoly r -> LaurentMPoly r -> Ordering
$ccompare :: forall r. Ord r => LaurentMPoly r -> LaurentMPoly r -> Ordering
$cp1Ord :: forall r. Ord r => Eq (LaurentMPoly r)
Ord)
instance Show r => Show (LaurentMPoly r) where
show :: LaurentMPoly r -> String
show (LP []) = "0"
show (LP ts :: [(LaurentMonomial, r)]
ts) =
let (c :: Char
c:cs :: String
cs) = ((LaurentMonomial, r) -> String)
-> [(LaurentMonomial, r)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LaurentMonomial, r) -> String
forall a a. (Show a, Show a, Eq a, Num a) => (a, a) -> String
showTerm ([(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
forall a. [a] -> [a]
reverse [(LaurentMonomial, r)]
ts)
in if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '+' then String
cs else Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs
where showTerm :: (a, a) -> String
showTerm (m :: a
m,c :: a
c) =
case a -> String
forall a. Show a => a -> String
show a
c of
"1" -> "+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
m
"-1" -> "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
m
cs :: String
cs -> ShowS
showCoeff String
cs String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if a
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "" else a -> String
forall a. Show a => a -> String
show a
m)
showCoeff :: ShowS
showCoeff (c :: Char
c:cs :: String
cs) = if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['+','-']) String
cs
then "+(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
else if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' then Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs else '+'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs
instance (Eq r, Num r) => Num (LaurentMPoly r) where
LP ts :: [(LaurentMonomial, r)]
ts + :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
+ LP us :: [(LaurentMonomial, r)]
us = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP ([(LaurentMonomial, r)]
-> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
forall a b.
(Ord a, Eq b, Num b) =>
[(a, b)] -> [(a, b)] -> [(a, b)]
mergeTerms [(LaurentMonomial, r)]
ts [(LaurentMonomial, r)]
us)
negate :: LaurentMPoly r -> LaurentMPoly r
negate (LP ts :: [(LaurentMonomial, r)]
ts) = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP ([(LaurentMonomial, r)] -> LaurentMPoly r)
-> [(LaurentMonomial, r)] -> LaurentMPoly r
forall a b. (a -> b) -> a -> b
$ ((LaurentMonomial, r) -> (LaurentMonomial, r))
-> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
forall a b. (a -> b) -> [a] -> [b]
map (\(m :: LaurentMonomial
m,c :: r
c)->(LaurentMonomial
m,-r
c)) [(LaurentMonomial, r)]
ts
LP ts :: [(LaurentMonomial, r)]
ts * :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
* LP us :: [(LaurentMonomial, r)]
us = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP ([(LaurentMonomial, r)] -> LaurentMPoly r)
-> [(LaurentMonomial, r)] -> LaurentMPoly r
forall a b. (a -> b) -> a -> b
$ [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
forall a a. (Num a, Eq a, Eq a) => [(a, a)] -> [(a, a)]
collect ([(LaurentMonomial, r)] -> [(LaurentMonomial, r)])
-> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
forall a b. (a -> b) -> a -> b
$ ((LaurentMonomial, r) -> (LaurentMonomial, r) -> Ordering)
-> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (LaurentMonomial, r) -> (LaurentMonomial, r) -> Ordering
forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
cmpTerm ([(LaurentMonomial, r)] -> [(LaurentMonomial, r)])
-> [(LaurentMonomial, r)] -> [(LaurentMonomial, r)]
forall a b. (a -> b) -> a -> b
$ [(LaurentMonomial
gLaurentMonomial -> LaurentMonomial -> LaurentMonomial
forall a. Num a => a -> a -> a
*LaurentMonomial
h,r
cr -> r -> r
forall a. Num a => a -> a -> a
*r
d) | (g :: LaurentMonomial
g,c :: r
c) <- [(LaurentMonomial, r)]
ts, (h :: LaurentMonomial
h,d :: r
d) <- [(LaurentMonomial, r)]
us]
fromInteger :: Integer -> LaurentMPoly r
fromInteger 0 = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP []
fromInteger n :: Integer
n = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP [(Integer -> LaurentMonomial
forall a. Num a => Integer -> a
fromInteger 1, Integer -> r
forall a. Num a => Integer -> a
fromInteger Integer
n)]
cmpTerm :: (a, b) -> (a, b) -> Ordering
cmpTerm (a :: a
a,c :: b
c) (b :: a
b,d :: b
d) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b of EQ -> Ordering
EQ; GT -> Ordering
LT; LT -> Ordering
GT
mergeTerms :: [(a, b)] -> [(a, b)] -> [(a, b)]
mergeTerms (t :: (a, b)
t@(g :: a
g,c :: b
c):ts :: [(a, b)]
ts) (u :: (a, b)
u@(h :: a
h,d :: b
d):us :: [(a, b)]
us) =
case (a, b) -> (a, b) -> Ordering
forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
cmpTerm (a, b)
t (a, b)
u of
LT -> (a, b)
t (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)] -> [(a, b)]
mergeTerms [(a, b)]
ts ((a, b)
u(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
us)
GT -> (a, b)
u (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)] -> [(a, b)]
mergeTerms ((a, b)
t(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
ts) [(a, b)]
us
EQ -> if b
e b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [(a, b)] -> [(a, b)] -> [(a, b)]
mergeTerms [(a, b)]
ts [(a, b)]
us else (a
g,b
e) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)] -> [(a, b)]
mergeTerms [(a, b)]
ts [(a, b)]
us
where e :: b
e = b
c b -> b -> b
forall a. Num a => a -> a -> a
+ b
d
mergeTerms ts :: [(a, b)]
ts us :: [(a, b)]
us = [(a, b)]
ts [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [(a, b)]
us
collect :: [(a, a)] -> [(a, a)]
collect (t1 :: (a, a)
t1@(g :: a
g,c :: a
c):t2 :: (a, a)
t2@(h :: a
h,d :: a
d):ts :: [(a, a)]
ts)
| a
g a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
h = [(a, a)] -> [(a, a)]
collect ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ (a
g,a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
d)(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
ts
| a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = [(a, a)] -> [(a, a)]
collect ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ (a, a)
t2(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
ts
| Bool
otherwise = (a, a)
t1 (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [(a, a)] -> [(a, a)]
collect ((a, a)
t2(a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
:[(a, a)]
ts)
collect ts :: [(a, a)]
ts = [(a, a)]
ts
instance (Eq r, Fractional r) => Fractional (LaurentMPoly r) where
recip :: LaurentMPoly r -> LaurentMPoly r
recip (LP [(m :: LaurentMonomial
m,c :: r
c)]) = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP [(LaurentMonomial -> LaurentMonomial
forall a. Fractional a => a -> a
recip LaurentMonomial
m, r -> r
forall a. Fractional a => a -> a
recip r
c)]
recip _ = String -> LaurentMPoly r
forall a. HasCallStack => String -> a
error "LaurentMPoly.recip: only supported for (non-zero) constants or monomials"
lm :: LaurentMPoly r -> LaurentMonomial
lm (LP ((m :: LaurentMonomial
m,c :: r
c):ts :: [(LaurentMonomial, r)]
ts)) = LaurentMonomial
m
lc :: LaurentMPoly r -> r
lc (LP ((m :: LaurentMonomial
m,c :: r
c):ts :: [(LaurentMonomial, r)]
ts)) = r
c
lt :: LaurentMPoly r -> LaurentMPoly r
lt (LP ((m :: LaurentMonomial
m,c :: r
c):ts :: [(LaurentMonomial, r)]
ts)) = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP [(LaurentMonomial
m,r
c)]
quotRemLP :: LaurentMPoly r
-> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
quotRemLP f :: LaurentMPoly r
f g :: LaurentMPoly r
g
| LaurentMPoly r
g LaurentMPoly r -> LaurentMPoly r -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = String -> (LaurentMPoly r, LaurentMPoly r)
forall a. HasCallStack => String -> a
error "quotRemLP: division by zero"
| LaurentMPoly r -> LaurentMPoly Integer
forall r r. Num r => LaurentMPoly r -> LaurentMPoly r
denominatorLP LaurentMPoly r
f LaurentMPoly Integer -> LaurentMPoly Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 1 Bool -> Bool -> Bool
|| LaurentMPoly r -> LaurentMPoly Integer
forall r r. Num r => LaurentMPoly r -> LaurentMPoly r
denominatorLP LaurentMPoly r
g LaurentMPoly Integer -> LaurentMPoly Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= 1 = String -> (LaurentMPoly r, LaurentMPoly r)
forall a. HasCallStack => String -> a
error "quotRemLP: negative exponents"
| Bool
otherwise = LaurentMPoly r
-> (LaurentMPoly r, LaurentMPoly r)
-> (LaurentMPoly r, LaurentMPoly r)
quotRemLP' LaurentMPoly r
f (0,0)
where
quotRemLP' :: LaurentMPoly r
-> (LaurentMPoly r, LaurentMPoly r)
-> (LaurentMPoly r, LaurentMPoly r)
quotRemLP' 0 (q :: LaurentMPoly r
q,r :: LaurentMPoly r
r) = (LaurentMPoly r
q,LaurentMPoly r
r)
quotRemLP' h :: LaurentMPoly r
h (q :: LaurentMPoly r
q,r :: LaurentMPoly r
r) =
case LaurentMPoly r -> LaurentMonomial
forall r. LaurentMPoly r -> LaurentMonomial
lm LaurentMPoly r
h LaurentMonomial -> LaurentMonomial -> Maybe LaurentMonomial
`divLM` LaurentMPoly r -> LaurentMonomial
forall r. LaurentMPoly r -> LaurentMonomial
lm LaurentMPoly r
g of
Just m :: LaurentMonomial
m -> let t :: LaurentMPoly r
t = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP [(LaurentMonomial
m, LaurentMPoly r -> r
forall r. LaurentMPoly r -> r
lc LaurentMPoly r
h r -> r -> r
forall a. Fractional a => a -> a -> a
/ LaurentMPoly r -> r
forall r. LaurentMPoly r -> r
lc LaurentMPoly r
g)]
in LaurentMPoly r
-> (LaurentMPoly r, LaurentMPoly r)
-> (LaurentMPoly r, LaurentMPoly r)
quotRemLP' (LaurentMPoly r
hLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
forall a. Num a => a -> a -> a
-LaurentMPoly r
tLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
forall a. Num a => a -> a -> a
*LaurentMPoly r
g) (LaurentMPoly r
qLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
forall a. Num a => a -> a -> a
+LaurentMPoly r
t,LaurentMPoly r
r)
Nothing -> let lth :: LaurentMPoly r
lth = LaurentMPoly r -> LaurentMPoly r
forall r. LaurentMPoly r -> LaurentMPoly r
lt LaurentMPoly r
h
in LaurentMPoly r
-> (LaurentMPoly r, LaurentMPoly r)
-> (LaurentMPoly r, LaurentMPoly r)
quotRemLP' (LaurentMPoly r
hLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
forall a. Num a => a -> a -> a
-LaurentMPoly r
lth) (LaurentMPoly r
q, LaurentMPoly r
rLaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
forall a. Num a => a -> a -> a
+LaurentMPoly r
lth)
reduceLP :: LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
reduceLP f :: LaurentMPoly r
f g :: LaurentMPoly r
g@(LP [_,_]) =
let fn :: LaurentMPoly r
fn = LaurentMPoly r
f LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
forall a. Num a => a -> a -> a
* LaurentMPoly r
fd
fd :: LaurentMPoly r
fd = LaurentMPoly r -> LaurentMPoly r
forall r r. Num r => LaurentMPoly r -> LaurentMPoly r
denominatorLP LaurentMPoly r
f
(_,rn :: LaurentMPoly r
rn) = LaurentMPoly r
-> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
forall r.
(Eq r, Fractional r) =>
LaurentMPoly r
-> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
quotRemLP LaurentMPoly r
fn LaurentMPoly r
g
(_,rd :: LaurentMPoly r
rd) = LaurentMPoly r
-> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
forall r.
(Eq r, Fractional r) =>
LaurentMPoly r
-> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
quotRemLP LaurentMPoly r
fd LaurentMPoly r
g
in LaurentMPoly r
rn LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
forall a. Fractional a => a -> a -> a
/ LaurentMPoly r
rd
var :: String -> LaurentMPoly r
var v :: String
v = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP [(Map String Q -> LaurentMonomial
LM (Map String Q -> LaurentMonomial)
-> Map String Q -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ String -> Q -> Map String Q
forall k a. k -> a -> Map k a
M.singleton String
v 1, 1)]
t :: LaurentMPoly Q
t = String -> LaurentMPoly Q
forall r. Num r => String -> LaurentMPoly r
var "t" :: LaurentMPoly Q
x :: LaurentMPoly Q
x = String -> LaurentMPoly Q
forall r. Num r => String -> LaurentMPoly r
var "x" :: LaurentMPoly Q
y :: LaurentMPoly Q
y = String -> LaurentMPoly Q
forall r. Num r => String -> LaurentMPoly r
var "y" :: LaurentMPoly Q
z :: LaurentMPoly Q
z = String -> LaurentMPoly Q
forall r. Num r => String -> LaurentMPoly r
var "z" :: LaurentMPoly Q
denominatorLP :: LaurentMPoly r -> LaurentMPoly r
denominatorLP (LP ts :: [(LaurentMonomial, r)]
ts) = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP [(LaurentMonomial
m',1)] where
m' :: LaurentMonomial
m' = (LaurentMonomial -> LaurentMonomial -> LaurentMonomial)
-> LaurentMonomial -> [LaurentMonomial] -> LaurentMonomial
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl LaurentMonomial -> LaurentMonomial -> LaurentMonomial
lcmLM 1 [LaurentMonomial -> LaurentMonomial
denominatorLM LaurentMonomial
m | (m :: LaurentMonomial
m,c :: r
c) <- [(LaurentMonomial, r)]
ts]
inject :: r -> LaurentMPoly r
inject 0 = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP []
inject c :: r
c = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP [(Integer -> LaurentMonomial
forall a. Num a => Integer -> a
fromInteger 1, r
c)]
sqrtvar :: String -> LaurentMPoly r
sqrtvar v :: String
v = [(LaurentMonomial, r)] -> LaurentMPoly r
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP [(Map String Q -> LaurentMonomial
LM (Map String Q -> LaurentMonomial)
-> Map String Q -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ String -> Q -> Map String Q
forall k a. k -> a -> Map k a
M.singleton String
v (1Q -> Q -> Q
forall a. Fractional a => a -> a -> a
/2), 1)]
subst :: [(LaurentMPoly r, LaurentMPoly r)]
-> LaurentMPoly r -> LaurentMPoly r
subst vts :: [(LaurentMPoly r, LaurentMPoly r)]
vts (LP us :: [(LaurentMonomial, r)]
us) = [LaurentMPoly r] -> LaurentMPoly r
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [r -> LaurentMPoly r
forall r. (Eq r, Num r) => r -> LaurentMPoly r
inject r
c LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
forall a. Num a => a -> a -> a
* LaurentMonomial -> LaurentMPoly r
substM LaurentMonomial
m | (m :: LaurentMonomial
m,c :: r
c) <- [(LaurentMonomial, r)]
us] where
substM :: LaurentMonomial -> LaurentMPoly r
substM (LM m :: Map String Q
m) = [LaurentMPoly r] -> LaurentMPoly r
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [String -> LaurentMPoly r
substV String
v LaurentMPoly r -> Q -> LaurentMPoly r
forall a.
(Eq a, Fractional a, Show a) =>
LaurentMPoly a -> Q -> LaurentMPoly a
^^^ Q
i | (v :: String
v,i :: Q
i) <- Map String Q -> [(String, Q)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Q
m]
substV :: String -> LaurentMPoly r
substV v :: String
v =
let v' :: LaurentMPoly r
v' = String -> LaurentMPoly r
forall r. Num r => String -> LaurentMPoly r
var String
v in
case LaurentMPoly r
-> [(LaurentMPoly r, LaurentMPoly r)] -> Maybe (LaurentMPoly r)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup LaurentMPoly r
v' [(LaurentMPoly r, LaurentMPoly r)]
vts of
Just t :: LaurentMPoly r
t -> LaurentMPoly r
t
Nothing -> LaurentMPoly r
v'
f :: LaurentMPoly a
f ^^^ :: LaurentMPoly a -> Q -> LaurentMPoly a
^^^ i :: Q
i | Q -> Integer
denominatorQ Q
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = LaurentMPoly a
f LaurentMPoly a -> Integer -> LaurentMPoly a
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Q -> Integer
numeratorQ Q
i
| Bool
otherwise = case LaurentMPoly a
f of
LP [(LM m :: Map String Q
m,1)] -> [(LaurentMonomial, a)] -> LaurentMPoly a
forall r. [(LaurentMonomial, r)] -> LaurentMPoly r
LP [(Map String Q -> LaurentMonomial
LM (Map String Q -> LaurentMonomial)
-> Map String Q -> LaurentMonomial
forall a b. (a -> b) -> a -> b
$ (Q -> Q) -> Map String Q -> Map String Q
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (Q -> Q -> Q
forall a. Num a => a -> a -> a
*Q
i) Map String Q
m ,1)]
otherwise :: LaurentMPoly a
otherwise -> String -> LaurentMPoly a
forall a. HasCallStack => String -> a
error ("(^^^): Cannot calculate " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LaurentMPoly a -> String
forall a. Show a => a -> String
show LaurentMPoly a
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ " ^^^ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Q -> String
forall a. Show a => a -> String
show Q
i)