hspray-0.2.7.0: Multivariate polynomials and fractions of multivariate polynomials.
Copyright(c) Stéphane Laurent 2023
LicenseGPL-3
Maintainerlaurent_step@outlook.fr
Safe HaskellSafe-Inferred
LanguageHaskell2010

Math.Algebra.Hspray

Description

Deals with multivariate polynomials on a commutative ring. See README for examples.

Synopsis

Classes

class HasVariables a where Source #

A spray represents a multivariate polynomial so it has some variables. We introduce a class because it will be assigned to the ratios of sprays too.

Associated Types

type VariablesType a Source #

The type of the objects the variables represent

Methods

evaluate :: a -> [VariablesType a] -> VariablesType a Source #

Evaluation (replacing the variables by some values)

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> spray = 2*^x^**^2 ^-^ 3*^y
>>> evaluate spray [2, 1]
5

substitute :: [Maybe (VariablesType a)] -> a -> a Source #

Substitution (partial evaluation)

>>> x1 = lone 1 :: Spray Int
>>> x2 = lone 2 :: Spray Int
>>> x3 = lone 3 :: Spray Int
>>> spray = x1^**^2 ^-^ x2 ^+^ x3 ^-^ unitSpray
>>> spray' = substitute [Just 2, Nothing, Just 3] spray
>>> putStrLn $ prettyNumSprayX1X2X3 "x" spray'
-x2 + 6 

numberOfVariables :: a -> Int Source #

Number of variables

permuteVariables Source #

Arguments

:: [Int]

permutation

-> a

the object whose variables will be permuted

-> a

the object with permuted variables

Permutes the variables

>>> f :: Spray Rational -> Spray Rational -> Spray Rational -> Spray Rational
>>> f p1 p2 p3 = p1^**^4 ^+^ (2*^p2^**^3) ^+^ (3*^p3^**^2) ^-^ (4*^unitSpray)
>>> x1 = lone 1 :: Spray Rational
>>> x2 = lone 2 :: Spray Rational
>>> x3 = lone 3 :: Spray Rational
>>> spray = f x1 x2 x3
permuteVariables [3, 1, 2] spray == f x3 x1 x2

swapVariables Source #

Arguments

:: (Int, Int)

the indices of the variables to be swapped (starting at 1)

-> a

the object whose variables will be swapped

-> a

the object with swapped variables

Swaps two variables

swapVariables (1, 3) x == permuteVariables [3, 2, 1] x

derivative Source #

Arguments

:: Int

index of the variable of differentiation (starting at 1)

-> a

the object to be derivated

-> a

the derivated object

Derivative

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> spray = 2*^x ^-^ 3*^y^**^8
>>> spray' = derivative 1 spray
>>> putStrLn $ prettyNumSpray spray'
2

isConstant :: HasVariables a => a -> Bool Source #

Whether an object of class HasVariables is constant

isUnivariate :: HasVariables a => a -> Bool Source #

Whether an object of class HasVariables is univariate; it is considered that it is univariate if it is constant

isBivariate :: HasVariables a => a -> Bool Source #

Whether an object of class HasVariables is bivariate; it is considered that it is bivariate if it is univariate

isTrivariate :: HasVariables a => a -> Bool Source #

Whether an object of class HasVariables is trivariate; it is considered that it is trivariate if it is bivariate

Main types

data Powers Source #

Constructors

Powers 

Fields

Instances

Instances details
Show Powers Source # 
Instance details

Defined in Math.Algebra.Hspray

Eq Powers Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(==) :: Powers -> Powers -> Bool #

(/=) :: Powers -> Powers -> Bool #

Hashable Powers Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

hashWithSalt :: Int -> Powers -> Int #

hash :: Powers -> Int #

