module Symtegration.Integration.Monomial
( hermiteReduce,
polynomialReduce,
residueReduce,
)
where
import Data.List (find)
import Data.Monoid (Sum (..))
import Symtegration.Polynomial
import Symtegration.Polynomial.Differential
import Symtegration.Polynomial.Rational
hermiteReduce ::
(Polynomial p e c, Eq (p e c), Num (p e c), Eq c, Fractional c) =>
(p e c -> p e c) ->
Function (p e c) ->
([Function (p e c)], Function (p e c), Function (p e c))
hermiteReduce :: forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Eq c, Fractional c) =>
(p e c -> p e c)
-> Function (p e c)
-> ([Function (p e c)], Function (p e c), Function (p e c))
hermiteReduce p e c -> p e c
_ r :: Function (p e c)
r@(Function p e c
_ p e c
0) = ([], Function (p e c)
0, Function (p e c)
r)
hermiteReduce p e c -> p e c
derivation Function (p e c)
f = ([Function (p e c)]
g, Function (p e c)
h, p e c -> Function (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Num (p e c)) =>
p e c -> Function (p e c)
fromPolynomial (p e c
q p e c -> p e c -> p e c
forall a. Num a => a -> a -> a
+ p e c
p) Function (p e c) -> Function (p e c) -> Function (p e c)
forall a. Num a => a -> a -> a
+ Function (p e c)
s)
where
(p e c
p, Function (p e c)
n, Function (p e c)
s) = (p e c -> p e c)
-> Function (p e c) -> (p e c, Function (p e c), Function (p e c))
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Eq c, Fractional c) =>
(p e c -> p e c)
-> Function (p e c) -> (p e c, Function (p e c), Function (p e c))
canonical p e c -> p e c
derivation Function (p e c)
f
([Function (p e c)]
g, Function (p e c)
h, p e c
q) = (p e c -> p e c)
-> Function (p e c)
-> ([Function (p e c)], Function (p e c), p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Eq c, Fractional c) =>
(p e c -> p e c)
-> Function (p e c)
-> ([Function (p e c)], Function (p e c), p e c)
hermiteReduce' p e c -> p e c
derivation Function (p e c)
n
hermiteReduce' ::
(Polynomial p e c, Eq (p e c), Num (p e c), Eq c, Fractional c) =>
(p e c -> p e c) ->
Function (p e c) ->
([Function (p e c)], Function (p e c), p e c)
hermiteReduce' :: forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Eq c, Fractional c) =>
(p e c -> p e c)
-> Function (p e c)
-> ([Function (p e c)], Function (p e c), p e c)
hermiteReduce' p e c -> p e c
derivation f :: Function (p e c)
f@(Function p e c
x p e c
y)
| (Just ([Function (p e c)]
g, (p e c
a, p e c
d))) <- p e c
-> [Function (p e c)]
-> p e c
-> Maybe ([Function (p e c)], (p e c, p e c))
reduce p e c
x [] p e c
common =
let (p e c
q, p e c
r) = p e c
a p e c -> p e c -> (p e c, p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> (p e c, p e c)
`divide` p e c
d
in ([Function (p e c)]
g, p e c -> p e c -> Function (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> Function (p e c)
fromPolynomials p e c
r p e c
d, p e c
q)
| Bool
otherwise = ([], Function (p e c)
f, p e c
0)
where
common :: p e c
common = p e c -> p e c
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq c, Fractional c) =>
p e c -> p e c
monic (p e c -> p e c) -> p e c -> p e c
forall a b. (a -> b) -> a -> b
$ p e c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> p e c
greatestCommonDivisor p e c
y (p e c -> p e c) -> p e c -> p e c
forall a b. (a -> b) -> a -> b
$ p e c -> p e c
derivation p e c
y
(p e c
divisor, p e c
_) = p e c
y p e c -> p e c -> (p e c, p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> (p e c, p e c)
`divide` p e c
common
reduce :: p e c
-> [Function (p e c)]
-> p e c
-> Maybe ([Function (p e c)], (p e c, p e c))
reduce p e c
a [Function (p e c)]
g p e c
d
| p e c -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree p e c
d e -> e -> Bool
forall a. Ord a => a -> a -> Bool
> e
0 = do
let d' :: p e c
d' = p e c -> p e c
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq c, Fractional c) =>
p e c -> p e c
monic (p e c -> p e c) -> p e c -> p e c
forall a b. (a -> b) -> a -> b
$ p e c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> p e c
greatestCommonDivisor p e c
d (p e c -> p e c) -> p e c -> p e c
forall a b. (a -> b) -> a -> b
$ p e c -> p e c
derivation p e c
d
let (p e c
d'', p e c
_) = p e c
d p e c -> p e c -> (p e c, p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> (p e c, p e c)
`divide` p e c
d'
let (p e c
d''', p e c
_) = (p e c
divisor p e c -> p e c -> p e c
forall a. Num a => a -> a -> a
* p e c -> p e c
derivation p e c
d) p e c -> p e c -> (p e c, p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> (p e c, p e c)
`divide` p e c
d
(p e c
b, p e c
c) <- p e c -> p e c -> p e c -> Maybe (p e c, p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> p e c -> Maybe (p e c, p e c)
diophantineEuclidean (-p e c
d''') p e c
d'' p e c
a
let (p e c
b', p e c
_) = (p e c -> p e c
derivation p e c
b p e c -> p e c -> p e c
forall a. Num a => a -> a -> a
* p e c
divisor) p e c -> p e c -> (p e c, p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> (p e c, p e c)
`divide` p e c
d''
let a' :: p e c
a' = p e c
c p e c -> p e c -> p e c
forall a. Num a => a -> a -> a
- p e c
b'
let g' :: [Function (p e c)]
g' = p e c -> p e c -> Function (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> Function (p e c)
fromPolynomials p e c
b p e c
d Function (p e c) -> [Function (p e c)] -> [Function (p e c)]
forall a. a -> [a] -> [a]
: [Function (p e c)]
g
p e c
-> [Function (p e c)]
-> p e c
-> Maybe ([Function (p e c)], (p e c, p e c))
reduce p e c
a' [Function (p e c)]
g' p e c
d'
| Bool
otherwise = ([Function (p e c)], (p e c, p e c))
-> Maybe ([Function (p e c)], (p e c, p e c))
forall a. a -> Maybe a
Just ([Function (p e c)]
g, (p e c
a, p e c
divisor))
polynomialReduce ::
(Polynomial p e c, Num (p e c), Fractional c) =>
(p e c -> p e c) ->
p e c ->
(p e c, p e c)
polynomialReduce :: forall (p :: * -> * -> *) e c.
(Polynomial p e c, Num (p e c), Fractional c) =>
(p e c -> p e c) -> p e c -> (p e c, p e c)
polynomialReduce p e c -> p e c
derivation p e c
p
| e
delta e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
0 = (p e c
0, p e c
p)
| p e c -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree p e c
p e -> e -> Bool
forall a. Ord a => a -> a -> Bool
< e
delta = (p e c
0, p e c
p)
| Bool
otherwise = (p e c
q0 p e c -> p e c -> p e c
forall a. Num a => a -> a -> a
+ p e c
q, p e c
r)
where
delta :: e
delta = p e c -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree (p e c -> e) -> p e c -> e
forall a b. (a -> b) -> a -> b
$ p e c -> p e c
derivation (p e c -> p e c) -> p e c -> p e c
forall a b. (a -> b) -> a -> b
$ e -> p e c
forall (p :: * -> * -> *) e c. Polynomial p e c => e -> p e c
power e
1
lambda :: c
lambda = p e c -> c
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> c
leadingCoefficient (p e c -> c) -> p e c -> c
forall a b. (a -> b) -> a -> b
$ p e c -> p e c
derivation (p e c -> p e c) -> p e c -> p e c
forall a b. (a -> b) -> a -> b
$ e -> p e c
forall (p :: * -> * -> *) e c. Polynomial p e c => e -> p e c
power e
1
m :: e
m = p e c -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree p e c
p e -> e -> e
forall a. Num a => a -> a -> a
- e
delta e -> e -> e
forall a. Num a => a -> a -> a
+ e
1
q0 :: p e c
q0 = c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
Polynomial p e c =>
c -> p e c -> p e c
scale (p e c -> c
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> c
leadingCoefficient p e c
p c -> c -> c
forall a. Fractional a => a -> a -> a
/ (e -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral e
m c -> c -> c
forall a. Num a => a -> a -> a
* c
lambda)) (e -> p e c
forall (p :: * -> * -> *) e c. Polynomial p e c => e -> p e c
power e
m)
(p e c
q, p e c
r) = (p e c -> p e c) -> p e c -> (p e c, p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Num (p e c), Fractional c) =>
(p e c -> p e c) -> p e c -> (p e c, p e c)
polynomialReduce p e c -> p e c
derivation (p e c -> (p e c, p e c)) -> p e c -> (p e c, p e c)
forall a b. (a -> b) -> a -> b
$ p e c -> p e c
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> p e c
deleteLeadingTerm p e c
p p e c -> p e c -> p e c
forall a. Num a => a -> a -> a
- p e c -> p e c
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> p e c
deleteLeadingTerm (p e c -> p e c
derivation p e c
q0)
residueReduce ::
( Polynomial p e c,
Eq (p e c),
Num (p e c),
Polynomial p e (p e c),
Eq (p e (p e c)),
Num (p e (p e c)),
Polynomial p e (Function (p e c)),
Eq (p e (Function (p e c))),
Num (p e (Function (p e c))),
Eq c,
Fractional c
) =>
(p e c -> p e c) ->
Function (p e c) ->
Maybe ([(p e c, p e (p e c))], Bool)
residueReduce :: forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Polynomial p e (p e c),
Eq (p e (p e c)), Num (p e (p e c)),
Polynomial p e (Function (p e c)), Eq (p e (Function (p e c))),
Num (p e (Function (p e c))), Eq c, Fractional c) =>
(p e c -> p e c)
-> Function (p e c) -> Maybe ([(p e c, p e (p e c))], Bool)
residueReduce p e c -> p e c
derivation (Function p e c
e p e c
d) = do
let (p e c
_, p e c
a) = p e c
e p e c -> p e c -> (p e c, p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> (p e c, p e c)
`divide` p e c
d
let d' :: p e (Function (p e c))
d' = (c -> Function (p e c)) -> p e c -> p e (Function (p e c))
forall (p :: * -> * -> *) e c c'.
(Polynomial p e c, Polynomial p e c', Num (p e c), Num (p e c')) =>
(c -> c') -> p e c -> p e c'
mapCoefficients (\c
c -> p e c -> Function (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Num (p e c)) =>
p e c -> Function (p e c)
fromPolynomial (p e c -> Function (p e c)) -> p e c -> Function (p e c)
forall a b. (a -> b) -> a -> b
$ c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
Polynomial p e c =>
c -> p e c -> p e c
scale c
c p e c
1) p e c
d
let a' :: p e (Function (p e c))
a' = (c -> Function (p e c)) -> p e c -> p e (Function (p e c))
forall (p :: * -> * -> *) e c c'.
(Polynomial p e c, Polynomial p e c', Num (p e c), Num (p e c')) =>
(c -> c') -> p e c -> p e c'
mapCoefficients (\c
c -> p e c -> Function (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Num (p e c)) =>
p e c -> Function (p e c)
fromPolynomial (p e c -> Function (p e c)) -> p e c -> Function (p e c)
forall a b. (a -> b) -> a -> b
$ c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
Polynomial p e c =>
c -> p e c -> p e c
scale c
c p e c
1) p e c
a
let zd' :: p e (Function (p e c))
zd' = (c -> Function (p e c)) -> p e c -> p e (Function (p e c))
forall (p :: * -> * -> *) e c c'.
(Polynomial p e c, Polynomial p e c', Num (p e c), Num (p e c')) =>
(c -> c') -> p e c -> p e c'
mapCoefficients (\c
c -> p e c -> Function (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Num (p e c)) =>
p e c -> Function (p e c)
fromPolynomial (p e c -> Function (p e c)) -> p e c -> Function (p e c)
forall a b. (a -> b) -> a -> b
$ c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
Polynomial p e c =>
c -> p e c -> p e c
scale c
c (p e c -> p e c) -> p e c -> p e c
forall a b. (a -> b) -> a -> b
$ e -> p e c
forall (p :: * -> * -> *) e c. Polynomial p e c => e -> p e c
power e
1) (p e c -> p e c
derivation p e c
d)
let (Function (p e c)
r', [p e (Function (p e c))]
rs')
| p e c -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree (p e c -> p e c
derivation p e c
d) e -> e -> Bool
forall a. Ord a => a -> a -> Bool
<= p e c -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree p e c
d = p e (Function (p e c))
-> p e (Function (p e c))
-> (Function (p e c), [p e (Function (p e c))])
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Num e, Fractional c) =>
p e c -> p e c -> (c, [p e c])
subresultant p e (Function (p e c))
d' (p e (Function (p e c))
a' p e (Function (p e c))
-> p e (Function (p e c)) -> p e (Function (p e c))
forall a. Num a => a -> a -> a
- p e (Function (p e c))
zd')
| Bool
otherwise = p e (Function (p e c))
-> p e (Function (p e c))
-> (Function (p e c), [p e (Function (p e c))])
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Num e, Fractional c) =>
p e c -> p e c -> (c, [p e c])
subresultant (p e (Function (p e c))
a' p e (Function (p e c))
-> p e (Function (p e c)) -> p e (Function (p e c))
forall a. Num a => a -> a -> a
- p e (Function (p e c))
zd') p e (Function (p e c))
d'
p e c
r <- Function (p e c) -> Maybe (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
Function (p e c) -> Maybe (p e c)
toPolynomial Function (p e c)
r'
[p e (p e c)]
rs <- (p e (Function (p e c)) -> Maybe (p e (p e c)))
-> [p e (Function (p e c))] -> Maybe [p e (p e c)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Function (p e c) -> Maybe (p e c))
-> p e (Function (p e c)) -> Maybe (p e (p e c))
forall (p :: * -> * -> *) e c c' (m :: * -> *).
(Polynomial p e c, Polynomial p e c', Num (p e c), Num (p e c'),
Monad m) =>
(c -> m c') -> p e c -> m (p e c')
mapCoefficientsM Function (p e c) -> Maybe (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
Function (p e c) -> Maybe (p e c)
toPolynomial) [p e (Function (p e c))]
rs'
let kderiv :: p e c -> p e c
kderiv = Sum (p e c) -> p e c
forall a. Sum a -> a
getSum (Sum (p e c) -> p e c) -> (p e c -> Sum (p e c)) -> p e c -> p e c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> c -> Sum (p e c)) -> p e c -> Sum (p e c)
forall m. Monoid m => (e -> c -> m) -> p e c -> m
forall (p :: * -> * -> *) e c m.
(Polynomial p e c, Monoid m) =>
(e -> c -> m) -> p e c -> m
foldTerms (\e
ex c
c -> p e c -> Sum (p e c)
forall a. a -> Sum a
Sum (p e c -> Sum (p e c)) -> p e c -> Sum (p e c)
forall a b. (a -> b) -> a -> b
$ p e c -> p e c
derivation (c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
Polynomial p e c =>
c -> p e c -> p e c
scale c
c p e c
1) p e c -> p e c -> p e c
forall a. Num a => a -> a -> a
* e -> p e c
forall (p :: * -> * -> *) e c. Polynomial p e c => e -> p e c
power e
ex)
let factors :: [(p e c, p e c)]
factors = (p e c -> p e c) -> p e c -> [(p e c, p e c)]
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Eq c, Fractional c) =>
(p e c -> p e c) -> p e c -> [(p e c, p e c)]
splitSquarefreeFactor p e c -> p e c
kderiv p e c
r
let elementary :: Bool
elementary = ((p e c, p e c) -> Bool) -> [(p e c, p e c)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (e -> e -> Bool
forall a. Eq a => a -> a -> Bool
(==) e
0 (e -> Bool) -> ((p e c, p e c) -> e) -> (p e c, p e c) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p e c -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree (p e c -> e) -> ((p e c, p e c) -> p e c) -> (p e c, p e c) -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p e c, p e c) -> p e c
forall a b. (a, b) -> a
fst) [(p e c, p e c)]
factors
let specials :: [p e c]
specials = ((p e c, p e c) -> p e c) -> [(p e c, p e c)] -> [p e c]
forall a b. (a -> b) -> [a] -> [b]
map (p e c, p e c) -> p e c
forall a b. (a, b) -> b
snd [(p e c, p e c)]
factors
[(p e c, p e (p e c))]
terms' <- ((e, p e c) -> Maybe (p e c, p e (p e c)))
-> [(e, p e c)] -> Maybe [(p e c, p e (p e c))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([p e (p e c)]
-> [p e c] -> (e, p e c) -> Maybe (p e c, p e (p e c))
forall {t :: * -> *} {p :: * -> * -> *} {e} {c}.
(Foldable t, Polynomial p e c, Fractional c, Eq c) =>
t (p e (p e c))
-> [p e c] -> (e, p e c) -> Maybe (p e c, p e (p e c))
toTerm [p e (p e c)]
rs [p e c]
specials) ([(e, p e c)] -> Maybe [(p e c, p e (p e c))])
-> [(e, p e c)] -> Maybe [(p e c, p e (p e c))]
forall a b. (a -> b) -> a -> b
$ [e] -> [p e c] -> [(e, p e c)]
forall a b. [a] -> [b] -> [(a, b)]
zip [e
1 ..] [p e c]
specials
let terms :: [(p e c, p e (p e c))]
terms = ((p e c, p e (p e c)) -> Bool)
-> [(p e c, p e (p e c))] -> [(p e c, p e (p e c))]
forall a. (a -> Bool) -> [a] -> [a]
filter ((p e (p e c) -> p e (p e c) -> Bool
forall a. Eq a => a -> a -> Bool
/= p e (p e c)
1) (p e (p e c) -> Bool)
-> ((p e c, p e (p e c)) -> p e (p e c))
-> (p e c, p e (p e c))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p e c, p e (p e c)) -> p e (p e c)
forall a b. (a, b) -> b
snd) [(p e c, p e (p e c))]
terms'
([(p e c, p e (p e c))], Bool)
-> Maybe ([(p e c, p e (p e c))], Bool)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(p e c, p e (p e c))]
terms, Bool
elementary)
where
toTerm :: t (p e (p e c))
-> [p e c] -> (e, p e c) -> Maybe (p e c, p e (p e c))
toTerm t (p e (p e c))
prs [p e c]
specials (e
i, p e c
s)
| p e c -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree p e c
s e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
0 = (p e c, p e (p e c)) -> Maybe (p e c, p e (p e c))
forall a. a -> Maybe a
Just (p e c -> p e c
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq c, Fractional c) =>
p e c -> p e c
monic p e c
s, p e (p e c)
1)
| p e c -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree p e c
d e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
i = (p e c, p e (p e c)) -> Maybe (p e c, p e (p e c))
forall a. a -> Maybe a
Just (p e c -> p e c
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq c, Fractional c) =>
p e c -> p e c
monic p e c
s, (c -> p e c) -> p e c -> p e (p e c)
forall (p :: * -> * -> *) e c c'.
(Polynomial p e c, Polynomial p e c', Num (p e c), Num (p e c')) =>
(c -> c') -> p e c -> p e c'
mapCoefficients (c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
Polynomial p e c =>
c -> p e c -> p e c
`scale` p e c
1) p e c
d)
| Just p e (p e c)
pr <- (p e (p e c) -> Bool) -> t (p e (p e c)) -> Maybe (p e (p e c))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (e -> e -> Bool
forall a. Eq a => a -> a -> Bool
(==) e
i (e -> Bool) -> (p e (p e c) -> e) -> p e (p e c) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p e (p e c) -> e
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> e
degree) t (p e (p e c))
prs = p e c -> p e (p e c) -> [p e c] -> Maybe (p e c, p e (p e c))
forall {p :: * -> * -> *} {e} {c} {p :: * -> * -> *} {e} {c}.
(Polynomial p e c, Polynomial p e c, Polynomial p e (p e c),
Polynomial p e (Function (p e c)), Fractional c, Fractional c,
Eq c, Eq c, Eq (p e c), Eq (p e (Function (p e c))),
Num (p e (p e c)), Num (p e (Function (p e c)))) =>
p e c -> p e (p e c) -> [p e c] -> Maybe (p e c, p e (p e c))
derive p e c
s p e (p e c)
pr [p e c]
specials
| Bool
otherwise = Maybe (p e c, p e (p e c))
forall a. Maybe a
Nothing
derive :: p e c -> p e (p e c) -> [p e c] -> Maybe (p e c, p e (p e c))
derive p e c
s p e (p e c)
pr [p e c]
specials = do
let pr' :: p e (Function (p e c))
pr' = (p e c -> Function (p e c))
-> p e (p e c) -> p e (Function (p e c))
forall (p :: * -> * -> *) e c c'.
(Polynomial p e c, Polynomial p e c', Num (p e c), Num (p e c')) =>
(c -> c') -> p e c -> p e c'
mapCoefficients p e c -> Function (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Num (p e c)) =>
p e c -> Function (p e c)
fromPolynomial (p e (p e c) -> p e (Function (p e c)))
-> p e (p e c) -> p e (Function (p e c))
forall a b. (a -> b) -> a -> b
$ p e (p e c) -> p e (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e (p e c), Polynomial p e c, Num (p e (p e c))) =>
p e (p e c) -> p e (p e c)
switchVars p e (p e c)
pr
let (p e (Function (p e c))
logArg', p e (Function (p e c))
_) = p e (Function (p e c))
pr' p e (Function (p e c))
-> p e (Function (p e c))
-> (p e (Function (p e c)), p e (Function (p e c)))
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> (p e c, p e c)
`divide` p e (Function (p e c))
divisor
p e (p e c)
logArg <- (Function (p e c) -> Maybe (p e c))
-> p e (Function (p e c)) -> Maybe (p e (p e c))
forall (p :: * -> * -> *) e c c' (m :: * -> *).
(Polynomial p e c, Polynomial p e c', Num (p e c), Num (p e c'),
Monad m) =>
(c -> m c') -> p e c -> m (p e c')
mapCoefficientsM Function (p e c) -> Maybe (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
Function (p e c) -> Maybe (p e c)
toPolynomial p e (Function (p e c))
logArg'
(p e c, p e (p e c)) -> Maybe (p e c, p e (p e c))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (p e c -> p e c
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq c, Fractional c) =>
p e c -> p e c
monic p e c
s, p e (p e c) -> p e (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e (p e c), Polynomial p e c, Num (p e (p e c))) =>
p e (p e c) -> p e (p e c)
switchVars p e (p e c)
logArg)
where
factors :: [p e c]
factors = p e c -> [p e c]
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Eq c, Fractional c) =>
p e c -> [p e c]
squarefree (p e c -> [p e c]) -> p e c -> [p e c]
forall a b. (a -> b) -> a -> b
$ p e (p e c) -> p e c
forall (p :: * -> * -> *) e c. Polynomial p e c => p e c -> c
leadingCoefficient p e (p e c)
pr
divisor :: p e (Function (p e c))
divisor = (c -> Function (p e c)) -> p e c -> p e (Function (p e c))
forall (p :: * -> * -> *) e c c'.
(Polynomial p e c, Polynomial p e c', Num (p e c), Num (p e c')) =>
(c -> c') -> p e c -> p e c'
mapCoefficients (p e c -> Function (p e c)
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Num (p e c)) =>
p e c -> Function (p e c)
fromPolynomial (p e c -> Function (p e c))
-> (c -> p e c) -> c -> Function (p e c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> p e c -> p e c) -> p e c -> c -> p e c
forall a b c. (a -> b -> c) -> b -> a -> c
flip c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
Polynomial p e c =>
c -> p e c -> p e c
scale p e c
1) p e c
divisor'
where
divisor' :: p e c
divisor' = [p e c] -> p e c
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([p e c] -> p e c) -> [p e c] -> p e c
forall a b. (a -> b) -> a -> b
$ ((Int, p e c, p e c) -> p e c) -> [(Int, p e c, p e c)] -> [p e c]
forall a b. (a -> b) -> [a] -> [b]
map (Int, p e c, p e c) -> p e c
forall {p :: * -> * -> *} {e} {c}.
(Polynomial p e c, Fractional c, Eq (p e c), Num (p e c)) =>
(Int, p e c, p e c) -> p e c
toDivisor ([(Int, p e c, p e c)] -> [p e c])
-> [(Int, p e c, p e c)] -> [p e c]
forall a b. (a -> b) -> a -> b
$ [Int] -> [p e c] -> [p e c] -> [(Int, p e c, p e c)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
1 ..] [p e c]
factors [p e c]
specials
toDivisor :: (Int, p e c, p e c) -> p e c
toDivisor (Int
j, p e c
factor, p e c
special) = p e c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
(Polynomial p e c, Eq (p e c), Num (p e c), Fractional c) =>
p e c -> p e c -> p e c
greatestCommonDivisor p e c
factor p e c
special p e c -> Int -> p e c
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
j :: Int)
switchVars ::
(Polynomial p e (p e c), Polynomial p e c, Num (p e (p e c))) =>
p e (p e c) ->
p e (p e c)
switchVars :: forall (p :: * -> * -> *) e c.
(Polynomial p e (p e c), Polynomial p e c, Num (p e (p e c))) =>
p e (p e c) -> p e (p e c)
switchVars p e (p e c)
p = Sum (p e (p e c)) -> p e (p e c)
forall a. Sum a -> a
getSum (Sum (p e (p e c)) -> p e (p e c))
-> Sum (p e (p e c)) -> p e (p e c)
forall a b. (a -> b) -> a -> b
$ (e -> p e c -> Sum (p e (p e c)))
-> p e (p e c) -> Sum (p e (p e c))
forall m. Monoid m => (e -> p e c -> m) -> p e (p e c) -> m
forall (p :: * -> * -> *) e c m.
(Polynomial p e c, Monoid m) =>
(e -> c -> m) -> p e c -> m
foldTerms (\e
e p e c
c -> p e (p e c) -> Sum (p e (p e c))
forall a. a -> Sum a
Sum (p e (p e c) -> Sum (p e (p e c)))
-> p e (p e c) -> Sum (p e (p e c))
forall a b. (a -> b) -> a -> b
$ (c -> p e c) -> p e c -> p e (p e c)
forall (p :: * -> * -> *) e c c'.
(Polynomial p e c, Polynomial p e c', Num (p e c), Num (p e c')) =>
(c -> c') -> p e c -> p e c'
mapCoefficients (\c
c' -> c -> p e c -> p e c
forall (p :: * -> * -> *) e c.
Polynomial p e c =>
c -> p e c -> p e c
scale c
c' (p e c -> p e c) -> p e c -> p e c
forall a b. (a -> b) -> a -> b
$ e -> p e c
forall (p :: * -> * -> *) e c. Polynomial p e c => e -> p e c
power e
e) p e c
c) p e (p e c)
p