{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module MathObj.Polynomial
(T, fromCoeffs, coeffs, degree,
showsExpressionPrec, const,
evaluate, evaluateCoeffVector, evaluateArgVector,
collinear,
integrate,
compose, fromRoots, reverse,
translate, dilate, shrink, )
where
import qualified MathObj.Polynomial.Core as Core
import qualified Algebra.Differential as Differential
import qualified Algebra.VectorSpace as VectorSpace
import qualified Algebra.Module as Module
import qualified Algebra.Vector as Vector
import qualified Algebra.Field as Field
import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Units as Units
import qualified Algebra.IntegralDomain as Integral
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Algebra.ZeroTestable as ZeroTestable
import qualified Algebra.Indexable as Indexable
import Control.Monad (liftM, )
import qualified Data.List as List
import Test.QuickCheck (Arbitrary(arbitrary))
import qualified MathObj.Wrapper.Haskell98 as W98
import NumericPrelude.Base hiding (const, reverse, )
import NumericPrelude.Numeric
import qualified Prelude as P98
newtype T a = Cons {T a -> [a]
coeffs :: [a]}
{-# INLINE fromCoeffs #-}
fromCoeffs :: [a] -> T a
fromCoeffs :: [a] -> T a
fromCoeffs = [a] -> T a
forall a. [a] -> T a
lift0
{-# INLINE lift0 #-}
lift0 :: [a] -> T a
lift0 :: [a] -> T a
lift0 = [a] -> T a
forall a. [a] -> T a
Cons
{-# INLINE lift1 #-}
lift1 :: ([a] -> [a]) -> (T a -> T a)
lift1 :: ([a] -> [a]) -> T a -> T a
lift1 [a] -> [a]
f (Cons [a]
x0) = [a] -> T a
forall a. [a] -> T a
Cons ([a] -> [a]
f [a]
x0)
{-# INLINE lift2 #-}
lift2 :: ([a] -> [a] -> [a]) -> (T a -> T a -> T a)
lift2 :: ([a] -> [a] -> [a]) -> T a -> T a -> T a
lift2 [a] -> [a] -> [a]
f (Cons [a]
x0) (Cons [a]
x1) = [a] -> T a
forall a. [a] -> T a
Cons ([a] -> [a] -> [a]
f [a]
x0 [a]
x1)
degree :: (ZeroTestable.C a) => T a -> Maybe Int
degree :: T a -> Maybe Int
degree T a
x =
case [a] -> [a]
forall a. C a => [a] -> [a]
Core.normalize (T a -> [a]
forall a. T a -> [a]
coeffs T a
x) of
[] -> Maybe Int
forall a. Maybe a
Nothing
(a
_:[a]
xs) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
instance Functor T where
fmap :: (a -> b) -> T a -> T b
fmap a -> b
f (Cons [a]
xs) = [b] -> T b
forall a. [a] -> T a
Cons ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
{-# INLINE plusPrec #-}
{-# INLINE appPrec #-}
plusPrec, appPrec :: Int
plusPrec :: Int
plusPrec = Int
6
appPrec :: Int
appPrec = Int
10
instance (Show a) => Show (T a) where
showsPrec :: Int -> T a -> ShowS
showsPrec Int
p (Cons [a]
xs) =
Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec) (String -> ShowS
showString String
"Polynomial.fromCoeffs " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows [a]
xs)
{-# INLINE showsExpressionPrec #-}
showsExpressionPrec :: (Show a, ZeroTestable.C a, Additive.C a) =>
Int -> String -> T a -> String -> String
showsExpressionPrec :: Int -> String -> T a -> ShowS
showsExpressionPrec Int
p String
var T a
poly =
if T a -> Bool
forall a. C a => a -> Bool
isZero T a
poly
then String -> ShowS
showString String
"0"
else
let terms :: [(a, ShowS)]
terms = ((a, ShowS) -> Bool) -> [(a, ShowS)] -> [(a, ShowS)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((a, ShowS) -> Bool) -> (a, ShowS) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
forall a. C a => a -> Bool
isZero (a -> Bool) -> ((a, ShowS) -> a) -> (a, ShowS) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, ShowS) -> a
forall a b. (a, b) -> a
fst)
([a] -> [ShowS] -> [(a, ShowS)]
forall a b. [a] -> [b] -> [(a, b)]
zip (T a -> [a]
forall a. T a -> [a]
coeffs T a
poly) [ShowS]
monomials)
monomials :: [ShowS]
monomials = ShowS
forall a. a -> a
id ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
:
String -> ShowS
showString String
"*" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
var ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
:
(Int -> ShowS) -> [Int] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
k -> String -> ShowS
showString String
"*" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
var
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"^" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
k)
[(Int
2::Int)..]
showsTerm :: a -> (a -> String) -> a -> String
showsTerm a
x a -> String
showsMon = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
plusPrecInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
1) a
x ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
showsMon
in Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
plusPrec)
((ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id ([ShowS] -> ShowS) -> [ShowS] -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
List.intersperse (String -> ShowS
showString String
" + ") ([ShowS] -> [ShowS]) -> [ShowS] -> [ShowS]
forall a b. (a -> b) -> a -> b
$
((a, ShowS) -> ShowS) -> [(a, ShowS)] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> ShowS -> ShowS) -> (a, ShowS) -> ShowS
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> ShowS -> ShowS
forall a a. Show a => a -> (a -> String) -> a -> String
showsTerm) [(a, ShowS)]
terms)
{-# INLINE evaluate #-}
evaluate :: Ring.C a => T a -> a -> a
evaluate :: T a -> a -> a
evaluate (Cons [a]
y) a
x = a -> [a] -> a
forall a. C a => a -> [a] -> a
Core.horner a
x [a]
y
{-# INLINE evaluateCoeffVector #-}
evaluateCoeffVector :: Module.C a v => T v -> a -> v
evaluateCoeffVector :: T v -> a -> v
evaluateCoeffVector (Cons [v]
y) a
x = a -> [v] -> v
forall a v. C a v => a -> [v] -> v
Core.hornerCoeffVector a
x [v]
y
{-# INLINE evaluateArgVector #-}
evaluateArgVector :: (Module.C a v, Ring.C v) => T a -> v -> v
evaluateArgVector :: T a -> v -> v
evaluateArgVector (Cons [a]
y) v
x = v -> [a] -> v
forall a v. (C a v, C v) => v -> [a] -> v
Core.hornerArgVector v
x [a]
y
{-# INLINE compose #-}
compose :: (Ring.C a) => T a -> T a -> T a
compose :: T a -> T a -> T a
compose (Cons [a]
x) T a
y = T a -> [T a] -> T a
forall a. C a => a -> [a] -> a
Core.horner T a
y ((a -> T a) -> [a] -> [T a]
forall a b. (a -> b) -> [a] -> [b]
map a -> T a
forall a. a -> T a
const [a]
x)
{-# INLINE const #-}
const :: a -> T a
const :: a -> T a
const a
x = [a] -> T a
forall a. [a] -> T a
lift0 [a
x]
collinear :: (Eq a, Ring.C a) => T a -> T a -> Bool
collinear :: T a -> T a -> Bool
collinear (Cons [a]
x) (Cons [a]
y) = [a] -> [a] -> Bool
forall a. (Eq a, C a) => [a] -> [a] -> Bool
Core.collinear [a]
x [a]
y
instance (Eq a, ZeroTestable.C a) => Eq (T a) where
(Cons [a]
x) == :: T a -> T a -> Bool
== (Cons [a]
y) = [a] -> [a] -> Bool
forall a. (Eq a, C a) => [a] -> [a] -> Bool
Core.equal [a]
x [a]
y
instance (Indexable.C a, ZeroTestable.C a) => Indexable.C (T a) where
compare :: T a -> T a -> Ordering
compare = (T a -> [a]) -> T a -> T a -> Ordering
forall b a. C b => (a -> b) -> a -> a -> Ordering
Indexable.liftCompare T a -> [a]
forall a. T a -> [a]
coeffs
instance (ZeroTestable.C a) => ZeroTestable.C (T a) where
isZero :: T a -> Bool
isZero (Cons [a]
x) = [a] -> Bool
forall a. C a => a -> Bool
isZero [a]
x
instance (Additive.C a) => Additive.C (T a) where
+ :: T a -> T a -> T a
(+) = ([a] -> [a] -> [a]) -> T a -> T a -> T a
forall a. ([a] -> [a] -> [a]) -> T a -> T a -> T a
lift2 [a] -> [a] -> [a]
forall a. C a => [a] -> [a] -> [a]
Core.add
(-) = ([a] -> [a] -> [a]) -> T a -> T a -> T a
forall a. ([a] -> [a] -> [a]) -> T a -> T a -> T a
lift2 [a] -> [a] -> [a]
forall a. C a => [a] -> [a] -> [a]
Core.sub
zero :: T a
zero = [a] -> T a
forall a. [a] -> T a
lift0 []
negate :: T a -> T a
negate = ([a] -> [a]) -> T a -> T a
forall a. ([a] -> [a]) -> T a -> T a
lift1 [a] -> [a]
forall a. C a => [a] -> [a]
Core.negate
instance Vector.C T where
zero :: T a
zero = T a
forall a. C a => a
zero
<+> :: T a -> T a -> T a
(<+>) = T a -> T a -> T a
forall a. C a => a -> a -> a
(+)
*> :: a -> T a -> T a
(*>) = a -> T a -> T a
forall (v :: * -> *) a. (Functor v, C a) => a -> v a -> v a
Vector.functorScale
instance (Module.C a b) => Module.C a (T b) where
*> :: a -> T b -> T b
(*>) a
x = ([b] -> [b]) -> T b -> T b
forall a. ([a] -> [a]) -> T a -> T a
lift1 (a
x a -> [b] -> [b]
forall a v. C a v => a -> v -> v
*>)
instance (Field.C a, Module.C a b) => VectorSpace.C a (T b)
instance (Ring.C a) => Ring.C (T a) where
one :: T a
one = a -> T a
forall a. a -> T a
const a
forall a. C a => a
one
fromInteger :: Integer -> T a
fromInteger = a -> T a
forall a. a -> T a
const (a -> T a) -> (Integer -> a) -> Integer -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. C a => Integer -> a
fromInteger
* :: T a -> T a -> T a
(*) = ([a] -> [a] -> [a]) -> T a -> T a -> T a
forall a. ([a] -> [a] -> [a]) -> T a -> T a -> T a
lift2 [a] -> [a] -> [a]
forall a. C a => [a] -> [a] -> [a]
Core.mul
instance (ZeroTestable.C a, Field.C a) => Integral.C (T a) where
divMod :: T a -> T a -> (T a, T a)
divMod (Cons [a]
x) (Cons [a]
y) =
let ([a]
d,[a]
m) = [a] -> [a] -> ([a], [a])
forall a. (C a, C a) => [a] -> [a] -> ([a], [a])
Core.divMod [a]
x [a]
y
in ([a] -> T a
forall a. [a] -> T a
Cons [a]
d, [a] -> T a
forall a. [a] -> T a
Cons [a]
m)
instance (ZeroTestable.C a, Field.C a) => Units.C (T a) where
isUnit :: T a -> Bool
isUnit (Cons []) = Bool
False
isUnit (Cons (a
x0:[a]
xs)) = Bool -> Bool
not (a -> Bool
forall a. C a => a -> Bool
isZero a
x0) Bool -> Bool -> Bool
&& (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
forall a. C a => a -> Bool
isZero [a]
xs
stdUnit :: T a -> T a
stdUnit (Cons [a]
x) = a -> T a
forall a. a -> T a
const ([a] -> a
forall a. (C a, C a) => [a] -> a
Core.stdUnit [a]
x)
stdUnitInv :: T a -> T a
stdUnitInv (Cons [a]
x) = a -> T a
forall a. a -> T a
const (a -> a
forall a. C a => a -> a
recip ([a] -> a
forall a. (C a, C a) => [a] -> a
Core.stdUnit [a]
x))
instance (ZeroTestable.C a, Field.C a) => PID.C (T a)
instance (Ring.C a) => Differential.C (T a) where
differentiate :: T a -> T a
differentiate = ([a] -> [a]) -> T a -> T a
forall a. ([a] -> [a]) -> T a -> T a
lift1 [a] -> [a]
forall a. C a => [a] -> [a]
Core.differentiate
{-# INLINE integrate #-}
integrate :: (Field.C a) => a -> T a -> T a
integrate :: a -> T a -> T a
integrate = ([a] -> [a]) -> T a -> T a
forall a. ([a] -> [a]) -> T a -> T a
lift1 (([a] -> [a]) -> T a -> T a)
-> (a -> [a] -> [a]) -> a -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> [a]
forall a. C a => a -> [a] -> [a]
Core.integrate
{-# INLINE fromRoots #-}
fromRoots :: (Ring.C a) => [a] -> T a
fromRoots :: [a] -> T a
fromRoots = [a] -> T a
forall a. [a] -> T a
Cons ([a] -> T a) -> ([a] -> [a]) -> [a] -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> [a] -> [a]
forall a. C a => a -> [a] -> [a]
Core.mulLinearFactor) [a
forall a. C a => a
one]
{-# INLINE reverse #-}
reverse :: Additive.C a => T a -> T a
reverse :: T a -> T a
reverse = ([a] -> [a]) -> T a -> T a
forall a. ([a] -> [a]) -> T a -> T a
lift1 [a] -> [a]
forall a. C a => [a] -> [a]
Core.alternate
translate :: Ring.C a => a -> T a -> T a
translate :: a -> T a -> T a
translate a
d =
([a] -> [a]) -> T a -> T a
forall a. ([a] -> [a]) -> T a -> T a
lift1 (([a] -> [a]) -> T a -> T a) -> ([a] -> [a]) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
c [a]
p -> [a
c] [a] -> [a] -> [a]
forall a. C a => a -> a -> a
+ a -> [a] -> [a]
forall a. C a => a -> [a] -> [a]
Core.mulLinearFactor a
d [a]
p) []
shrink :: Ring.C a => a -> T a -> T a
shrink :: a -> T a -> T a
shrink = ([a] -> [a]) -> T a -> T a
forall a. ([a] -> [a]) -> T a -> T a
lift1 (([a] -> [a]) -> T a -> T a)
-> (a -> [a] -> [a]) -> a -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> [a]
forall a. C a => a -> [a] -> [a]
Core.shrink
dilate :: Field.C a => a -> T a -> T a
dilate :: a -> T a -> T a
dilate = ([a] -> [a]) -> T a -> T a
forall a. ([a] -> [a]) -> T a -> T a
lift1 (([a] -> [a]) -> T a -> T a)
-> (a -> [a] -> [a]) -> a -> T a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> [a]
forall a. C a => a -> [a] -> [a]
Core.dilate
instance (Arbitrary a, ZeroTestable.C a) => Arbitrary (T a) where
arbitrary :: Gen (T a)
arbitrary = ([a] -> T a) -> Gen [a] -> Gen (T a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([a] -> T a
forall a. [a] -> T a
fromCoeffs ([a] -> T a) -> ([a] -> [a]) -> [a] -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. C a => [a] -> [a]
Core.normalize) Gen [a]
forall a. Arbitrary a => Gen a
arbitrary
{-# INLINE notImplemented #-}
notImplemented :: String -> a
notImplemented :: String -> a
notImplemented String
name =
String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"MathObj.Polynomial: method " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cannot be implemented"
instance (P98.Num a) => P98.Num (T a) where
fromInteger :: Integer -> T a
fromInteger = a -> T a
forall a. a -> T a
const (a -> T a) -> (Integer -> a) -> Integer -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
P98.fromInteger
negate :: T a -> T a
negate = (T (T a) -> T (T a)) -> T a -> T a
forall (f :: * -> *) a b.
Functor f =>
(f (T a) -> f (T b)) -> f a -> f b
W98.unliftF1 T (T a) -> T (T a)
forall a. C a => a -> a
Additive.negate
+ :: T a -> T a -> T a
(+) = (T (T a) -> T (T a) -> T (T a)) -> T a -> T a -> T a
forall (f :: * -> *) a b c.
Functor f =>
(f (T a) -> f (T b) -> f (T c)) -> f a -> f b -> f c
W98.unliftF2 T (T a) -> T (T a) -> T (T a)
forall a. C a => a -> a -> a
(Additive.+)
* :: T a -> T a -> T a
(*) = (T (T a) -> T (T a) -> T (T a)) -> T a -> T a -> T a
forall (f :: * -> *) a b c.
Functor f =>
(f (T a) -> f (T b) -> f (T c)) -> f a -> f b -> f c
W98.unliftF2 T (T a) -> T (T a) -> T (T a)
forall a. C a => a -> a -> a
(Ring.*)
abs :: T a -> T a
abs = String -> T a -> T a
forall a. String -> a
notImplemented String
"abs"
signum :: T a -> T a
signum = String -> T a -> T a
forall a. String -> a
notImplemented String
"signum"
instance (P98.Fractional a) => P98.Fractional (T a) where
fromRational :: Rational -> T a
fromRational = a -> T a
forall a. a -> T a
const (a -> T a) -> (Rational -> a) -> Rational -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
P98.fromRational
/ :: T a -> T a -> T a
(/) = String -> T a -> T a -> T a
forall a. String -> a
notImplemented String
"(/)"