halg-core-0.6.0.0: Core types and functions of halg computational algebra suite.
Safe HaskellNone
LanguageHaskell2010

Algebra.Ring.Polynomial.Class

Description

This module provides abstract classes for finitary polynomial types.

Synopsis

Documentation

class (CoeffRing (Coefficient poly), Eq poly, DecidableZero poly, KnownNat (Arity poly), Module (Scalar (Coefficient poly)) poly, Ring poly, Commutative poly) => IsPolynomial poly where Source #

Polynomial in terms of free associative commutative algebra generated by n-elements. To effectively compute all terms, we need monomials in addition to universality of free object.

Minimal complete definition

(liftMap, monomials | terms'), (sArity | sArity'), (fromMonomial | toPolynomial' | polynomial')

Associated Types

type Coefficient poly :: Type Source #

Coefficient ring of polynomial type.

type Arity poly :: Nat Source #

Arity of polynomial type.

Methods

liftMap :: (Module (Scalar (Coefficient poly)) alg, Ring alg, Commutative alg) => (Ordinal (Arity poly) -> alg) -> poly -> alg Source #

Universal mapping for free algebra. This corresponds to the algebraic substitution operation.

subst :: (Ring alg, Commutative alg, Module (Scalar (Coefficient poly)) alg) => Sized (Arity poly) alg -> poly -> alg Source #

A variant of liftMap, each value is given by Sized.

substWith :: forall m. Ring m => (Coefficient poly -> m -> m) -> Sized (Arity poly) m -> poly -> m Source #

Another variant of liftMap. This function relies on terms'; if you have more efficient implementation, it is encouraged to override this method.

Since 0.6.0.0

sArity' :: poly -> SNat (Arity poly) Source #

Arity of given polynomial.

sArity :: proxy poly -> SNat (Arity poly) Source #

Arity of given polynomial, using type proxy.

arity :: proxy poly -> Integer Source #

Non-dependent version of arity.

injectCoeff :: Coefficient poly -> poly Source #

Inject coefficient into polynomial.

injectCoeff' :: proxy poly -> Coefficient poly -> poly Source #

Inject coefficient into polynomial with result-type explicitly given.

monomials :: poly -> HashSet (Monomial (Arity poly)) Source #

monomials f returns the finite set of all monomials appearing in f.

terms' :: poly -> Map (Monomial (Arity poly)) (Coefficient poly) Source #

monomials f returns the finite set of all terms appearing in f; Term is a finite map from monomials to non-zero coefficient.

coeff' :: Monomial (Arity poly) -> poly -> Coefficient poly Source #

'coeff m f' returns the coefficient of monomial m in polynomial f.

constantTerm :: poly -> Coefficient poly Source #

Calculates constant coefficient.

fromMonomial :: Monomial (Arity poly) -> poly Source #

Inject monic monomial.

toPolynomial' :: (Coefficient poly, Monomial (Arity poly)) -> poly Source #

Inject coefficient with monomial.

polynomial' :: Map (Monomial (Arity poly)) (Coefficient poly) -> poly Source #

Construct polynomial from the given finite mapping from monomials to coefficients.

totalDegree' :: poly -> Int Source #

Returns total degree.

var :: Ordinal (Arity poly) -> poly Source #

var n returns a polynomial representing n-th variable.

mapCoeff' :: (Coefficient poly -> Coefficient poly) -> poly -> poly Source #

Adjusting coefficients of each term.

(>|*) :: Monomial (Arity poly) -> poly -> poly infixl 7 Source #

m >|* f multiplies polynomial f by monomial m.

(*|<) :: poly -> Monomial (Arity poly) -> poly infixl 7 Source #

Flipped version of (>|*)

(!*) :: Coefficient poly -> poly -> poly infixl 7 Source #

_Terms' :: Iso' poly (Map (Monomial (Arity poly)) (Coefficient poly)) Source #

mapMonomial :: (Monomial (Arity poly) -> Monomial (Arity poly)) -> poly -> poly Source #

class (IsMonomialOrder (Arity poly) (MOrder poly), IsPolynomial poly) => IsOrderedPolynomial poly where Source #

Class to lookup ordering from its (type-level) name.

Minimal complete definition

leadingTerm | leadingMonomial, leadingCoeff

Associated Types

type MOrder poly :: Type Source #

Methods

coeff :: OrderedMonomial (MOrder poly) (Arity poly) -> poly -> Coefficient poly Source #

A variant of coeff' which takes OrderedMonomial instead of Monomial

terms :: poly -> Map (OrderedMonomial (MOrder poly) (Arity poly)) (Coefficient poly) Source #

The default implementation is not enough efficient. So it is strongly recomended to give explicit definition to terms.

