{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module MathObj.MultiVarPolynomial
(
T(..)
, fromMonomials
, lift0
, lift1
, lift2
, x
, constant
, compose
, merge
) where
import qualified Algebra.Additive as Additive
import qualified Algebra.Ring as Ring
import qualified Algebra.ZeroTestable as ZeroTestable
import qualified Algebra.Differential as Differential
import qualified MathObj.Monomial as Mon
import qualified Data.Map as M
import NumericPrelude
newtype T a = Cons [Mon.T a]
instance (ZeroTestable.C a, Ring.C a, Ord a, Show a) => Show (T a) where
show :: T a -> String
show (Cons []) = String
"0"
show (Cons (T a
m:[T a]
ms)) = T a -> String
forall a. Show a => a -> String
show T a
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ (T a -> String) -> [T a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap T a -> String
forall a. (Ord a, C a, C a, Show a) => T a -> String
showMon [T a]
ms
where showMon :: T a -> String
showMon T a
m | T a -> a
forall a. T a -> a
Mon.coeff T a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
forall a. C a => a
zero = String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ T a -> String
forall a. Show a => a -> String
show (T a -> T a
forall a. C a => a -> a
negate T a
m)
| Bool
otherwise = String
" + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ T a -> String
forall a. Show a => a -> String
show T a
m
{-# INLINE fromMonomials #-}
fromMonomials :: [Mon.T a] -> T a
fromMonomials :: [T a] -> T a
fromMonomials = [T a] -> T a
forall a. [T a] -> T a
lift0
{-# INLINE lift0 #-}
lift0 :: [Mon.T a] -> T a
lift0 :: [T a] -> T a
lift0 = [T a] -> T a
forall a. [T a] -> T a
Cons
{-# INLINE lift1 #-}
lift1 :: ([Mon.T a] -> [Mon.T a]) -> (T a -> T a)
lift1 :: ([T a] -> [T a]) -> T a -> T a
lift1 [T a] -> [T a]
f (Cons [T a]
xs) = [T a] -> T a
forall a. [T a] -> T a
Cons ([T a] -> [T a]
f [T a]
xs)
{-# INLINE lift2 #-}
lift2 :: ([Mon.T a] -> [Mon.T a] -> [Mon.T a]) -> (T a -> T a -> T a)
lift2 :: ([T a] -> [T a] -> [T a]) -> T a -> T a -> T a
lift2 [T a] -> [T a] -> [T a]
f (Cons [T a]
xs) (Cons [T a]
ys) = [T a] -> T a
forall a. [T a] -> T a
Cons ([T a] -> [T a] -> [T a]
f [T a]
xs [T a]
ys)
x :: (Ring.C a) => Integer -> T a
x :: Integer -> T a
x Integer
n = [T a] -> T a
forall a. [T a] -> T a
fromMonomials [Integer -> T a
forall a. C a => Integer -> T a
Mon.x Integer
n]
constant :: a -> T a
constant :: a -> T a
constant a
a = [T a] -> T a
forall a. [T a] -> T a
fromMonomials [a -> T a
forall a. a -> T a
Mon.constant a
a]
add :: (Ord a, Additive.C a) => [a] -> [a] -> [a]
add :: [a] -> [a] -> [a]
add [a]
xs [a]
ys = Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
forall a. Ord a => Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
merge Bool
True a -> a -> a
forall a. C a => a -> a -> a
(+) [a]
xs [a]
ys
merge :: Ord a => Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
merge :: Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
merge Bool
True a -> a -> a
_ [] [a]
ys = [a]
ys
merge Bool
False a -> a -> a
_ [] [a]
_ = []
merge Bool
True a -> a -> a
_ [a]
xs [] = [a]
xs
merge Bool
False a -> a -> a
_ [a]
_ [] = []
merge Bool
b a -> a -> a
f xxs :: [a]
xxs@(a
x:[a]
xs) yys :: [a]
yys@(a
y:[a]
ys) | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = Bool -> ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall p. Bool -> p -> p -> p
if' Bool
b (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [a] -> [a]
forall a. a -> a
id ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
forall a. Ord a => Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
merge Bool
b a -> a -> a
f [a]
xs [a]
yys
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = Bool -> ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall p. Bool -> p -> p -> p
if' Bool
b (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [a] -> [a]
forall a. a -> a
id ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
forall a. Ord a => Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
merge Bool
b a -> a -> a
f [a]
xxs [a]
ys
| Bool
otherwise = a -> a -> a
f a
x a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
forall a. Ord a => Bool -> (a -> a -> a) -> [a] -> [a] -> [a]
merge Bool
b a -> a -> a
f [a]
xs [a]
ys
where if' :: Bool -> p -> p -> p
if' Bool
True p
x p
_ = p
x
if' Bool
False p
_ p
y = p
y
instance (Additive.C a, ZeroTestable.C a) => Additive.C (T a) where
zero :: T a
zero = [T a] -> T a
forall a. [T a] -> T a
fromMonomials []
negate :: T a -> T a
negate = ([T a] -> [T a]) -> T a -> T a
forall a. ([T a] -> [T a]) -> T a -> T a
lift1 (([T a] -> [T a]) -> T a -> T a) -> ([T a] -> [T a]) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ (T a -> T a) -> [T a] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
map T a -> T a
forall a. C a => a -> a
negate
+ :: T a -> T a -> T a
(+) = ([T a] -> [T a] -> [T a]) -> T a -> T a -> T a
forall a. ([T a] -> [T a] -> [T a]) -> T a -> T a -> T a
lift2 [T a] -> [T a] -> [T a]
forall a. (Ord a, C a) => [a] -> [a] -> [a]
add
mul :: (Ring.C a, Ord a) => [a] -> [a] -> [a]
mul :: [a] -> [a] -> [a]
mul [] [a]
_ = []
mul [a]
_ [] = []
mul (a
x:[a]
xs) (a
y:[a]
ys) = a
xa -> a -> a
forall a. C a => a -> a -> a
*a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. (Ord a, C a) => [a] -> [a] -> [a]
add ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> a -> a
forall a. C a => a -> a -> a
*) [a]
ys) ([a] -> [a] -> [a]
forall a. (C a, Ord a) => [a] -> [a] -> [a]
mul [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys))
instance (Ring.C a, ZeroTestable.C a) => Ring.C (T a) where
fromInteger :: Integer -> T a
fromInteger Integer
n = [T a] -> T a
forall a. [T a] -> T a
fromMonomials [Integer -> T a
forall a. C a => Integer -> a
fromInteger Integer
n]
* :: T a -> T a -> T a
(*) = ([T a] -> [T a] -> [T a]) -> T a -> T a -> T a
forall a. ([T a] -> [T a] -> [T a]) -> T a -> T a -> T a
lift2 [T a] -> [T a] -> [T a]
forall a. (C a, Ord a) => [a] -> [a] -> [a]
mul
instance (ZeroTestable.C a, Ring.C a) => Differential.C (T a) where
differentiate :: T a -> T a
differentiate = ([T a] -> [T a]) -> T a -> T a
forall a. ([T a] -> [T a]) -> T a -> T a
lift1 (([T a] -> [T a]) -> T a -> T a) -> ([T a] -> [T a]) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ (T a -> Bool) -> [T a] -> [T a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (T a -> Bool) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> Bool
forall a. C a => a -> Bool
isZero) ([T a] -> [T a]) -> ([T a] -> [T a]) -> [T a] -> [T a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a -> T a) -> [T a] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
map T a -> T a
forall a. C a => a -> a
Differential.differentiate
compose :: (Ring.C a, ZeroTestable.C a) => T a -> T a -> T a
compose :: T a -> T a -> T a
compose (Cons []) T a
_ = [T a] -> T a
forall a. [T a] -> T a
Cons []
compose (Cons (T a
x:[T a]
_)) (Cons []) = [T a] -> T a
forall a. [T a] -> T a
Cons [T a
x]
compose (Cons [T a]
xs) yys :: T a
yys@(Cons (T a
y:[T a]
_))
| T a -> Integer
forall a. T a -> Integer
Mon.degree T a
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (T a -> Bool) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
forall a. C a => a -> Bool
isZero (a -> Bool) -> (T a -> a) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> a
forall a. T a -> a
Mon.coeff (T a -> Bool) -> T a -> Bool
forall a b. (a -> b) -> a -> b
$ T a
y)
= String -> T a
forall a. HasCallStack => String -> a
error (String -> T a) -> String -> T a
forall a b. (a -> b) -> a -> b
$ String
"MultiVarPolynomial.compose: inner series must not have a constant term."
| Bool
otherwise = [T a] -> T a -> T a
forall a. (C a, C a) => [T a] -> T a -> T a
comp [T a]
xs T a
yys
comp :: (Ring.C a, ZeroTestable.C a) => [Mon.T a] -> T a -> T a
comp :: [T a] -> T a -> T a
comp [T a]
ms T a
p = T a -> [T a] -> T a
comp' T a
forall a. C a => a
zero [T a]
ms
where
comp' :: T a -> [T a] -> T a
comp' T a
part [] = T a
part
comp' T a
part (T a
m:[T a]
ms) = ([T a] -> [T a] -> [T a]) -> T a -> T a -> T a
forall a. ([T a] -> [T a] -> [T a]) -> T a -> T a -> T a
lift2 [T a] -> [T a] -> [T a]
forall a. [a] -> [a] -> [a]
(++) T a
done (T a -> T a) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ T a -> [T a] -> T a
comp' (T a
rest T a -> T a -> T a
forall a. C a => a -> a -> a
+ T a -> T a -> T a
forall a. (C a, C a) => T a -> T a -> T a
substMon T a
p T a
m) [T a]
ms
where (T a
done,T a
rest) = (T a -> Bool) -> T a -> (T a, T a)
forall a. (T a -> Bool) -> T a -> (T a, T a)
splitPoly ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< T a -> Integer
forall a. T a -> Integer
Mon.pDegree T a
m) (Integer -> Bool) -> (T a -> Integer) -> T a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> Integer
forall a. T a -> Integer
Mon.pDegree) T a
part
substMon :: (ZeroTestable.C a, Ring.C a) => T a -> Mon.T a -> T a
substMon :: T a -> T a -> T a
substMon T a
poly T a
m
= (a -> T a
forall a. a -> T a
constant (T a -> a
forall a. T a -> a
Mon.coeff T a
m) T a -> T a -> T a
forall a. C a => a -> a -> a
*)
(T a -> T a)
-> (Map Integer Integer -> T a) -> Map Integer Integer -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> T a -> T a)
-> T a -> Map Integer Integer -> T a
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\Integer
sub Integer
pow -> T a -> T a -> T a
forall a. C a => a -> a -> a
(*) (Integer -> T a -> T a
forall a. Integer -> T a -> T a
scalePoly Integer
sub T a
poly T a -> Integer -> T a
forall a. C a => a -> Integer -> a
^Integer
pow)) T a
forall a. C a => a
one
(Map Integer Integer -> T a) -> Map Integer Integer -> T a
forall a b. (a -> b) -> a -> b
$ T a -> Map Integer Integer
forall a. T a -> Map Integer Integer
Mon.powers T a
m
scalePoly :: Integer -> T a -> T a
scalePoly :: Integer -> T a -> T a
scalePoly Integer
n = ([T a] -> [T a]) -> T a -> T a
forall a. ([T a] -> [T a]) -> T a -> T a
lift1 (([T a] -> [T a]) -> T a -> T a) -> ([T a] -> [T a]) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ (T a -> T a) -> [T a] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> T a -> T a
forall a. Integer -> T a -> T a
Mon.scaleMon Integer
n)
splitPoly :: (Mon.T a -> Bool) -> T a -> (T a, T a)
splitPoly :: (T a -> Bool) -> T a -> (T a, T a)
splitPoly T a -> Bool
p (Cons [T a]
xs) = ([T a] -> T a
forall a. [T a] -> T a
Cons [T a]
ys, [T a] -> T a
forall a. [T a] -> T a
Cons [T a]
zs)
where ([T a]
ys, [T a]
zs) = (T a -> Bool) -> [T a] -> ([T a], [T a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span T a -> Bool
p [T a]
xs