module Math.Algebra.NonCommutative.NCPoly where
import Data.List as L
import Math.Algebra.Field.Base
newtype Monomial v = M [v] deriving (Monomial v -> Monomial v -> Bool
(Monomial v -> Monomial v -> Bool)
-> (Monomial v -> Monomial v -> Bool) -> Eq (Monomial v)
forall v. Eq v => Monomial v -> Monomial v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Monomial v -> Monomial v -> Bool
$c/= :: forall v. Eq v => Monomial v -> Monomial v -> Bool
== :: Monomial v -> Monomial v -> Bool
$c== :: forall v. Eq v => Monomial v -> Monomial v -> Bool
Eq)
instance Ord v => Ord (Monomial v) where
compare :: Monomial v -> Monomial v -> Ordering
compare (M xs :: [v]
xs) (M ys :: [v]
ys) = (Int, [v]) -> (Int, [v]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
xs,[v]
xs) ([v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
ys,[v]
ys)
instance (Eq v, Show v) => Show (Monomial v) where
show :: Monomial v -> String
show (M xs :: [v]
xs) | [v] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [v]
xs = "1"
| Bool
otherwise = ([v] -> String) -> [[v]] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [v] -> String
forall a. Show a => [a] -> String
showPower ([v] -> [[v]]
forall a. Eq a => [a] -> [[a]]
L.group [v]
xs)
where showPower :: [a] -> String
showPower [v :: a
v] = a -> String
forall a. Show a => a -> String
showVar a
v
showPower vs :: [a]
vs@(v :: a
v:_) = a -> String
forall a. Show a => a -> String
showVar a
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ "^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs)
showVar :: a -> String
showVar v :: a
v = (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
v)
instance (Eq v, Show v) => Num (Monomial v) where
M xs :: [v]
xs * :: Monomial v -> Monomial v -> Monomial v
* M ys :: [v]
ys = [v] -> Monomial v
forall v. [v] -> Monomial v
M ([v]
xs [v] -> [v] -> [v]
forall a. [a] -> [a] -> [a]
++ [v]
ys)
fromInteger :: Integer -> Monomial v
fromInteger 1 = [v] -> Monomial v
forall v. [v] -> Monomial v
M []
divM :: Monomial v -> Monomial v -> Maybe (Monomial v, Monomial v)
divM (M a :: [v]
a) (M b :: [v]
b) = [v] -> [v] -> Maybe (Monomial v, Monomial v)
divM' [] [v]
a where
divM' :: [v] -> [v] -> Maybe (Monomial v, Monomial v)
divM' ls :: [v]
ls (r :: v
r:rs :: [v]
rs) =
if [v]
b [v] -> [v] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` (v
rv -> [v] -> [v]
forall a. a -> [a] -> [a]
:[v]
rs)
then (Monomial v, Monomial v) -> Maybe (Monomial v, Monomial v)
forall a. a -> Maybe a
Just ([v] -> Monomial v
forall v. [v] -> Monomial v
M ([v] -> Monomial v) -> [v] -> Monomial v
forall a b. (a -> b) -> a -> b
$ [v] -> [v]
forall a. [a] -> [a]
reverse [v]
ls, [v] -> Monomial v
forall v. [v] -> Monomial v
M ([v] -> Monomial v) -> [v] -> Monomial v
forall a b. (a -> b) -> a -> b
$ Int -> [v] -> [v]
forall a. Int -> [a] -> [a]
drop ([v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
b) (v
rv -> [v] -> [v]
forall a. a -> [a] -> [a]
:[v]
rs))
else [v] -> [v] -> Maybe (Monomial v, Monomial v)
divM' (v
rv -> [v] -> [v]
forall a. a -> [a] -> [a]
:[v]
ls) [v]
rs
divM' _ [] = Maybe (Monomial v, Monomial v)
forall a. Maybe a
Nothing
newtype NPoly r v = NP [(Monomial v,r)] deriving (NPoly r v -> NPoly r v -> Bool
(NPoly r v -> NPoly r v -> Bool)
-> (NPoly r v -> NPoly r v -> Bool) -> Eq (NPoly r v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r v. (Eq v, Eq r) => NPoly r v -> NPoly r v -> Bool
/= :: NPoly r v -> NPoly r v -> Bool
$c/= :: forall r v. (Eq v, Eq r) => NPoly r v -> NPoly r v -> Bool
== :: NPoly r v -> NPoly r v -> Bool
$c== :: forall r v. (Eq v, Eq r) => NPoly r v -> NPoly r v -> Bool
Eq)
instance (Ord r, Ord v) => Ord (NPoly r v) where
compare :: NPoly r v -> NPoly r v -> Ordering
compare (NP ts :: [(Monomial v, r)]
ts) (NP us :: [(Monomial v, r)]
us) = [(Monomial v, r)] -> [(Monomial v, r)] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [(Monomial v, r)]
ts [(Monomial v, r)]
us
instance (Show r, Eq v, Show v) => Show (NPoly r v) where
show :: NPoly r v -> String
show (NP []) = "0"
show (NP ts :: [(Monomial v, r)]
ts) =
let (c :: Char
c:cs :: String
cs) = ((Monomial v, r) -> String) -> [(Monomial v, r)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Monomial v, r) -> String
forall a a. (Show a, Show a, Eq a, Num a) => (a, a) -> String
showTerm [(Monomial v, 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,a :: a
a) =
case a -> String
forall a. Show a => a -> String
show a
a 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, Ord v, Show v) => Num (NPoly r v) where
NP ts :: [(Monomial v, r)]
ts + :: NPoly r v -> NPoly r v -> NPoly r v
+ NP us :: [(Monomial v, r)]
us = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP ([(Monomial v, r)] -> [(Monomial v, r)] -> [(Monomial v, r)]
forall a b.
(Ord a, Eq b, Num b) =>
[(a, b)] -> [(a, b)] -> [(a, b)]
mergeTerms [(Monomial v, r)]
ts [(Monomial v, r)]
us)
negate :: NPoly r v -> NPoly r v
negate (NP ts :: [(Monomial v, r)]
ts) = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP ([(Monomial v, r)] -> NPoly r v) -> [(Monomial v, r)] -> NPoly r v
forall a b. (a -> b) -> a -> b
$ ((Monomial v, r) -> (Monomial v, r))
-> [(Monomial v, r)] -> [(Monomial v, r)]
forall a b. (a -> b) -> [a] -> [b]
map (\(m :: Monomial v
m,c :: r
c) -> (Monomial v
m,-r
c)) [(Monomial v, r)]
ts
NP ts :: [(Monomial v, r)]
ts * :: NPoly r v -> NPoly r v -> NPoly r v
* NP us :: [(Monomial v, r)]
us = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP ([(Monomial v, r)] -> NPoly r v) -> [(Monomial v, r)] -> NPoly r v
forall a b. (a -> b) -> a -> b
$ [(Monomial v, r)] -> [(Monomial v, r)]
forall a a. (Num a, Eq a, Eq a) => [(a, a)] -> [(a, a)]
collect ([(Monomial v, r)] -> [(Monomial v, r)])
-> [(Monomial v, r)] -> [(Monomial v, r)]
forall a b. (a -> b) -> a -> b
$ ((Monomial v, r) -> (Monomial v, r) -> Ordering)
-> [(Monomial v, r)] -> [(Monomial v, r)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Monomial v, r) -> (Monomial v, r) -> Ordering
forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
cmpTerm ([(Monomial v, r)] -> [(Monomial v, r)])
-> [(Monomial v, r)] -> [(Monomial v, r)]
forall a b. (a -> b) -> a -> b
$ [(Monomial v
gMonomial v -> Monomial v -> Monomial v
forall a. Num a => a -> a -> a
*Monomial v
h,r
cr -> r -> r
forall a. Num a => a -> a -> a
*r
d) | (g :: Monomial v
g,c :: r
c) <- [(Monomial v, r)]
ts, (h :: Monomial v
h,d :: r
d) <- [(Monomial v, r)]
us]
fromInteger :: Integer -> NPoly r v
fromInteger 0 = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP []
fromInteger n :: Integer
n = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Integer -> Monomial v
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 k, Fractional k, Ord v, Show v) => Fractional (NPoly k v) where
recip :: NPoly k v -> NPoly k v
recip (NP [(1,c :: k
c)]) = [(Monomial v, k)] -> NPoly k v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(1, k -> k
forall a. Fractional a => a -> a
recip k
c)]
recip _ = String -> NPoly k v
forall a. HasCallStack => String -> a
error "NPoly.recip: only supported for (non-zero) constants"
data Var = X | Y | Z deriving (Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c== :: Var -> Var -> Bool
Eq,Eq Var
Eq Var =>
(Var -> Var -> Ordering)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Var)
-> (Var -> Var -> Var)
-> Ord Var
Var -> Var -> Bool
Var -> Var -> Ordering
Var -> Var -> Var
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
min :: Var -> Var -> Var
$cmin :: Var -> Var -> Var
max :: Var -> Var -> Var
$cmax :: Var -> Var -> Var
>= :: Var -> Var -> Bool
$c>= :: Var -> Var -> Bool
> :: Var -> Var -> Bool
$c> :: Var -> Var -> Bool
<= :: Var -> Var -> Bool
$c<= :: Var -> Var -> Bool
< :: Var -> Var -> Bool
$c< :: Var -> Var -> Bool
compare :: Var -> Var -> Ordering
$ccompare :: Var -> Var -> Ordering
$cp1Ord :: Eq Var
Ord)
instance Show Var where
show :: Var -> String
show X = "x"
show Y = "y"
show Z = "z"
var :: (Num k) => v -> NPoly k v
var :: v -> NPoly k v
var v :: v
v = [(Monomial v, k)] -> NPoly k v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [([v] -> Monomial v
forall v. [v] -> Monomial v
M [v
v], 1)]
x :: NPoly Q Var
x = Var -> NPoly Q Var
forall k v. Num k => v -> NPoly k v
var Var
X :: NPoly Q Var
y :: NPoly Q Var
y = Var -> NPoly Q Var
forall k v. Num k => v -> NPoly k v
var Var
Y :: NPoly Q Var
z :: NPoly Q Var
z = Var -> NPoly Q Var
forall k v. Num k => v -> NPoly k v
var Var
Z :: NPoly Q Var
lm :: NPoly r v -> Monomial v
lm (NP ((m :: Monomial v
m,c :: r
c):ts :: [(Monomial v, r)]
ts)) = Monomial v
m
lc :: NPoly r v -> r
lc (NP ((m :: Monomial v
m,c :: r
c):ts :: [(Monomial v, r)]
ts)) = r
c
lt :: NPoly r v -> NPoly r v
lt (NP (t :: (Monomial v, r)
t:ts :: [(Monomial v, r)]
ts)) = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Monomial v, r)
t]
quotRemNP :: NPoly r v -> [NPoly r v] -> ([(NPoly r v, NPoly r v)], NPoly r v)
quotRemNP f :: NPoly r v
f gs :: [NPoly r v]
gs | (NPoly r v -> Bool) -> [NPoly r v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (NPoly r v -> NPoly r v -> Bool
forall a. Eq a => a -> a -> Bool
/=0) [NPoly r v]
gs = NPoly r v
-> ([(NPoly r v, NPoly r v)], NPoly r v)
-> ([(NPoly r v, NPoly r v)], NPoly r v)
quotRemNP' NPoly r v
f (Int -> (NPoly r v, NPoly r v) -> [(NPoly r v, NPoly r v)]
forall a. Int -> a -> [a]
replicate Int
n (0,0), 0)
| Bool
otherwise = String -> ([(NPoly r v, NPoly r v)], NPoly r v)
forall a. HasCallStack => String -> a
error "quotRemNP: division by zero"
where
n :: Int
n = [NPoly r v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NPoly r v]
gs
quotRemNP' :: NPoly r v
-> ([(NPoly r v, NPoly r v)], NPoly r v)
-> ([(NPoly r v, NPoly r v)], NPoly r v)
quotRemNP' 0 (lrs :: [(NPoly r v, NPoly r v)]
lrs,f' :: NPoly r v
f') = ([(NPoly r v, NPoly r v)]
lrs,NPoly r v
f')
quotRemNP' h :: NPoly r v
h (lrs :: [(NPoly r v, NPoly r v)]
lrs,f' :: NPoly r v
f') = NPoly r v
-> ([NPoly r v], [(NPoly r v, NPoly r v)],
[(NPoly r v, NPoly r v)], NPoly r v)
-> ([(NPoly r v, NPoly r v)], NPoly r v)
divisionStep NPoly r v
h ([NPoly r v]
gs,[],[(NPoly r v, NPoly r v)]
lrs,NPoly r v
f')
divisionStep :: NPoly r v
-> ([NPoly r v], [(NPoly r v, NPoly r v)],
[(NPoly r v, NPoly r v)], NPoly r v)
-> ([(NPoly r v, NPoly r v)], NPoly r v)
divisionStep h :: NPoly r v
h (g :: NPoly r v
g:gs :: [NPoly r v]
gs, lrs' :: [(NPoly r v, NPoly r v)]
lrs', (l :: NPoly r v
l,r :: NPoly r v
r):lrs :: [(NPoly r v, NPoly r v)]
lrs, f' :: NPoly r v
f') =
case NPoly r v -> Monomial v
forall r v. NPoly r v -> Monomial v
lm NPoly r v
h Monomial v -> Monomial v -> Maybe (Monomial v, Monomial v)
forall v.
Eq v =>
Monomial v -> Monomial v -> Maybe (Monomial v, Monomial v)
`divM` NPoly r v -> Monomial v
forall r v. NPoly r v -> Monomial v
lm NPoly r v
g of
Just (l' :: Monomial v
l',r' :: Monomial v
r') -> let l'' :: NPoly r v
l'' = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Monomial v
l',NPoly r v -> r
forall r v. NPoly r v -> r
lc NPoly r v
h r -> r -> r
forall a. Fractional a => a -> a -> a
/ NPoly r v -> r
forall r v. NPoly r v -> r
lc NPoly r v
g)]
r'' :: NPoly r v
r'' = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Monomial v
r',1)]
h' :: NPoly r v
h' = NPoly r v
h NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
- NPoly r v
l'' NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* NPoly r v
g NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* NPoly r v
r''
in NPoly r v
-> ([(NPoly r v, NPoly r v)], NPoly r v)
-> ([(NPoly r v, NPoly r v)], NPoly r v)
quotRemNP' NPoly r v
h' ([(NPoly r v, NPoly r v)] -> [(NPoly r v, NPoly r v)]
forall a. [a] -> [a]
reverse [(NPoly r v, NPoly r v)]
lrs' [(NPoly r v, NPoly r v)]
-> [(NPoly r v, NPoly r v)] -> [(NPoly r v, NPoly r v)]
forall a. [a] -> [a] -> [a]
++ (NPoly r v
lNPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
+NPoly r v
l'',NPoly r v
rNPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
+NPoly r v
r'')(NPoly r v, NPoly r v)
-> [(NPoly r v, NPoly r v)] -> [(NPoly r v, NPoly r v)]
forall a. a -> [a] -> [a]
:[(NPoly r v, NPoly r v)]
lrs, NPoly r v
f')
Nothing -> NPoly r v
-> ([NPoly r v], [(NPoly r v, NPoly r v)],
[(NPoly r v, NPoly r v)], NPoly r v)
-> ([(NPoly r v, NPoly r v)], NPoly r v)
divisionStep NPoly r v
h ([NPoly r v]
gs,(NPoly r v
l,NPoly r v
r)(NPoly r v, NPoly r v)
-> [(NPoly r v, NPoly r v)] -> [(NPoly r v, NPoly r v)]
forall a. a -> [a] -> [a]
:[(NPoly r v, NPoly r v)]
lrs',[(NPoly r v, NPoly r v)]
lrs,NPoly r v
f')
divisionStep h :: NPoly r v
h ([],lrs' :: [(NPoly r v, NPoly r v)]
lrs',[],f' :: NPoly r v
f') =
let lth :: NPoly r v
lth = NPoly r v -> NPoly r v
forall r v. NPoly r v -> NPoly r v
lt NPoly r v
h
in NPoly r v
-> ([(NPoly r v, NPoly r v)], NPoly r v)
-> ([(NPoly r v, NPoly r v)], NPoly r v)
quotRemNP' (NPoly r v
hNPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
-NPoly r v
lth) ([(NPoly r v, NPoly r v)] -> [(NPoly r v, NPoly r v)]
forall a. [a] -> [a]
reverse [(NPoly r v, NPoly r v)]
lrs', NPoly r v
f'NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
+NPoly r v
lth)
remNP :: NPoly r v -> [NPoly r v] -> NPoly r v
remNP f :: NPoly r v
f gs :: [NPoly r v]
gs | (NPoly r v -> Bool) -> [NPoly r v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (NPoly r v -> NPoly r v -> Bool
forall a. Eq a => a -> a -> Bool
/=0) [NPoly r v]
gs = NPoly r v -> NPoly r v -> NPoly r v
remNP' NPoly r v
f 0
| Bool
otherwise = String -> NPoly r v
forall a. HasCallStack => String -> a
error "remNP: division by zero"
where
n :: Int
n = [NPoly r v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NPoly r v]
gs
remNP' :: NPoly r v -> NPoly r v -> NPoly r v
remNP' 0 f' :: NPoly r v
f' = NPoly r v
f'
remNP' h :: NPoly r v
h f' :: NPoly r v
f' = NPoly r v -> [NPoly r v] -> NPoly r v -> NPoly r v
divisionStep NPoly r v
h [NPoly r v]
gs NPoly r v
f'
divisionStep :: NPoly r v -> [NPoly r v] -> NPoly r v -> NPoly r v
divisionStep h :: NPoly r v
h (g:gs) f' :: NPoly r v
f' =
case NPoly r v -> Monomial v
forall r v. NPoly r v -> Monomial v
lm NPoly r v
h Monomial v -> Monomial v -> Maybe (Monomial v, Monomial v)
forall v.
Eq v =>
Monomial v -> Monomial v -> Maybe (Monomial v, Monomial v)
`divM` NPoly r v -> Monomial v
forall r v. NPoly r v -> Monomial v
lm NPoly r v
g of
Just (l' :: Monomial v
l',r' :: Monomial v
r') -> let l'' :: NPoly r v
l'' = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Monomial v
l',NPoly r v -> r
forall r v. NPoly r v -> r
lc NPoly r v
h r -> r -> r
forall a. Fractional a => a -> a -> a
/ NPoly r v -> r
forall r v. NPoly r v -> r
lc NPoly r v
g)]
r'' :: NPoly r v
r'' = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Monomial v
r',1)]
h' :: NPoly r v
h' = NPoly r v
h NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
- NPoly r v
l'' NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* NPoly r v
g NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* NPoly r v
r''
in NPoly r v -> NPoly r v -> NPoly r v
remNP' NPoly r v
h' NPoly r v
f'
Nothing -> NPoly r v -> [NPoly r v] -> NPoly r v -> NPoly r v
divisionStep NPoly r v
h [NPoly r v]
gs NPoly r v
f'
divisionStep h :: NPoly r v
h [] f' :: NPoly r v
f' =
let lth :: NPoly r v
lth = NPoly r v -> NPoly r v
forall r v. NPoly r v -> NPoly r v
lt NPoly r v
h
in NPoly r v -> NPoly r v -> NPoly r v
remNP' (NPoly r v
hNPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
-NPoly r v
lth) (NPoly r v
f'NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
+NPoly r v
lth)
infixl 7 %%
f :: NPoly r v
f %% :: NPoly r v -> [NPoly r v] -> NPoly r v
%% gs :: [NPoly r v]
gs = NPoly r v -> [NPoly r v] -> NPoly r v
forall v r.
(Fractional r, Ord v, Show v, Eq r) =>
NPoly r v -> [NPoly r v] -> NPoly r v
remNP NPoly r v
f [NPoly r v]
gs
remNP2 :: NPoly r v -> [NPoly r v] -> NPoly r v
remNP2 f :: NPoly r v
f gs :: [NPoly r v]
gs | (NPoly r v -> Bool) -> [NPoly r v] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (NPoly r v -> NPoly r v -> Bool
forall a. Eq a => a -> a -> Bool
/=0) [NPoly r v]
gs = NPoly r v -> NPoly r v -> NPoly r v
remNP' NPoly r v
f 0
| Bool
otherwise = String -> NPoly r v
forall a. HasCallStack => String -> a
error "remNP: division by zero"
where
n :: Int
n = [NPoly r v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NPoly r v]
gs
remNP' :: NPoly r v -> NPoly r v -> NPoly r v
remNP' 0 f' :: NPoly r v
f' = NPoly r v
f'
remNP' h :: NPoly r v
h f' :: NPoly r v
f' = NPoly r v -> [NPoly r v] -> NPoly r v -> NPoly r v
divisionStep NPoly r v
h [NPoly r v]
gs NPoly r v
f'
divisionStep :: NPoly r v -> [NPoly r v] -> NPoly r v -> NPoly r v
divisionStep h :: NPoly r v
h (g:gs) f' :: NPoly r v
f' =
case NPoly r v -> Monomial v
forall r v. NPoly r v -> Monomial v
lm NPoly r v
h Monomial v -> Monomial v -> Maybe (Monomial v, Monomial v)
forall v.
Eq v =>
Monomial v -> Monomial v -> Maybe (Monomial v, Monomial v)
`divM` NPoly r v -> Monomial v
forall r v. NPoly r v -> Monomial v
lm NPoly r v
g of
Just (l' :: Monomial v
l',r' :: Monomial v
r') -> let l'' :: NPoly r v
l'' = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Monomial v
l',1)]
r'' :: NPoly r v
r'' = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Monomial v
r',1)]
lcg :: NPoly r v
lcg = r -> NPoly r v
forall r v. (Num r, Eq r, Eq v, Show v) => r -> NPoly r v
inject (NPoly r v -> r
forall r v. NPoly r v -> r
lc NPoly r v
g)
lch :: NPoly r v
lch = r -> NPoly r v
forall r v. (Num r, Eq r, Eq v, Show v) => r -> NPoly r v
inject (NPoly r v -> r
forall r v. NPoly r v -> r
lc NPoly r v
h)
h' :: NPoly r v
h' = NPoly r v
lcg NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* NPoly r v
h NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
- NPoly r v
lch NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* NPoly r v
l'' NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* NPoly r v
g NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* NPoly r v
r''
in NPoly r v -> NPoly r v -> NPoly r v
remNP' NPoly r v
h' (NPoly r v
lcg NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* NPoly r v
f')
Nothing -> NPoly r v -> [NPoly r v] -> NPoly r v -> NPoly r v
divisionStep NPoly r v
h [NPoly r v]
gs NPoly r v
f'
divisionStep h :: NPoly r v
h [] f' :: NPoly r v
f' =
let lth :: NPoly r v
lth = NPoly r v -> NPoly r v
forall r v. NPoly r v -> NPoly r v
lt NPoly r v
h
in NPoly r v -> NPoly r v -> NPoly r v
remNP' (NPoly r v
hNPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
-NPoly r v
lth) (NPoly r v
f'NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
+NPoly r v
lth)
toMonic :: NPoly r v -> NPoly r v
toMonic 0 = 0
toMonic (NP ts :: [(Monomial v, r)]
ts@((_,c :: r
c):_))
| r
c r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Monomial v, r)]
ts
| Bool
otherwise = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP ([(Monomial v, r)] -> NPoly r v) -> [(Monomial v, r)] -> NPoly r v
forall a b. (a -> b) -> a -> b
$ ((Monomial v, r) -> (Monomial v, r))
-> [(Monomial v, r)] -> [(Monomial v, r)]
forall a b. (a -> b) -> [a] -> [b]
map (\(m :: Monomial v
m,d :: r
d)->(Monomial v
m,r
dr -> r -> r
forall a. Fractional a => a -> a -> a
/r
c)) [(Monomial v, r)]
ts
inject :: r -> NPoly r v
inject 0 = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP []
inject c :: r
c = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [(Integer -> Monomial v
forall a. Num a => Integer -> a
fromInteger 1, r
c)]
subst :: [(NPoly r v, NPoly r v)] -> NPoly r v -> NPoly r v
subst vts :: [(NPoly r v, NPoly r v)]
vts (NP us :: [(Monomial v, r)]
us) = [NPoly r v] -> NPoly r v
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [r -> NPoly r v
forall r v. (Num r, Eq r, Eq v, Show v) => r -> NPoly r v
inject r
c NPoly r v -> NPoly r v -> NPoly r v
forall a. Num a => a -> a -> a
* Monomial v -> NPoly r v
substM Monomial v
m | (m :: Monomial v
m,c :: r
c) <- [(Monomial v, r)]
us] where
substM :: Monomial v -> NPoly r v
substM (M xs :: [v]
xs) = [NPoly r v] -> NPoly r v
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [v -> NPoly r v
substV v
x | v
x <- [v]
xs]
substV :: v -> NPoly r v
substV v :: v
v =
let v' :: NPoly r v
v' = [(Monomial v, r)] -> NPoly r v
forall r v. [(Monomial v, r)] -> NPoly r v
NP [([v] -> Monomial v
forall v. [v] -> Monomial v
M [v
v], 1)] in
case NPoly r v -> [(NPoly r v, NPoly r v)] -> Maybe (NPoly r v)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup NPoly r v
v' [(NPoly r v, NPoly r v)]
vts of
Just t :: NPoly r v
t -> NPoly r v
t
Nothing -> String -> NPoly r v
forall a. HasCallStack => String -> a
error ("subst: no substitute supplied for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NPoly r v -> String
forall a. Show a => a -> String
show NPoly r v
v')
class Invertible a where
inv :: a -> a
x :: a
x ^- :: a -> b -> a
^- k :: b
k = a -> a
forall a. Invertible a => a -> a
inv a
x a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ b
k