Copyright | (c) 2019 Andrew Lelechenko |
---|---|
License | BSD3 |
Maintainer | Andrew Lelechenko <[email protected]> |
Safe Haskell | None |
Language | Haskell2010 |
Data.Poly.Semiring
Description
Dense polynomials and a Semiring
-based interface.
Since: 0.2.0.0
Synopsis
- data Poly (v :: Type -> Type) a
- type VPoly = Poly Vector
- type UPoly = Poly Vector
- unPoly :: Poly v a -> v a
- leading :: forall (v :: Type -> Type) a. Vector v a => Poly v a -> Maybe (Word, a)
- toPoly :: (Eq a, Semiring a, Vector v a) => v a -> Poly v a
- monomial :: forall a (v :: Type -> Type). (Eq a, Semiring a, Vector v a) => Word -> a -> Poly v a
- scale :: forall a (v :: Type -> Type). (Eq a, Semiring a, Vector v a) => Word -> a -> Poly v a -> Poly v a
- pattern X :: (Eq a, Semiring a, Vector v a) => Poly v a
- eval :: forall a (v :: Type -> Type). (Semiring a, Vector v a) => Poly v a -> a -> a
- subst :: forall a (v :: Type -> Type) (w :: Type -> Type). (Eq a, Semiring a, Vector v a, Vector w a) => Poly v a -> Poly w a -> Poly w a
- deriv :: forall a (v :: Type -> Type). (Eq a, Semiring a, Vector v a) => Poly v a -> Poly v a
- integral :: forall a (v :: Type -> Type). (Eq a, Field a, Vector v a) => Poly v a -> Poly v a
- timesRing :: forall (v :: Type -> Type) a. (Eq a, Ring a, Vector v a) => Poly v a -> Poly v a -> Poly v a
- denseToSparse :: forall a (v :: Type -> Type). (Eq a, Semiring a, Vector v a, Vector v (Vector 1 Word, a)) => Poly v a -> Poly v a
- sparseToDense :: forall a (v :: Type -> Type). (Semiring a, Vector v a, Vector v (Vector 1 Word, a)) => Poly v a -> Poly v a
- dft :: (Ring a, Vector v a) => a -> v a -> v a
- inverseDft :: (Field a, Vector v a) => a -> v a -> v a
- dftMult :: forall a (v :: Type -> Type). (Eq a, Field a, Vector v a) => (Int -> a) -> Poly v a -> Poly v a -> Poly v a
Documentation
data Poly (v :: Type -> Type) a Source #
Polynomials of one variable with coefficients from a
,
backed by a Vector
v
(boxed, unboxed, storable, etc.).
Use the pattern X
for construction:
>>>
(X + 1) + (X - 1) :: VPoly Integer
2 * X + 0>>>
(X + 1) * (X - 1) :: UPoly Int
1 * X^2 + 0 * X + (-1)
Polynomials are stored normalized, without leading
zero coefficients, so 0 * X
+ 1 equals to 1.
The Ord
instance does not make much sense mathematically,
it is defined only for the sake of Set
, Map
, etc.
Due to being polymorphic by multiple axis, the performance of Poly
crucially
depends on specialisation of instances. Clients are strongly recommended
to compile with ghc-options:
-fspecialise-aggressively
and suggested to enable -O2
.
Since: 0.1.0.0
Instances
(Eq a, Semiring a, Vector v a) => IsList (Poly v a) Source # | Since: 0.3.1.0 |
(Eq a, Num a, Vector v a) => Num (Poly v a) Source # | |
(Show a, Vector v a) => Show (Poly v a) Source # | |
NFData (v a) => NFData (Poly v a) Source # | Since: 0.3.2.0 |
Defined in Data.Poly.Internal.Dense | |
Eq (v a) => Eq (Poly v a) Source # | |
Ord (v a) => Ord (Poly v a) Source # | |
Defined in Data.Poly.Internal.Dense | |
(Eq a, Field a, Vector v a) => Euclidean (Poly v a) Source # | Note that Since: 0.3.0.0 |
(Eq a, Ring a, GcdDomain a, Vector v a) => GcdDomain (Poly v a) Source # | Since: 0.3.0.0 |
(Eq a, Ring a, Vector v a) => Ring (Poly v a) Source # | |
Defined in Data.Poly.Internal.Dense | |
(Eq a, Semiring a, Vector v a) => Semiring (Poly v a) Source # | Note that |
type Item (Poly v a) Source # | |
Defined in Data.Poly.Internal.Dense |
unPoly :: Poly v a -> v a Source #
Convert a Poly
to a vector of coefficients
(first element corresponds to the constant term).
Since: 0.1.0.0
leading :: forall (v :: Type -> Type) a. Vector v a => Poly v a -> Maybe (Word, a) Source #
Return the leading power and coefficient of a non-zero polynomial.
>>>
leading ((2 * X + 1) * (2 * X^2 - 1) :: UPoly Int)
Just (3,4)>>>
leading (0 :: UPoly Int)
Nothing
Since: 0.3.0.0
toPoly :: (Eq a, Semiring a, Vector v a) => v a -> Poly v a Source #
Make a Poly
from a vector of coefficients
(first element corresponds to the constant term).
>>>
:set -XOverloadedLists
>>>
toPoly [1,2,3] :: VPoly Integer
3 * X^2 + 2 * X + 1>>>
toPoly [0,0,0] :: UPoly Int
0
Since: 0.2.0.0
monomial :: forall a (v :: Type -> Type). (Eq a, Semiring a, Vector v a) => Word -> a -> Poly v a Source #
Create a monomial from a power and a coefficient.
Since: 0.3.0.0
scale :: forall a (v :: Type -> Type). (Eq a, Semiring a, Vector v a) => Word -> a -> Poly v a -> Poly v a Source #
Multiply a polynomial by a monomial, expressed as a power and a coefficient.
>>>
scale 2 3 (X^2 + 1) :: UPoly Int
3 * X^4 + 0 * X^3 + 3 * X^2 + 0 * X + 0
Since: 0.3.0.0
eval :: forall a (v :: Type -> Type). (Semiring a, Vector v a) => Poly v a -> a -> a Source #
Evaluate the polynomial at a given point.
>>>
eval (X^2 + 1 :: UPoly Int) 3
10
Since: 0.2.0.0
subst :: forall a (v :: Type -> Type) (w :: Type -> Type). (Eq a, Semiring a, Vector v a, Vector w a) => Poly v a -> Poly w a -> Poly w a Source #
Substitute another polynomial instead of X
.
>>>
subst (X^2 + 1 :: UPoly Int) (X + 1 :: UPoly Int)
1 * X^2 + 2 * X + 2
Since: 0.3.3.0
deriv :: forall a (v :: Type -> Type). (Eq a, Semiring a, Vector v a) => Poly v a -> Poly v a Source #
Take the derivative of the polynomial.
>>>
deriv (X^3 + 3 * X) :: UPoly Int
3 * X^2 + 0 * X + 3
Since: 0.2.0.0
integral :: forall a (v :: Type -> Type). (Eq a, Field a, Vector v a) => Poly v a -> Poly v a Source #
Compute an indefinite integral of the polynomial, setting the constant term to zero.
>>>
integral (3 * X^2 + 3) :: UPoly Double
1.0 * X^3 + 0.0 * X^2 + 3.0 * X + 0.0
Since: 0.3.2.0
timesRing :: forall (v :: Type -> Type) a. (Eq a, Ring a, Vector v a) => Poly v a -> Poly v a -> Poly v a Source #
Karatsuba multiplication algorithm for polynomials over rings.
denseToSparse :: forall a (v :: Type -> Type). (Eq a, Semiring a, Vector v a, Vector v (Vector 1 Word, a)) => Poly v a -> Poly v a Source #
Convert from dense to sparse polynomials.
>>>
:set -XFlexibleContexts
>>>
denseToSparse (1 `Data.Semiring.plus` Data.Poly.X^2) :: Data.Poly.Sparse.UPoly Int
1 * X^2 + 1
Since: 0.5.0.0
sparseToDense :: forall a (v :: Type -> Type). (Semiring a, Vector v a, Vector v (Vector 1 Word, a)) => Poly v a -> Poly v a Source #
Convert from sparse to dense polynomials.
>>>
:set -XFlexibleContexts
>>>
sparseToDense (1 `Data.Semiring.plus` Data.Poly.Sparse.X^2) :: Data.Poly.UPoly Int
1 * X^2 + 0 * X + 1
Since: 0.5.0.0
Arguments
:: (Ring a, Vector v a) | |
=> a | primitive root \( \sqrt[N]{1} \), otherwise behaviour is undefined |
-> v a | \( \{ x_k \}_{k=0}^{N-1} \) (currently only \( N = 2^n \) is supported) |
-> v a | \( \{ y_k \}_{k=0}^{N-1} \) |
Discrete Fourier transform \( y_k = \sum_{j=0}^{N-1} x_j \sqrt[N]{1}^{jk} \).
Since: 0.5.0.0
Arguments
:: (Field a, Vector v a) | |
=> a | primitive root \( \sqrt[N]{1} \), otherwise behaviour is undefined |
-> v a | \( \{ y_k \}_{k=0}^{N-1} \) (currently only \( N = 2^n \) is supported) |
-> v a | \( \{ x_k \}_{k=0}^{N-1} \) |
Inverse discrete Fourier transform \( x_k = {1\over N} \sum_{j=0}^{N-1} y_j \sqrt[N]{1}^{-jk} \).
Since: 0.5.0.0
Arguments
:: forall a (v :: Type -> Type). (Eq a, Field a, Vector v a) | |
=> (Int -> a) | mapping from \( N = 2^n \) to a primitive root \( \sqrt[N]{1} \) |
-> Poly v a | |
-> Poly v a | |
-> Poly v a |
Multiplication of polynomials using
discrete Fourier transform.
It could be faster than (*)
for large polynomials
if multiplication of coefficients is particularly expensive.
Since: 0.5.0.0