(Eq a, C a) => C a (ParametricSpray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(*>) :: a -> ParametricSpray a -> ParametricSpray a #

(C a, Eq a) => C a (Spray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(*>) :: a -> Spray a -> Spray a #

(Eq a, C a) => C a (ParametricSpray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(<*) :: ParametricSpray a -> a -> ParametricSpray a #

(C a, Eq a) => C a (Spray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(<*) :: Spray a -> a -> Spray a #

(C a, Eq a) => HasVariables (Spray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Associated Types

type VariablesType (Spray a) Source #

(C a, Eq a) => C (Spray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

zero :: Spray a #

(+) :: Spray a -> Spray a -> Spray a #

(-) :: Spray a -> Spray a -> Spray a #

negate :: Spray a -> Spray a #

(C a, Eq a) => C (Spray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(*) :: Spray a -> Spray a -> Spray a #

one :: Spray a #

fromInteger :: Integer -> Spray a #

(^) :: Spray a -> Integer -> Spray a #

(Eq a, C a) => C (Polynomial a) (SymbolicSpray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

(C a, Eq a) => C (Spray a) (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(*>) :: Spray a -> RatioOfSprays a -> RatioOfSprays a #

(C a, Eq a) => C (Spray a) (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(<*) :: RatioOfSprays a -> Spray a -> RatioOfSprays a #

type VariablesType (Spray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

type VariablesType (Spray a) = a

type Monomial a = (Powers, a) Source #

Basic sprays

lone :: C a => Int -> Spray a Source #

The n-th polynomial variable x_n as a spray; one usually builds a spray by introducing these variables and combining them with the arithmetic operations

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> spray = 2*^x^**^2 ^-^ 3*^y
>>> putStrLn $ prettyNumSpray spray
2*x^2 - 3*y
lone 0 == unitSpray

qlone :: Int -> QSpray Source #

The n-th polynomial variable for rational sprays; this is just a specialization of lone

unitSpray :: C a => Spray a Source #

The unit spray

spray ^*^ unitSpray == spray

zeroSpray :: (Eq a, C a) => Spray a Source #

The null spray

spray ^+^ zeroSpray == spray

constantSpray :: (C a, Eq a) => a -> Spray a Source #

Constant spray

constantSpray 3 == 3 *^ unitSpray

Operations on sprays

(*^) :: (C a, Eq a) => a -> Spray a -> Spray a infixr 7 Source #

Scales a spray by a scalar; if you import the Algebra.Module module then it is the same operation as (*>) from this module

(/^) :: (C a, Eq a) => Spray a -> a -> Spray a infixr 7 Source #

Divides a spray by a scalar; you can equivalently use (/>) if the type of the scalar is not ambiguous

(^+^) :: (C a, Eq a) => Spray a -> Spray a -> Spray a infixl 6 Source #

Addition of two sprays

(^-^) :: (C a, Eq a) => Spray a -> Spray a -> Spray a infixl 6 Source #

Substraction of two sprays

(^*^) :: (C a, Eq a) => Spray a -> Spray a -> Spray a infixl 7 Source #

Multiply two sprays

(^**^) :: (C a, Eq a) => Spray a -> Int -> Spray a infixr 8 Source #

Power of a spray

Showing a spray

prettySpray :: Show a => Spray a -> String Source #

Pretty form of a spray with monomials displayed in the style of "x.z^2"; you should rather use prettyNumSpray or prettyQSpray if you deal with sprays with numeric coefficients

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> z = lone 3 :: Spray Int
>>> p = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3
>>> putStrLn $ prettySpray p
(2)*x + (3)*y^2 + (-4)*z^3
>>> putStrLn $ prettySpray (p ^+^ lone 4)
(2)*x1 + (3)*x2^2 + (-4)*x3^3 + x4
prettySpray spray == prettySprayXYZ ["x", "y", "z"] spray

prettySpray' :: Show a => Spray a -> String Source #

Pretty form of a spray, with monomials shown as "x1.x3^2"; use prettySprayX1X2X3 to change the letter (or prettyNumSprayX1X2X3 or prettyQSprayX1X2X3 if the coefficients are numeric)

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> z = lone 3 :: Spray Int
>>> p = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3
>>> putStrLn $ prettySpray' p
(2)*x1 + (3)*x2^2 + (-4)*x3^3 

prettySpray'' Source #

Arguments

:: Show a 
=> String

a string denoting the variables, e.g. "x"

-> Spray a

the spray

-> String 

Pretty form of a spray; you will probably prefer prettySpray or prettySpray'

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> z = lone 3 :: Spray Int
>>> p = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3
>>> putStrLn $ prettySpray'' "x" p
(2)*x^(1) + (3)*x^(0, 2) + (-4)*x^(0, 0, 3)

prettySprayXYZ Source #

Arguments

:: Show a 
=> [String]

typically some letters, to print the variables

-> Spray a

the spray to be printed

-> String 

Pretty form of a spray with monomials displayed in the style of "x.z^2"; you should rather use prettyNumSprayXYZ or prettyQSprayXYZ if your coefficients are numeric

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> z = lone 3 :: Spray Int
>>> p = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3
>>> putStrLn $ prettySprayXYZ ["X", "Y", "Z"] p
(2)*X + (3)*Y^2 + (-4)*Z^3
>>> putStrLn $ prettySprayXYZ ["X", "Y"] p
(2)*X1 + (3)*X2^2 + (-4)*X3^3

prettySprayX1X2X3 Source #

Arguments

:: Show a 
=> String

typically a letter, to print the non-indexed variables

-> Spray a

the spray to be printed

-> String 

Pretty form of a spray with monomials displayed in the style of "x1.x3^2"; you should rather use prettyNumSprayX1X2X3 or prettyQSprayX1X2X3 if your coefficients are numeric

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> z = lone 3 :: Spray Int
>>> spray = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3
>>> putStrLn $ prettySprayX1X2X3 "X" spray
(2)*X1 + (3)*X2^2 + (-4)*X3^3

showSpray Source #

Arguments

:: (a -> String)

function mapping a coefficient to a string, typically show

-> (String, String)

pair of braces to enclose the coefficients

-> ([Seq Int] -> [String])

function mapping a list of exponents to a list of strings representing the monomials corresponding to these exponents

-> Spray a

the spray to be printed

-> String 

Prints a spray; this function is exported for possible usage in other packages

showSprayXYZ Source #

Arguments

:: (a -> String)

function mapping a coefficient to a string, typically show

-> (String, String)

used to enclose the coefficients, usually a pair of braces

-> [String]

typically some letters, to print the variables

-> Spray a

the spray to be printed

-> String 

Prints a spray, with monomials shown as "x.z^2", and with a user-defined showing function for the coefficients

showSprayXYZ' Source #

Arguments

:: (a -> String)

function mapping a coefficient to a string, typically show

-> [String]

typically some letters, to print the variables

-> Spray a

the spray to be printed

-> String 

Prints a spray, with monomials shown as "x.z^2", and with a user-defined showing function for the coefficients; this is the same as the function showSprayXYZ with the pair of braces ("(", ")")

showSprayX1X2X3 Source #

Arguments

:: (a -> String)

function mapping a coefficient to a string, typically show

-> (String, String)

used to enclose the coefficients

-> String

typically a letter, to print the non-indexed variables

-> Spray a

the spray to be printed

-> String 

Pretty form of a spray, with monomials shown as "x1.x3^2", and with a user-defined showing function for the coefficients

showSprayX1X2X3' Source #

Arguments

:: (a -> String)

function mapping a coefficient to a string, e.g. show

-> String

typically a letter, to print the non-indexed variables

-> Spray a

the spray to be printed

-> String 

Pretty form of a spray, with monomials shown as "x1.x3^2", and with a user-defined showing function for the coefficients; this is the same as the function showSprayX1X2X3 with the pair of braces ("(", ")") used to enclose the coefficients

showNumSpray Source #

Arguments

:: (Num a, Ord a) 
=> ([Seq Int] -> [String])

function mapping a list of monomial exponents to a list of strings representing the monomials

-> (a -> String)

function mapping a positive coefficient to a string

-> Spray a 
-> String 

Show a spray with numeric coefficients; this function is exported for possible usage in other packages

showQSpray Source #

Arguments

:: ([Seq Int] -> [String])

function printing monomials

-> QSpray 
-> String 

Prints a QSpray; for internal usage but exported for usage in other packages

showQSpray' Source #

Arguments

:: ([Seq Int] -> [String])

function mapping a list of monomials exponents to a list of strings

-> QSpray' 
-> String 

Prints a QSpray'; for internal usage but exported for usage in other packages

prettyNumSprayX1X2X3 Source #

Arguments

:: (Num a, Ord a, Show a) 
=> String

usually a letter such as "x" to denote the non-indexed variables

-> Spray a 
-> String 

Pretty form of a spray with numeric coefficients, printing monomials as "x1.x3^2"

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> z = lone 3 :: Spray Int
>>> p = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3
>>> putStrLn $ prettyNumSprayX1X2X3 "x" p
2*x1 + 3*x2^2 - 4*x3^3 

prettyQSprayX1X2X3 Source #

Arguments

:: String

usually a letter such as "x", to denote the non-indexed variables

-> QSpray 
-> String 

Pretty form of a spray with rational coefficients, printing monomials in the style of "x1.x3^2"

>>> x = lone 1 :: QSpray
>>> y = lone 2 :: QSpray
>>> z = lone 3 :: QSpray
>>> p = 2*^x ^+^ 3*^y^**^2 ^-^ (4%3)*^z^**^3
>>> putStrLn $ prettyQSprayX1X2X3 "x" p
2*x1 + 3*x2^2 - (4/3)*x3^3 

prettyQSprayX1X2X3' Source #

Arguments

:: String

usually a letter such as "x", to denote the non-indexed variables

-> QSpray' 
-> String 

Same as prettyQSprayX1X2X3 but for a QSpray' spray

prettyNumSprayXYZ Source #

Arguments

:: (Num a, Ord a, Show a) 
=> [String]

usually some letters, denoting the variables

-> Spray a 
-> String 

Pretty form of a spray with numeric coefficients, printing monomials as "x.z^2" if possible, i.e. if enough letters are provided, otherwise as "x1.x3^2"

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> z = lone 3 :: Spray Int
>>> w = lone 4 :: Spray Int
>>> p = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3
>>> putStrLn $ prettyNumSprayXYZ ["x","y","z"] p
2*x + 3*y^2 - 4*z^3 
>>> putStrLn $ prettyNumSprayXYZ ["x","y","z"] (p ^+^ w)
2*x1 + 3*x2^2 - 4*x3^3 + x4
>>> putStrLn $ prettyNumSprayXYZ ["a","b","c"] (p ^+^ w)
2*a1 + 3*a2^2 - 4*a3^3 + a4

prettyQSprayXYZ Source #

Arguments

:: [String]

usually some letters, to denote the variables

-> QSpray 
-> String 

Pretty form of a spray with rational coefficients, printing monomials in the style of "x.z^2" with the provided letters if possible, i.e. if enough letters are provided, otherwise in the style "x1.x3^2", taking the first provided letter to denote the non-indexed variables

>>> x = lone 1 :: QSpray
>>> y = lone 2 :: QSpray
>>> z = lone 3 :: QSpray
>>> p = 2*^x ^+^ 3*^y^**^2 ^-^ (4%3)*^z^**^3
>>> putStrLn $ prettyQSprayXYZ ["x","y","z"] p
2*x + 3*y^2 - (4/3)*z^3 
>>> putStrLn $ prettyQSprayXYZ ["x","y"] p
2*x1 + 3*x2^2 - (4%3)*x3^3
>>> putStrLn $ prettyQSprayXYZ ["a","b"] p
2*a1 + 3*a2^2 - (4/3)*a3^3

prettyQSprayXYZ' Source #

Arguments

:: [String]

usually some letters, to denote the variables

-> QSpray' 
-> String 

Same as prettyQSprayXYZ but for a QSpray' spray

prettyNumSpray :: (Num a, Ord a, Show a) => Spray a -> String Source #

Pretty printing of a spray with numeric coefficients prop> prettyNumSpray == prettyNumSprayXYZ ["x", "y", "z"]

prettyNumSpray' :: (Num a, Ord a, Show a) => Spray a -> String Source #

Pretty printing of a spray with numeric coefficients prop> prettyNumSpray' == prettyNumSprayXYZ [X, Y, Z]

prettyQSpray :: QSpray -> String Source #

Pretty printing of a spray with rational coefficients prop> prettyQSpray == prettyQSprayXYZ ["x", "y", "z"]

prettyQSpray'' :: QSpray -> String Source #

Pretty printing of a spray with rational coefficients prop> prettyQSpray'' == prettyQSprayXYZ [X, Y, Z]

prettyQSpray' :: QSpray' -> String Source #

Pretty printing of a spray with rational coefficients prop> prettyQSpray' == prettyQSprayXYZ' ["x", "y", "z"]

prettyQSpray''' :: QSpray' -> String Source #

Pretty printing of a spray with rational coefficients prop> prettyQSpray''' == prettyQSprayXYZ' [X, Y, Z]

Univariate polynomials and fractions of univariate polynomials

newtype A a Source #

Constructors

A a 

Instances

Instances details
Show a => Show (A a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

showsPrec :: Int -> A a -> ShowS #

show :: A a -> String #

showList :: [A a] -> ShowS #

Eq a => Eq (A a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(==) :: A a -> A a -> Bool #

(/=) :: A a -> A a -> Bool #

C a => C (A a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

zero :: A a #

(+) :: A a -> A a -> A a #

(-) :: A a -> A a -> A a #

negate :: A a -> A a #

C a => C (A a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(/) :: A a -> A a -> A a #

recip :: A a -> A a #

fromRational' :: Rational -> A a #

(^-) :: A a -> Integer -> A a #

C a => C (A a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(*) :: A a -> A a -> A a #

one :: A a #

fromInteger :: Integer -> A a #

(^) :: A a -> Integer -> A a #

(Eq a, C a) => C (A a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

isZero :: A a -> Bool #

(Eq a, C a) => C (A a) (RatioOfPolynomials a) Source # 
Instance details

Defined in Math.Algebra.Hspray

(Eq a, C a) => C (Polynomial a) (RatioOfPolynomials a) Source # 
Instance details

Defined in Math.Algebra.Hspray

(Eq a, C a) => C (Polynomial a) (SymbolicSpray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

scalarQ :: Rational' -> Q Source #

Identify a rational to a A Rational' element

type Polynomial a = T (A a) Source #

(^/^) :: (Eq a, C a) => Polynomial a -> Polynomial a -> RatioOfPolynomials a Source #

Division of univariate polynomials; this is an application of :% followed by a simplification of the obtained fraction of the two polynomials

prettyRatioOfPolynomials Source #

Arguments

:: (Eq a, C a, Show a) 
=> String

string (usually a single letter) to denote the variable, e.g. "a"

-> RatioOfPolynomials a 
-> String 

Pretty form of a ratio of univariate polynomials

prettyRatioOfQPolynomials Source #

Arguments

:: String

a string to denote the variable, e.g. "a"

-> RatioOfQPolynomials 
-> String 

Pretty form of a ratio of univariate polynomials with rational coefficients

(*.) :: (Eq a, C a) => a -> RatioOfPolynomials a -> RatioOfPolynomials a infixr 7 Source #

Scale a ratio of univariate polynomials by a scalar

constPoly :: a -> Polynomial a Source #

Constant univariate polynomial

polyFromCoeffs :: [a] -> Polynomial a Source #

Univariate polynomial from its coefficients (ordered by increasing degrees)

outerVariable :: C a => Polynomial a Source #

The variable of a univariate polynomial; it is called "outer" because this is the variable occuring in the polynomial coefficients of a SymbolicSpray

constQPoly :: Rational' -> QPolynomial Source #

Constant rational univariate polynomial

>>> import Number.Ratio ( (%) )
>>> constQPoly (2 % 3)
constQPoly (2 % 3) == qpolyFromCoeffs [2 % 3]

qpolyFromCoeffs :: [Rational'] -> QPolynomial Source #

Rational univariate polynomial from coefficients

>>> import Number.Ratio ( (%) )
>>> qpolyFromCoeffs [2 % 3, 5, 7 % 4]

outerQVariable :: QPolynomial Source #

The variable of a univariate rational polynomial; it is called "outer" because it is the variable occuring in the coefficients of a SymbolicQSpray (but I do not like this name - see README)

outerQVariable == qpolyFromCoeffs [0, 1]

evalRatioOfPolynomials Source #

Arguments

:: C a 
=> a

the value at which the evaluation is desired

-> RatioOfPolynomials a 
-> a 

Evaluates a ratio of univariate polynomials

Symbolic sprays

prettySymbolicSprayX1X2X3 Source #

Arguments

:: (Eq a, Show a, C a) 
=> String

string to denote the outer variable of the spray, e.g. "a"

-> String

typically a letter, to denote the non-indexed variables

-> SymbolicSpray a

a symbolic spray; note that this function does not simplify it

-> String 

Pretty form of a symbolic spray, using a string (typically a letter) followed by an index to denote the variables

prettySymbolicSprayXYZ Source #

Arguments

:: (Eq a, Show a, C a) 
=> String

string to denote the outer variable of the spray, e.g. "a"

-> [String]

typically some letters, to denote the main variables

-> SymbolicSpray a

a symbolic spray; note that this function does not simplify it

-> String 

Pretty form of a symbolic spray, using some given strings (typically some letters) to denote the variables if possible, i.e. if enough letters are provided; otherwise this function behaves exactly like prettySymbolicQSprayX1X2X3 a where a is the first provided letter

prettySymbolicSpray Source #

Arguments

:: (Eq a, Show a, C a) 
=> String

string to denote the outer variable of the spray, e.g. "a"

-> SymbolicSpray a

a symbolic spray; note that this function does not simplify it

-> String 

Pretty form of a symbolic spray; see the definition below and see prettySymbolicSprayXYZ

prettySymbolicSpray a spray == prettySymbolicSprayXYZ a ["x","y","z"] spray

prettySymbolicSpray' Source #

Arguments

:: (Eq a, Show a, C a) 
=> String

string to denote the outer variable of the spray, e.g. "a"

-> SymbolicSpray a

a symbolic spray; note that this function does not simplify it

-> String 

Pretty form of a symbolic spray; see the definition below and see prettySymbolicSprayXYZ

prettySymbolicSpray' a spray == prettySymbolicSprayXYZ a ["X","Y","Z"] spray

prettySymbolicQSprayX1X2X3 Source #

Arguments

:: String

usually a letter, to denote the outer variable of the spray, e.g. "a"

-> String

usually a letter, to denote the non-indexed variables of the spray

-> SymbolicQSpray

a symbolic rational spray; note that this function does not simplify it

-> String 

Pretty form of a symbolic rational spray, using a string (typically a letter) followed by an index to denote the variables

prettySymbolicQSprayXYZ Source #

Arguments

:: String

usually a letter, to denote the outer variable of the spray, e.g. "a"

-> [String]

usually some letters, to denote the variables of the spray

-> SymbolicQSpray

a symbolic rational spray; note that this function does not simplify it

-> String 

Pretty form of a symbolic rational spray, using some given strings (typically some letters) to denote the variables if possible, i.e. if enough letters are provided; otherwise this function behaves exactly like prettySymbolicQSprayX1X2X3 a where a is the first provided letter

prettySymbolicQSpray Source #

Arguments

:: String

usually a letter, to denote the outer variable of the spray, e.g. "a"

-> SymbolicQSpray

the symbolic rational spray to be printed; note that this function does not simplify it

-> String 

Pretty form of a symbolic rational spray, using "x", "y" and "z" for the variables if possible; i.e. if the spray does not have more than three variables, otherwise "x1", "x2", ... are used to denote the variables

prettySymbolicQSpray a == prettySymbolicQSprayXYZ a ["x","y","z"]

prettySymbolicQSpray' Source #

Arguments

:: String

usually a letter, to denote the outer variable of the spray, e.g. "a"

-> SymbolicQSpray

the symbolic rational spray to be printed; note that this function does not simplify it

-> String 

Pretty form of a symbolic rational spray, using X, Y and Z for the variables if possible; i.e. if the spray does not have more than three variables, otherwise X1, X2, ... are used

prettySymbolicQSpray' a = prettySymbolicQSprayXYZ a ["X","Y","Z"]

simplifySymbolicSpray :: (Eq a, C a) => SymbolicSpray a -> SymbolicSpray a Source #

Simplifies the coefficients (the fractions of univariate polynomials) of a symbolic spray

evalSymbolicSpray :: (Eq a, C a) => SymbolicSpray a -> a -> Spray a Source #

Substitutes a value to the outer variable of a symbolic spray (the variable occuring in the coefficients)

evalSymbolicSpray' Source #

Arguments

:: (Eq a, C a) 
=> SymbolicSpray a

symbolic spray to be evaluated

-> a

a value for the outer variable

-> [a]

some values for the inner variables

-> a 

Substitutes a value to the outer variable of a symbolic spray as well as some values to the main variables of this spray

evalSymbolicSpray'' :: (Eq a, C a) => SymbolicSpray a -> [a] -> RatioOfPolynomials a Source #

Substitutes some values to the main variables of a symbolic spray

Ratios of sprays

data RatioOfSprays a Source #

A RatioOfSprays a object represents a fraction of two multivariate polynomials whose coefficients are of type a which represents a field. These two polynomials are represented by two Spray a objects. Generally we do not use this constructor to build a ratio of sprays: we use the %//% operator instead, because it always returns an irreducible ratio of sprays, meaning that its corresponding fraction of polynomials is irreducible, i.e. its numerator and its denominator are coprime. You can use this constructor if you are sure that the numerator and the denominator are coprime. This can save some computation time, but unfortunate consequences can occur if the numerator and the denominator are not coprime. An arithmetic operation on ratios of sprays always returns an irreducible ratio of sprays under the condition that the ratios of sprays it involves are irreducible. Moreover, it never returns a ratio of sprays with a constant denominator other than the unit spray. If you use this constructor with a constant denominator, always set this denominator to the unit spray (by dividing the numerator by the constant value of the denominator).

Constructors

RatioOfSprays 

Fields

Instances

Instances details
(Eq a, C a) => C a (ParametricSpray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(*>) :: a -> ParametricSpray a -> ParametricSpray a #

(C a, Eq a) => C a (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(*>) :: a -> RatioOfSprays a -> RatioOfSprays a #

(Eq a, C a) => C a (ParametricSpray a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(<*) :: ParametricSpray a -> a -> ParametricSpray a #

(C a, Eq a) => C a (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(<*) :: RatioOfSprays a -> a -> RatioOfSprays a #

Show a => Show (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

(C a, Eq a) => Eq (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

(Eq a, C a) => HasVariables (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Associated Types

type VariablesType (RatioOfSprays a) Source #

(C a, Eq a) => C (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

(C a, Eq a) => C (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

(C a, Eq a) => C (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

(C a, Eq a) => C (Spray a) (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(*>) :: Spray a -> RatioOfSprays a -> RatioOfSprays a #

(C a, Eq a) => C (Spray a) (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

Methods

(<*) :: RatioOfSprays a -> Spray a -> RatioOfSprays a #

type VariablesType (RatioOfSprays a) Source # 
Instance details

Defined in Math.Algebra.Hspray

(%//%) :: (Eq a, C a) => Spray a -> Spray a -> RatioOfSprays a infixl 7 Source #

Irreducible ratio of sprays from numerator and denominator

(%/%) :: (Eq a, C a) => RatioOfSprays a -> Spray a -> RatioOfSprays a infixr 7 Source #

Division of a ratio of sprays by a spray

isConstantRatioOfSprays :: (Eq a, C a) => RatioOfSprays a -> Bool Source #

Whether a ratio of sprays is constant; this is an alias of isConstant

isPolynomialRatioOfSprays :: (Eq a, C a) => RatioOfSprays a -> Bool Source #

Wheter a ratio of sprays actually is polynomial, that is, whether its denominator is a constant spray (and then it should be the unit spray)

zeroRatioOfSprays :: (C a, Eq a) => RatioOfSprays a Source #

The null ratio of sprays

zeroROS :: (C a, Eq a) => RatioOfSprays a Source #

The null ratio of sprays

unitRatioOfSprays :: (C a, Eq a) => RatioOfSprays a Source #

The unit ratio of sprays

unitROS :: (C a, Eq a) => RatioOfSprays a Source #

The unit ratio of sprays

constantRatioOfSprays :: (Eq a, C a) => a -> RatioOfSprays a Source #

Constant ratio of sprays

asRatioOfSprays :: C a => Spray a -> RatioOfSprays a Source #

Coerces a spray to a ratio of sprays

evalRatioOfSprays :: (Eq a, C a) => RatioOfSprays a -> [a] -> a Source #

Evaluates a ratio of sprays; this is an alias of evaluate

substituteRatioOfSprays :: (Eq a, C a) => [Maybe a] -> RatioOfSprays a -> RatioOfSprays a Source #

Substitutes some variables in a ratio of sprays; this is an alias of substitute

fromRatioOfPolynomials :: (Eq a, C a) => RatioOfPolynomials a -> RatioOfSprays a Source #

Converts a ratio of polynomials to a ratio of sprays

fromRatioOfQPolynomials :: RatioOfQPolynomials -> RatioOfQSprays Source #

Converts a ratio of rational polynomials to a ratio of rational sprays; this is not a specialization of fromRatioOfPolynomials because RatioOfQPolynomials is RatioOfPolynomials a with a = Rational', not with a = Rational

showRatioOfSprays Source #

Arguments

:: (Eq a, C a) 
=> ((Spray a, Spray a) -> (String, String))

function which prints a pair of sprays that will be applied to the numerator and the denominator

-> (String, String)

pair of braces to enclose the numerator and the denominator

-> String

represents the quotient bar

-> RatioOfSprays a 
-> String 

General function to print a RatioOfSprays object

showRatioOfNumSprays Source #

Arguments

:: (Num a, Ord a, C a) 
=> (a -> String)

function mapping a positive coefficient to a string

-> ([Seq Int] -> [String])

prints the monomials

-> (String, String)

pair of braces to enclose the numerator and the denominator

-> String

represents the quotient bar

-> RatioOfSprays a 
-> String 

Prints a ratio of sprays with numeric coefficients

showRatioOfQSprays Source #

Arguments

:: ([Seq Int] -> [String])

prints the monomials

-> (String, String)

pair of braces to enclose the numerator and the denominator

-> String

represents the quotient bar

-> RatioOfQSprays 
-> String 

Prints a ratio of sprays with rational coefficients

showRatioOfSpraysXYZ Source #

Arguments

:: forall a. (Eq a, C a) 
=> [String]

typically some letters, to represent the variables

-> (a -> String)

function mapping a coefficient to a string, typically show

-> (String, String)

used to enclose the coefficients, usually a pair of braces

-> (String, String)

pair of braces to enclose the numerator and the denominator

-> String

represents the quotient bar

-> RatioOfSprays a 
-> String 

Prints a ratio of sprays

showRatioOfSpraysXYZ' Source #

Arguments

:: (Eq a, C a) 
=> [String]

typically some letters, to represent the variables

-> (a -> String)

function mapping a coefficient to a string, typically show

-> RatioOfSprays a 
-> String 

Prints a ratio of sprays

showRatioOfSpraysX1X2X3 Source #

Arguments

:: forall a. (Eq a, C a) 
=> String

typically a letter, to represent the variables

-> (a -> String)

function mapping a coefficient to a string, typically show

-> (String, String)

used to enclose the coefficients, usually a pair of braces

-> (String, String)

pair of braces to enclose the numerator and the denominator

-> String

represents the quotient bar

-> RatioOfSprays a 
-> String 

Prints a ratio of sprays

showRatioOfSpraysX1X2X3' Source #

Arguments

:: (Eq a, C a) 
=> String

typically a letter, to represent the variables

-> (a -> String)

function mapping a coefficient to a string, typically show

-> RatioOfSprays a 
-> String 

Prints a ratio of sprays

prettyRatioOfQSpraysXYZ Source #

Arguments

:: [String]

typically some letters, to represent the variables

-> RatioOfQSprays 
-> String 

Prints a ratio of sprays with rational coefficients

prettyRatioOfQSpraysX1X2X3 Source #

Arguments

:: String

typically a letter, to represent the variables

-> RatioOfQSprays 
-> String 

Prints a ratio of sprays with rational coefficients, printing the monomials in the style of "x1^2.x2.x3^3"

prettyRatioOfQSprays :: RatioOfQSprays -> String Source #

Prints a ratio of sprays with rational coefficients

prettyRatioOfQSprays rOS == prettyRatioOfQSpraysXYZ ["x","y","z"] rOS

prettyRatioOfQSprays' :: RatioOfQSprays -> String Source #

Prints a ratio of sprays with rational coefficients

prettyRatioOfQSprays' rOS == prettyRatioOfQSpraysXYZ ["X","Y","Z"] rOS

prettyRatioOfNumSpraysXYZ Source #

Arguments

:: (Num a, Ord a, C a, Show a) 
=> [String]

typically some letters, to represent the variables

-> RatioOfSprays a 
-> String 

Prints a ratio of sprays with numeric coefficients

prettyRatioOfNumSpraysX1X2X3 Source #

Arguments

:: (Num a, Ord a, C a, Show a) 
=> String

typically a letter, to represent the variables

-> RatioOfSprays a 
-> String 

Prints a ratio of sprays with numeric coefficients, printing the monomials in the style of "x1^2.x2.x3^3"

prettyRatioOfNumSprays :: (Num a, Ord a, C a, Show a) => RatioOfSprays a -> String Source #

Prints a ratio of sprays with numeric coefficients

prettyRatioOfNumSprays rOS == prettyRatioOfNumSpraysXYZ ["x","y","z"] rOS

prettyRatioOfNumSprays' :: (Num a, Ord a, C a, Show a) => RatioOfSprays a -> String Source #

Prints a ratio of sprays with numeric coefficients

prettyRatioOfNumSprays' rOS == prettyRatioOfNumSpraysXYZ ["X","Y","Z"] rOS

Queries on a spray

getCoefficient :: C a => [Int] -> Spray a -> a Source #

Get coefficient of a term of a spray

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> z = lone 3 :: Spray Int
>>> p = 2 *^ (2 *^ (x^**^3 ^*^ y^**^2)) ^+^ 4*^z ^+^ 5*^unitSpray
>>> getCoefficient [3, 2, 0] p
4
>>> getCoefficient [0, 4] p
0

getConstantTerm :: C a => Spray a -> a Source #

Get the constant term of a spray

getConstantTerm p == getCoefficient [] p

isConstantSpray :: (Eq a, C a) => Spray a -> Bool Source #

Whether a spray is constant; this is an alias of isConstant

sprayTerms :: Spray a -> HashMap (Seq Int) a Source #

Terms of a spray

Evaluation of a spray

evalSpray :: (Eq a, C a) => Spray a -> [a] -> a Source #

Evaluates a spray; this is an alias of evaluate

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> spray = 2*^x^**^2 ^-^ 3*^y
>>> evalSpray spray [2, 1]
5

substituteSpray :: (Eq a, C a) => [Maybe a] -> Spray a -> Spray a Source #

Substitutes some variables in a spray by some values; this is an alias of substitute

>>> x1 = lone 1 :: Spray Int
>>> x2 = lone 2 :: Spray Int
>>> x3 = lone 3 :: Spray Int
>>> p = x1^**^2 ^-^ x2 ^+^ x3 ^-^ unitSpray
>>> p' = substituteSpray [Just 2, Nothing, Just 3] p
>>> putStrLn $ prettyNumSprayX1X2X3 "x" p'
-x2 + 6 

composeSpray :: forall a. (C a, Eq a) => Spray a -> [Spray a] -> Spray a Source #

Sustitutes the variables of a spray with some sprays (e.g. change of variables)

>>> x = lone 1 :: Spray Int
>>> y = lone 2 :: Spray Int
>>> z = lone 3 :: Spray Int
>>> p = x ^+^ y
>>> q = composeSpray p [z, x ^+^ y ^+^ z]
>>> putStrLn $ prettyNumSpray' q
X + Y + 2*Z

evalSpraySpray :: (Eq a, C a) => Spray (Spray a) -> [a] -> Spray a Source #

Evaluates the coefficients of a spray with spray coefficients; see README for an example

Division of a spray

sprayDivision Source #

Arguments

:: forall a. (Eq a, C a) 
=> Spray a

dividend

-> Spray a

divisor

-> (Spray a, Spray a)

(quotient, remainder)

Division of a spray by a spray

sprayDivisionRemainder :: forall a. (Eq a, C a) => Spray a -> [Spray a] -> Spray a Source #

Remainder of the division of a spray by a list of divisors, using the lexicographic ordering of the monomials

Gröbner basis

groebner Source #

Arguments

:: forall a. (Eq a, C a) 
=> [Spray a]

list of sprays

-> Bool

whether to return the reduced basis

-> [Spray a] 

Gröbner basis, always minimal and possibly reduced

groebner sprays True == reduceGroebnerBasis (groebner sprays False)

reduceGroebnerBasis :: forall a. (Eq a, C a) => [Spray a] -> [Spray a] Source #

Reduces a Groebner basis

Symmetric polynomials

esPolynomial Source #

Arguments

:: (C a, Eq a) 
=> Int

number of variables

-> Int

index

-> Spray a 

Elementary symmetric polynomial

>>> putStrLn $ prettySpray' (esPolynomial 3 2)
(1)*x1x2 + (1)*x1x3 + (1)*x2x3

psPolynomial Source #

Arguments

:: forall a. (C a, Eq a) 
=> Int

number of variables

-> Int

power

-> Spray a 

Power sum polynomial

isSymmetricSpray :: forall a. (C a, Eq a) => Spray a -> Bool Source #

Whether a spray is a symmetric polynomial, an inefficient algorithm (use the function with the same name in the jackpolynomials package if you need efficiency)

Resultant and subresultants

resultant Source #

Arguments

:: (Eq a, C a) 
=> Int

indicator of the variable with respect to which the resultant is desired (e.g. 1 for x)

-> Spray a 
-> Spray a 
-> Spray a 

Resultant of two sprays

resultant' Source #

Arguments

:: forall a. (Eq a, C a) 
=> Int

indicator of the variable with respect to which the resultant is desired (e.g. 1 for x)

-> Spray a 
-> Spray a 
-> Spray a 

Resultant of two sprays with coefficients in a field; this function is more efficient than the function resultant

resultant1 :: (Eq a, C a) => Spray a -> Spray a -> a Source #

Resultant of two univariate sprays

subresultants Source #

Arguments

:: (Eq a, C a) 
=> Int

indicator of the variable with respect to which the subresultants are desired (e.g. 1 for x)

-> Spray a 
-> Spray a 
-> [Spray a] 

Subresultants of two sprays

subresultants1 :: (Eq a, C a) => Spray a -> Spray a -> [a] Source #

Subresultants of two univariate sprays

Greatest common divisor

gcdSpray :: forall a. (Eq a, C a) => Spray a -> Spray a -> Spray a Source #

Greatest common divisor of two sprays with coefficients in a field

Matrices

detLaplace :: forall a. (Eq a, C a) => Matrix a -> a Source #

Determinant of a matrix with entries in a ring by using Laplace expansion (this is slow); the numeric-prelude package provides some stuff to deal with matrices over a ring but it does not provide the determinant

detLaplace' :: forall a. (Eq a, C a) => T a -> a Source #

Determinant of a matrix over a ring by using Laplace expansion; this is the same as detLaplace but for a matrix from the numeric-prelude package

characteristicPolynomial :: (Eq a, C a) => Matrix a -> Spray a Source #

Characteristic polynomial of a square matrix

>>> import Data.Matrix (Matrix, fromLists)
>>> m = fromLists [ [12, 16, 4]
>>> , [16, 2, 8]
>>> , [8, 18, 10] ] :: Matrix Int
>>> spray = characteristicPolynomial m
>>> putStrLn $ prettyNumSpray spray
-x^3 + 24*x^2 + 268*x - 1936

Miscellaneous

(.^) :: (C a, Eq a) => Int -> a -> a infixr 7 Source #

Scale by an integer (I do not find this operation in numeric-prelude)

3 .^ x == x Algebra.Additive.+ x Algebra.Additive.+ x

(/>) :: (C k, C k a) => a -> k -> a infixr 7 Source #

Divides by a scalar in a module over a field

fromList :: (C a, Eq a) => [([Int], a)] -> Spray a Source #

Creates a spray from a list of terms

toList :: Spray a -> [([Int], a)] Source #

Spray as a list

fromRationalSpray :: Spray Rational -> Spray Double Source #

Converts a spray with rational coefficients to a spray with double coefficients (useful for evaluation)

leadingTerm :: Spray a -> Monomial a Source #

Leading term of a spray

isPolynomialOf :: forall a. (C a, Eq a) => Spray a -> [Spray a] -> (Bool, Maybe (Spray a)) Source #

Whether a spray can be written as a polynomial of a given list of sprays (the sprays in the list must belong to the same polynomial ring as the spray); this polynomial is returned if this is true

>>> x = lone 1 :: Spray Rational
>>> y = lone 2 :: Spray Rational
>>> p1 = x ^+^ y
>>> p2 = x ^-^ y
>>> p = p1 ^*^ p2
isPolynomialOf p [p1, p2] == (True, Just $ x ^*^ y)

bombieriSpray :: C a => Spray a -> Spray a Source #

Bombieri spray (for internal usage in the 'scubature' library)

collinearSprays :: (Eq a, C a) => Spray a -> Spray a -> Bool Source #

Whether two sprays are equal up to a scalar factor

gegenbauerPolynomial :: Int -> Spray (Spray Rational) Source #

Gegenbauer polynomials; we mainly provide them to give an example of the Spray (Spray a) type

>>> gp = gegenbauerPolynomial 3
>>> putStrLn $ showSprayXYZ' (prettyQSprayXYZ ["alpha"]) ["X"] gp
((4/3)*alpha^3 + 4*alpha^2 + (8/3)*alpha)*X^3 + (-2*alpha^2 - 2*alpha)*X
>>> putStrLn $ prettyQSpray'' $ evalSpraySpray gp [1]
8*X^3 - 4*X