leadingTerm :: poly -> (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly)) Source #

Leading term with respect to its monomial ordering.

leadingMonomial :: poly -> OrderedMonomial (MOrder poly) (Arity poly) Source #

Leading monomial with respect to its monomial ordering.

leadingCoeff :: poly -> Coefficient poly Source #

Leading coefficient with respect to its monomial ordering.

splitLeadingTerm :: poly -> (Term poly, poly) Source #

Splitting leading term, returning a pair of the leading term and the new polynomial with the leading term subtracted.

orderedMonomials :: poly -> Set (OrderedMonomial (MOrder poly) (Arity poly)) Source #

The collection of all monomials in the given polynomial, with metadata of their ordering.

fromOrderedMonomial :: OrderedMonomial (MOrder poly) (Arity poly) -> poly Source #

A variant of fromMonomial which takes OrderedMonomial as argument.

toPolynomial :: (Coefficient poly, OrderedMonomial (MOrder poly) (Arity poly)) -> poly Source #

A variant of toPolynomial' which takes OrderedMonomial as argument.

polynomial :: Map (OrderedMonomial (MOrder poly) (Arity poly)) (Coefficient poly) -> poly Source #

A variant of polynomial' which takes OrderedMonomial as argument.

The default implementation combines mapKeys and polynomial', hence is not enough efficient. So it is strongly recomended to give explicit definition to polynomial.

(>*) :: OrderedMonomial (MOrder poly) (Arity poly) -> poly -> poly infixl 7 Source #

A variant of (>|*) which takes OrderedMonomial as argument.

(*<) :: poly -> OrderedMonomial (MOrder poly) (Arity poly) -> poly infixl 7 Source #

Flipped version of (>*)

_Terms :: Iso' poly (Map (OrderedMonomial (MOrder poly) (Arity poly)) (Coefficient poly)) Source #

diff :: Ordinal (Arity poly) -> poly -> poly Source #

diff n f partially diffrenciates n-th variable in the given polynomial f. The default implementation uses terms and polynomial and is really naive; please consider overrideing for efficiency.

mapMonomialMonotonic :: (OrderedMonomial (MOrder poly) (Arity poly) -> OrderedMonomial (MOrder poly) (Arity poly)) -> poly -> poly Source #

Same as mapMonomial, but maping function is assumed to be strictly monotonic (i.e. a < b implies f a < f b).

type Term poly = (Coefficient poly, OMonom poly) Source #

type OMonom poly = OrderedMonomial (MOrder poly) (Arity poly) Source #

substCoeff :: IsPolynomial poly => Sized (Arity poly) (Coefficient poly) -> poly -> Coefficient poly Source #

liftMapCoeff :: IsPolynomial poly => (Ordinal (Arity poly) -> Coefficient poly) -> poly -> Coefficient poly Source #

class (DecidableZero r, Ring r, Commutative r, Eq r, Module (Scalar r) (Scalar r)) => CoeffRing r Source #

Constraint synonym for rings that can be used as polynomial coefficient.

Instances

Instances details
(DecidableZero r, Ring r, Commutative r, Eq r) => CoeffRing r Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

oneNorm :: (IsPolynomial poly, Normed (Coefficient poly), Monoidal (Norm (Coefficient poly))) => poly -> Norm (Coefficient poly) Source #

1-norm of given polynomial, taking sum of norms of each coefficients.

maxNorm :: (IsPolynomial poly, Normed (Coefficient poly)) => poly -> Norm (Coefficient poly) Source #

Maximum norm of given polynomial, taking maximum of the norms of each coefficients.

monoize :: (Field (Coefficient poly), IsOrderedPolynomial poly) => poly -> poly Source #

Make the given polynomial monic. If the given polynomial is zero, it returns as it is.

sPolynomial :: (IsOrderedPolynomial poly, Field (Coefficient poly)) => poly -> poly -> poly Source #

sPolynomial calculates the S-Polynomial of given two polynomials.

pDivModPoly :: (k ~ Coefficient poly, Euclidean k, IsOrderedPolynomial poly) => poly -> poly -> (poly, poly) Source #

pDivModPoly f g calculates the pseudo quotient and reminder of f by g.

content :: (IsPolynomial poly, Euclidean (Coefficient poly)) => poly -> Coefficient poly Source #

The content of a polynomial f is the gcd of all its coefficients.

pp :: (Euclidean (Coefficient poly), IsPolynomial poly) => poly -> poly Source #

pp f calculates the primitive part of given polynomial f, namely f / content(f).

injectVarsAtEnd :: forall r r'. (Arity r <= Arity r', IsPolynomial r, IsPolynomial r', Coefficient r ~ Coefficient r') => r -> r' Source #

Similar to injectVars, but injects variables at the end of the target polynomial ring.

