hops-0.7.2: Handy Operations on Power Series

CopyrightAnders Claesson 2015
MaintainerAnders Claesson <anders.claesson@gmail.com>
Safe HaskellNone
LanguageHaskell98

HOPS.GF.Series

Contents

Description

License : BSD-3

Truncated power series with rational coefficients.

When writing this module I benefited from ideas and inspiration from the following sources:

Synopsis

Documentation

newtype Series n Source #

A truncated power series is represented as a (dense) vector of coefficients. The precision (maximum number of coefficients) is statically checked. For instance, adding two series of different precision would result in a type error.

Constructors

Series (Vector Rat) 

Instances

Eq (Series n) Source # 

Methods

(==) :: Series n -> Series n -> Bool #

(/=) :: Series n -> Series n -> Bool #

KnownNat n => Floating (Series n) Source # 

Methods

pi :: Series n #

exp :: Series n -> Series n #

log :: Series n -> Series n #

sqrt :: Series n -> Series n #

(**) :: Series n -> Series n -> Series n #

logBase :: Series n -> Series n -> Series n #

sin :: Series n -> Series n #

cos :: Series n -> Series n #

tan :: Series n -> Series n #

asin :: Series n -> Series n #

acos :: Series n -> Series n #

atan :: Series n -> Series n #

sinh :: Series n -> Series n #

cosh :: Series n -> Series n #

tanh :: Series n -> Series n #

asinh :: Series n -> Series n #

acosh :: Series n -> Series n #

atanh :: Series n -> Series n #

log1p :: Series n -> Series n #

expm1 :: Series n -> Series n #

log1pexp :: Series n -> Series n #

log1mexp :: Series n -> Series n #

KnownNat n => Fractional (Series n) Source # 

Methods

(/) :: Series n -> Series n -> Series n #

recip :: Series n -> Series n #

fromRational :: Rational -> Series n #

KnownNat n => Num (Series n) Source # 

Methods

(+) :: Series n -> Series n -> Series n #

(-) :: Series n -> Series n -> Series n #

(*) :: Series n -> Series n -> Series n #

negate :: Series n -> Series n #

abs :: Series n -> Series n #

signum :: Series n -> Series n #

fromInteger :: Integer -> Series n #

Show (Series n) Source # 

Methods

showsPrec :: Int -> Series n -> ShowS #

show :: Series n -> String #

showList :: [Series n] -> ShowS #

Pretty (Series n) Source # 

Constructions

polynomial :: KnownNat n => Proxy n -> [Rat] -> Series n Source #

Create a polynomial with the given list of coefficients. E.g.

>>> (polynomial (Proxy :: Proxy 4) [1,1])^2
series (Proxy :: Proxy 4) [Val (1 % 1),Val (2 % 1),Val (1 % 1),Val (0 % 1)]

series :: KnownNat n => Proxy n -> [Rat] -> Series n Source #

Create a power series with the given list of initial coefficients. E.g.

>>> (series (Proxy :: Proxy 4) [1,1])^2
series (Proxy :: Proxy 4) [Val (1 % 1),Val (2 % 1),Indet,Indet]

xpow :: KnownNat n => Int -> Series n Source #

Create the power series x^k.

nil :: KnownNat n => Series n Source #

Create an empty power series. All its coefficients are Indet.

infty :: KnownNat n => Series n Source #

A series whose constant term is DZ.

Accessors

precision :: Series n -> Int Source #

If f :: Series n, then precision f = n.

coeffVector :: Series n -> Vector Rat Source #

The underlying vector of coefficients. E.g.

>>> coeffVector $ polynomial (Proxy :: Proxy 3) [1,2]
fromList [Val (1 % 1),Val (2 % 1),Val (0 % 1)]

coeffList :: Series n -> [Rat] Source #

The list of coefficients of the given series. E.g.

>>> coeffList $ series (Proxy :: Proxy 3) [9]
[Val (9 % 1),Indet,Indet]

constant :: Series n -> Rat Source #

Constant term of the given series.

leadingCoeff :: Series n -> Rat Source #

The first nonzero coefficient when read from smaller to larger powers of x. If no such coefficient exists then return 0.

rationalPrefix :: Series n -> [Rational] Source #

The longest initial segment of coefficients that are rational (i.e. not Indet or DZ).

integerPrefix :: Series n -> [Integer] Source #

The longest initial segment of coefficients that are integral

intPrefix :: Series n -> [Int] Source #

The longest initial segment of coefficients that are Ints

eval :: Series n -> Rat -> Rat Source #

Evaluate the polynomial p at x using Horner's method.

>>> let x = polynomial (Proxy :: Proxy 5) [0,1]
>>> eval (1-x+x^2) 2
Val (3 % 1)

Operations

(.*) :: Series n -> Series n -> Series n Source #

Coefficient wise multiplication of two power series. Also called the Hadamard product.

(./) :: Series n -> Series n -> Series n Source #

Coefficient wise division of two power series.

(!^!) :: Rat -> Rat -> Rat Source #

The power operator for Rats. E.g.

>>> (1/4) !^! (3/2)
Val (1 % 8)

(^!) :: KnownNat n => Series n -> Rat -> Series n Source #

A power series raised to a rational power.

>>> series (Proxy :: Proxy 4) [1,2,3,4] ^! (1/2)
series (Proxy :: Proxy 4) [Val (1 % 1),Val (1 % 1),Val (1 % 1),Val (1 % 1)]

(?) :: KnownNat n => Series n -> Series n -> Series n infixr 7 Source #

Select certain coefficients of the first series, based on indices from the second series, returning the selection as a series. Elements of the second series that are not nonnegative integers or not less than the precision are ignored; trailing zeros are also ignored.

o :: Series n -> Series n -> Series n infixr 7 Source #

The composition of two power series.

>>> let x = polynomial (Proxy :: Proxy 4) [0,1]
>>> (1/(1-x)) `o` (2*x)
series (Proxy :: Proxy 4) [Val (1 % 1),Val (2 % 1),Val (4 % 1),Val (8 % 1)]

derivative :: Series n -> Series n Source #

The (formal) derivative of a power series.

integral :: Series n -> Series n Source #

The (formal) integral of a power series.

revert :: Series n -> Series n Source #

Reversion (compositional inverse) of a power series. Unless the constant of the power series is zero the result is indeterminate.

>>> revert $ series (Proxy :: Proxy 4) [0,1,2,3]
series (Proxy :: Proxy 4) [Val (0 % 1),Val (1 % 1),Val ((-2) % 1),Val (5 % 1)]
>>> revert $ series (Proxy :: Proxy 4) [1,1,1,1]
series (Proxy :: Proxy 4) [Indet,Indet,Indet,Indet]

sec :: KnownNat n => Series n -> Series n Source #

The secant function: sec f = 1 / cos f

fac :: KnownNat n => Series n -> Series n Source #

The factorial of a constant power series. If the the power series isn't constant, then the result is indeterminate (represented using Indet).

>>> fac (polynomial (Proxy :: Proxy 4) [3])
series (Proxy :: Proxy 4) [Val (6 % 1),Val (0 % 1),Val (0 % 1),Val (0 % 1)]

rseq :: Series n -> Series n Source #

Construct a series that has coefficient 1 for each term whose power is some coefficient of the input series and 0 elsewhere. Elements of the input series that are not nonnegative integers or not less than the precision are ignored; trailing zeros are also ignored.

>>> rseq $ series (Proxy :: Proxy 4) [1,3]
series (Proxy :: Proxy 4) [Val (0 % 1),Val (1 % 1),Val (0 % 1),Val (1 % 1)]

rseq' :: Series n -> Series n Source #

The "complement" of rseq, i.e., the series generated by rseq, with 0 replaced by 1, and 1 replaced by 0.