See also injectVars and injectVarsOffset.

injectVarsOffset :: forall n r r'. ((n + Arity r) <= Arity r', IsPolynomial r, IsPolynomial r', Coefficient r ~ Coefficient r') => SNat n -> r -> r' Source #

Similar to injectVars, but injectVarsOffset n f injects variables into the first but n variables.

See also injectVars and injectVarsAtEnd.

vars :: forall poly. IsPolynomial poly => [poly] Source #

class Show r => PrettyCoeff r where Source #

Coefficients which admits pretty-printing

Minimal complete definition

Nothing

Methods

showsCoeff :: Int -> r -> ShowSCoeff Source #

Instances

Instances details
PrettyCoeff Int Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Int8 Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Int16 Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Int32 Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Int64 Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Integer Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Natural Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Word8 Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Word16 Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Word32 Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff Word64 Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

(Integral a, PrettyCoeff a) => PrettyCoeff (Ratio a) Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff (Fraction Integer) Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

(PrettyCoeff r, Eq r, Euclidean r) => PrettyCoeff (Fraction r) Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

PrettyCoeff r => PrettyCoeff (Complex r) Source # 
Instance details

Defined in Algebra.Ring.Polynomial.Class

Methods

showsCoeff :: Int -> Complex r -> ShowSCoeff Source #

Reifies p Integer => PrettyCoeff (F p) Source # 
Instance details

Defined in Algebra.Field.Prime

Methods

showsCoeff :: Int -> F p -> ShowSCoeff Source #

(Show a, Reifies r a, DecidableZero a) => PrettyCoeff (Quotient r a) Source # 
Instance details

Defined in Algebra.Ring.Euclidean.Quotient

data ShowSCoeff Source #

Pretty-printing conditional for coefficients. Each returning ShowS must not have any sign.

showsCoeffAsTerm :: ShowSCoeff -> ShowS Source #

ShowS coefficients as term.

showsCoeffAsTerm Vanished "" = ""
showsCoeffAsTerm (Negative (shows "12")) "" = "-12"
showsCoeffAsTerm (Positive (shows "12")) "" = "12"

showsCoeffWithOp :: ShowSCoeff -> ShowS Source #

ShowS coefficients prefixed with infix operator.

(shows 12 . showsCoeffWithOp Vanished) "" = "12"
(shows 12 . showsCoeffWithOp (Negative (shows 34))) "" = "12 - 34"
(shows 12 . showsCoeffWithOp (Positive (shows 34))) "" = "12 + 34"

showsPolynomialWith' Source #

Arguments

:: IsOrderedPolynomial poly 
=> Bool

Whether print multiplication as * or not.

-> (Int -> Coefficient poly -> ShowSCoeff)

Coefficient printer

-> Sized (Arity poly) String

Variables

-> Int

Precision

-> poly

Polynomial

-> ShowS 

Polynomial division

divModPolynomial :: forall poly. (IsOrderedPolynomial poly, Field (Coefficient poly)) => poly -> [poly] -> ([(poly, poly)], poly) infixl 7 Source #

Calculate a polynomial quotient and remainder w.r.t. second argument.

divPolynomial :: (IsOrderedPolynomial poly, Field (Coefficient poly)) => poly -> [poly] -> [(poly, poly)] infixl 7 Source #

A Quotient of given polynomial w.r.t. the second argument.

modPolynomial :: (IsOrderedPolynomial poly, Field (Coefficient poly), Functor t, Foldable t) => poly -> t poly -> poly infixl 7 Source #

Remainder of given polynomial w.r.t. the second argument.

Conversion between polynomial types

convertPolynomial :: (IsOrderedPolynomial poly, IsOrderedPolynomial poly', Coefficient poly ~ Coefficient poly', MOrder poly ~ MOrder poly', Arity poly ~ Arity poly') => poly -> poly' Source #

Conversion between polynomials with the same monomial orderings, coefficents and variables.

convertPolynomial' :: (IsOrderedPolynomial poly, IsOrderedPolynomial poly', Coefficient poly ~ Coefficient poly', Arity poly ~ Arity poly') => poly -> poly' Source #

Conversion between polynomials with the same monomial coefficents and variables.

mapPolynomial :: (IsOrderedPolynomial poly, IsOrderedPolynomial poly') => (Coefficient poly -> Coefficient poly') -> (Ordinal (Arity poly) -> Ordinal (Arity poly')) -> poly -> poly' Source #

Default instances

recipUnitDefault :: (DecidableUnits r, Coefficient poly ~ r, IsPolynomial poly) => poly -> Maybe poly Source #

splitUnitDefault :: (UnitNormalForm r, Coefficient poly ~ r, IsOrderedPolynomial poly) => poly -> (poly, poly) Source #