hspray 0.4.0.0 → 0.5.0.0
raw patch · 5 files changed
+473/−254 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Math.Algebra.Hspray: (*.) :: (Eq a, C a) => a -> RatioOfPolynomials a -> RatioOfPolynomials a
- Math.Algebra.Hspray: class HasVariables b where {
- Math.Algebra.Hspray: groebner :: forall a. (Eq a, C a) => [Spray a] -> Bool -> [Spray a]
- Math.Algebra.Hspray: instance (Algebra.Ring.C a, GHC.Classes.Eq a) => Math.Algebra.Hspray.HasVariables (Math.Algebra.Hspray.Spray a)
- Math.Algebra.Hspray: instance (GHC.Classes.Eq a, Algebra.Field.C a) => Math.Algebra.Hspray.HasVariables (Math.Algebra.Hspray.Polynomial a)
- Math.Algebra.Hspray: instance (GHC.Classes.Eq a, Algebra.Field.C a) => Math.Algebra.Hspray.HasVariables (Math.Algebra.Hspray.RatioOfPolynomials a)
- Math.Algebra.Hspray: instance (GHC.Classes.Eq a, Algebra.Field.C a) => Math.Algebra.Hspray.HasVariables (Math.Algebra.Hspray.RatioOfSprays a)
- Math.Algebra.Hspray: quotientsByGCD :: (Eq a, C a) => Spray a -> Spray a -> (Spray a, Spray a)
- Math.Algebra.Hspray: scalarQ :: Rational' -> Q
- Math.Algebra.Hspray: sprayTerms :: Spray a -> HashMap (Seq Int) a
- Math.Algebra.Hspray: type Q = A Rational'
+ Math.Algebra.Hspray: (+>) :: FunctionLike b => BaseRing b -> b -> b
+ Math.Algebra.Hspray: (<+) :: FunctionLike b => b -> BaseRing b -> b
+ Math.Algebra.Hspray: class FunctionLike b where {
+ Math.Algebra.Hspray: groebnerBasis :: forall a. (Eq a, C a) => [Spray a] -> Bool -> [Spray a]
+ Math.Algebra.Hspray: infixr 6 <+
+ Math.Algebra.Hspray: instance (Algebra.Ring.C a, GHC.Classes.Eq a) => Math.Algebra.Hspray.FunctionLike (Math.Algebra.Hspray.Spray a)
+ Math.Algebra.Hspray: instance (GHC.Classes.Eq a, Algebra.Field.C a) => Math.Algebra.Hspray.FunctionLike (Math.Algebra.Hspray.Polynomial a)
+ Math.Algebra.Hspray: instance (GHC.Classes.Eq a, Algebra.Field.C a) => Math.Algebra.Hspray.FunctionLike (Math.Algebra.Hspray.RatioOfPolynomials a)
+ Math.Algebra.Hspray: instance (GHC.Classes.Eq a, Algebra.Field.C a) => Math.Algebra.Hspray.FunctionLike (Math.Algebra.Hspray.RatioOfSprays a)
+ Math.Algebra.Hspray: isHomogeneousSpray :: (Eq a, C a) => Spray a -> (Bool, Maybe Int)
+ Math.Algebra.Hspray: type Exponents = Seq Int
- Math.Algebra.Hspray: (*^) :: (C a, Eq a) => a -> Spray a -> Spray a
+ Math.Algebra.Hspray: (*^) :: FunctionLike b => BaseRing b -> b -> b
- Math.Algebra.Hspray: (^**^) :: (C a, Eq a) => Spray a -> Int -> Spray a
+ Math.Algebra.Hspray: (^**^) :: (FunctionLike b, C b) => b -> Int -> b
- Math.Algebra.Hspray: (^*^) :: (C a, Eq a) => Spray a -> Spray a -> Spray a
+ Math.Algebra.Hspray: (^*^) :: (FunctionLike b, C b) => b -> b -> b
- Math.Algebra.Hspray: (^+^) :: (C a, Eq a) => Spray a -> Spray a -> Spray a
+ Math.Algebra.Hspray: (^+^) :: (FunctionLike b, C b) => b -> b -> b
- Math.Algebra.Hspray: (^-^) :: (C a, Eq a) => Spray a -> Spray a -> Spray a
+ Math.Algebra.Hspray: (^-^) :: (FunctionLike b, C b) => b -> b -> b
- Math.Algebra.Hspray: Powers :: Seq Int -> Int -> Powers
+ Math.Algebra.Hspray: Powers :: Exponents -> Int -> Powers
- Math.Algebra.Hspray: [exponents] :: Powers -> Seq Int
+ Math.Algebra.Hspray: [exponents] :: Powers -> Exponents
- Math.Algebra.Hspray: changeParameters :: HasVariables b => Spray b -> [VariablesType b] -> Spray b
+ Math.Algebra.Hspray: changeParameters :: (FunctionLike b, Eq b, C b) => Spray b -> [VariablesType b] -> Spray b
- Math.Algebra.Hspray: changeVariables :: HasVariables b => b -> [VariablesType b] -> b
+ Math.Algebra.Hspray: changeVariables :: FunctionLike b => b -> [VariablesType b] -> b
- Math.Algebra.Hspray: derivative :: HasVariables b => Int -> b -> b
+ Math.Algebra.Hspray: derivative :: FunctionLike b => Int -> b -> b
- Math.Algebra.Hspray: evalParametricSpray' :: (HasVariables b, Eq (BaseRing b), C (BaseRing b) b) => Spray b -> [BaseRing b] -> [BaseRing b] -> BaseRing b
+ Math.Algebra.Hspray: evalParametricSpray' :: (FunctionLike b, Eq (BaseRing b), C (BaseRing b) b) => Spray b -> [BaseRing b] -> [BaseRing b] -> BaseRing b
- Math.Algebra.Hspray: evaluate :: HasVariables b => b -> [BaseRing b] -> BaseRing b
+ Math.Algebra.Hspray: evaluate :: FunctionLike b => b -> [BaseRing b] -> BaseRing b
- Math.Algebra.Hspray: evaluateAt :: HasVariables b => [BaseRing b] -> b -> BaseRing b
+ Math.Algebra.Hspray: evaluateAt :: FunctionLike b => [BaseRing b] -> b -> BaseRing b
- Math.Algebra.Hspray: infixl 6 ^-^
+ Math.Algebra.Hspray: infixl 6 +>
- Math.Algebra.Hspray: infixr 7 />
+ Math.Algebra.Hspray: infixr 7 /^
- Math.Algebra.Hspray: isBivariate :: HasVariables b => b -> Bool
+ Math.Algebra.Hspray: isBivariate :: FunctionLike b => b -> Bool
- Math.Algebra.Hspray: isConstant :: HasVariables b => b -> Bool
+ Math.Algebra.Hspray: isConstant :: FunctionLike b => b -> Bool
- Math.Algebra.Hspray: isTrivariate :: HasVariables b => b -> Bool
+ Math.Algebra.Hspray: isTrivariate :: FunctionLike b => b -> Bool
- Math.Algebra.Hspray: isUnivariate :: HasVariables b => b -> Bool
+ Math.Algebra.Hspray: isUnivariate :: FunctionLike b => b -> Bool
- Math.Algebra.Hspray: numberOfParameters :: HasVariables b => Spray b -> Int
+ Math.Algebra.Hspray: numberOfParameters :: FunctionLike b => Spray b -> Int
- Math.Algebra.Hspray: numberOfVariables :: HasVariables b => b -> Int
+ Math.Algebra.Hspray: numberOfVariables :: FunctionLike b => b -> Int
- Math.Algebra.Hspray: permuteVariables :: HasVariables b => [Int] -> b -> b
+ Math.Algebra.Hspray: permuteVariables :: FunctionLike b => [Int] -> b -> b
- Math.Algebra.Hspray: showNumSpray :: (Num a, Ord a) => ([Seq Int] -> [String]) -> (a -> String) -> Spray a -> String
+ Math.Algebra.Hspray: showNumSpray :: (Num a, Ord a) => ([Exponents] -> [String]) -> (a -> String) -> Spray a -> String
- Math.Algebra.Hspray: showQSpray :: ([Seq Int] -> [String]) -> QSpray -> String
+ Math.Algebra.Hspray: showQSpray :: ([Exponents] -> [String]) -> QSpray -> String
- Math.Algebra.Hspray: showQSpray' :: ([Seq Int] -> [String]) -> QSpray' -> String
+ Math.Algebra.Hspray: showQSpray' :: ([Exponents] -> [String]) -> QSpray' -> String
- Math.Algebra.Hspray: showRatioOfNumSprays :: (Num a, Ord a, C a) => (a -> String) -> ([Seq Int] -> [String]) -> (String, String) -> String -> RatioOfSprays a -> String
+ Math.Algebra.Hspray: showRatioOfNumSprays :: (Num a, Ord a, C a) => (a -> String) -> ([Exponents] -> [String]) -> (String, String) -> String -> RatioOfSprays a -> String
- Math.Algebra.Hspray: showRatioOfQSprays :: ([Seq Int] -> [String]) -> (String, String) -> String -> RatioOfQSprays -> String
+ Math.Algebra.Hspray: showRatioOfQSprays :: ([Exponents] -> [String]) -> (String, String) -> String -> RatioOfQSprays -> String
- Math.Algebra.Hspray: showSpray :: (a -> String) -> (String, String) -> ([Seq Int] -> [String]) -> Spray a -> String
+ Math.Algebra.Hspray: showSpray :: (a -> String) -> (String, String) -> ([Exponents] -> [String]) -> Spray a -> String
- Math.Algebra.Hspray: substitute :: HasVariables b => [Maybe (BaseRing b)] -> b -> b
+ Math.Algebra.Hspray: substitute :: FunctionLike b => [Maybe (BaseRing b)] -> b -> b
- Math.Algebra.Hspray: substituteParameters :: (HasVariables b, Eq (BaseRing b), C (BaseRing b)) => Spray b -> [BaseRing b] -> Spray (BaseRing b)
+ Math.Algebra.Hspray: substituteParameters :: (FunctionLike b, Eq (BaseRing b), C (BaseRing b)) => Spray b -> [BaseRing b] -> Spray (BaseRing b)
- Math.Algebra.Hspray: swapVariables :: HasVariables b => (Int, Int) -> b -> b
+ Math.Algebra.Hspray: swapVariables :: FunctionLike b => (Int, Int) -> b -> b
Files
- CHANGELOG.md +25/−1
- README.md +3/−0
- hspray.cabal +1/−1
- src/Math/Algebra/Hspray.hs +324/−200
- tests/Main.hs +120/−52
CHANGELOG.md view
@@ -228,7 +228,8 @@ * For this reason, the Jack polynomials with a symbolic Jack parameter, implemented in the 'jackpolynomials' package, are represented by -`ParametricSpray` sprays in a new version of the package. +`ParametricSpray` sprays in a new version of the package, while there were +previously represented by `OneParameterSpray` sprays. * Slight improvements of the code in general. @@ -236,3 +237,26 @@ `lone n ^**^ p`. * Function `monomial` to construct monomials like `x_1^4.x_3^7`. + + +## 0.5.0.0 - 2024-05-01 + +* The class `HasVariables` has been renamed to `FunctionLike`, and the +arithmetic operations for sprays (`^+^`, `^-^`, `^*^`, `^**^`, `*^`) have +been moved to this class. Therefore it is now possible to apply these +operations to the ratios of sprays. Moreover, there are two new operators in +this class, `(+>)` and `(<+)`, which allow to add a constant to an object of +this class. For example, `x +> spray` gives the same result as +`constantSpray x ^+^ spray` but is more efficient. + +* There was an error in `gcdSpray`. + +* There was a small mistake in `collinearSprays`. + +* The functions `changeParameters` and `changeVariables` did not remove the +possibly null terms of their result. + +* The function `groebner` has been renamed to `groebnerBasis`. + +* Function `isHomogeneousSpray`, to check whether a spray defines a homogeneous +polynomial.
README.md view
@@ -375,6 +375,9 @@ -- True ``` +Actually, as of version 0.5.0.0, it is possible to apply the operations +`^+^`, `^-^`, `^*^`, `^**^` and `*^` to the ratios of sprays. + The `RatioOfSprays a` type also has left and right module instances over `a` and over `Spray a` as well. That means you can multiply a ratio of sprays by a scalar and by a spray, by using, depending on the side, either `*>` or `<*`:
hspray.cabal view
@@ -1,5 +1,5 @@ name: hspray -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Multivariate polynomials and fractions of multivariate polynomials. description: Manipulation of multivariate polynomials over a commutative ring and fractions of multivariate polynomials over a commutative field, Gröbner bases, resultant and subresultants, and greatest common divisor. It is possible to deal with multivariate polynomials whose coefficients are fractions of multivariate polynomials, and they can be interpreted as parametric polynomials with symbolic parameters. homepage: https://github.com/stla/hspray#readme
src/Math/Algebra/Hspray.hs view
@@ -20,12 +20,13 @@ module Math.Algebra.Hspray ( -- * Classes - HasVariables (..) + FunctionLike (..) , isConstant , isUnivariate , isBivariate , isTrivariate -- * Main types + , Exponents , Powers (..) , Spray , QSpray @@ -41,13 +42,6 @@ , unitSpray , zeroSpray , constantSpray - -- * Operations on sprays - , (*^) - , (/^) - , (^+^) - , (^-^) - , (^*^) - , (^**^) -- * Showing a spray , prettySpray , prettySpray' @@ -75,17 +69,19 @@ , prettyQSpray' , prettyQSpray''' -- * Univariate polynomials and fractions of univariate polynomials + -- + -- | The univariate polynomials and the fractions of univariate polynomials + -- are used to defined the `OneParameterSpray` sprays, which represent + -- multivariate polynomials depending on a unique parameter. These sprays + -- lost their interest in version 0.4.0.0 (see CHANGELOG or README). , A (..) , Rational' - , Q - , scalarQ , Polynomial - , RatioOfPolynomials , QPolynomial + , RatioOfPolynomials , RatioOfQPolynomials , prettyRatioOfPolynomials , prettyRatioOfQPolynomials - , (*.) , constPoly , polyFromCoeffs , soleParameter @@ -93,7 +89,12 @@ , qpolyFromCoeffs , qsoleParameter , evalRatioOfPolynomials - -- * One-parameter sprays + -- * One-parameter sprays + -- + -- | The `OneParameterSpray` sprays represent multivariate polynomials with + -- coefficients depending on a unique parameter. These sprays lost their + -- interest in version 0.4.0.0 (see CHANGELOG or README). One can use the + -- more general `ParametricSpray` sprays instead. , OneParameterSpray , OneParameterQSpray , prettyOneParameterSprayX1X2X3 @@ -109,6 +110,9 @@ , evalOneParameterSpray' , evalOneParameterSpray'' -- * Ratios of sprays + -- + -- | An object of type `RatioOfSprays` represents a fraction of two + -- multivariate polynomials. , RatioOfSprays (..) , RatioOfQSprays , (%:%) @@ -146,7 +150,7 @@ -- -- | There are three types of parametric sprays: @OneParameterSpray@, -- @SimpleParametricSpray@ and @ParametricSpray@. These are sprays of - -- type @Spray b@ where @b@ has the class @HasVariables@. When we say + -- type @Spray b@ where @b@ has the class @FunctionLike@. When we say -- \"parametric spray\" in the documentation, we mean either -- such a spray or more precisely a @ParametricSpray@ spray. , SimpleParametricSpray @@ -179,7 +183,7 @@ , getCoefficient , getConstantTerm , isConstantSpray - , sprayTerms + , isHomogeneousSpray -- * Evaluation of a spray , evalSpray , substituteSpray @@ -189,7 +193,7 @@ , sprayDivision , sprayDivisionRemainder -- * Gröbner basis - , groebner + , groebnerBasis , reduceGroebnerBasis -- * Symmetric polynomials , esPolynomial @@ -210,6 +214,7 @@ -- * Miscellaneous , (.^) , (/>) + , (/^) , fromList , toList , fromRationalSpray @@ -217,7 +222,6 @@ , isPolynomialOf , bombieriSpray , collinearSprays - , quotientsByGCD ) where import qualified Algebra.Additive as AlgAdd import qualified Algebra.Differential as AlgDiff @@ -241,6 +245,7 @@ , foldl1' , uncons ) +import Data.List.Extra ( allSame ) import Data.Matrix ( Matrix , fromLists , minorMatrix @@ -286,9 +291,9 @@ -- Classes -------------------------------------------------------------------- --- | A spray represents a multivariate polynomial so it has some variables. We +-- | A spray represents a multivariate polynomial so it like a function. We -- introduce a class because it will be assigned to the ratios of sprays too. -class HasVariables b where +class FunctionLike b where -- | Number of variables numberOfVariables :: b -> Int @@ -335,6 +340,43 @@ -- | The type of the variables (this is @Spray a@ for both @Spray a@ and @RatioOfSprays a@) type family VariablesType b + infixl 6 ^+^ + -- | Addition + (^+^) :: (AlgAdd.C b) => b -> b -> b + (^+^) = (AlgAdd.+) + + infixl 6 ^-^ + -- | Substraction + (^-^) :: (AlgAdd.C b) => b -> b -> b + (^-^) = (AlgAdd.-) + + infixl 7 ^*^ + -- | Multiplication + (^*^) :: (AlgRing.C b) => b -> b -> b + (^*^) = (AlgRing.*) + + infixr 8 ^**^ + -- | Power + (^**^) :: (AlgRing.C b) => b -> Int -> b + (^**^) p k = p AlgRing.^ fromIntegral k + + infixr 7 *^ + -- | Multiply by a scalar + (*^) :: BaseRing b -> b -> b + + infixl 6 +> + -- | Add a constant at left + -- + -- prop> x +> spray == constantSpray x ^+^ spray + (+>) :: BaseRing b -> b -> b + + infixr 6 <+ + -- | Add a constant at right + -- + -- prop> object <+ x == x +> object + (<+) :: b -> BaseRing b -> b + (<+) = flip (+>) + -- | Evaluation (replacing the variables with some values) -- -- >>> x = lone 1 :: Spray Int @@ -342,19 +384,18 @@ -- >>> spray = 2*^x^**^2 ^-^ 3*^y -- >>> evaluate spray [2, 1] -- 5 - evaluate :: b -> [BaseRing b] -> BaseRing b + evaluate :: + b -- ^ function-like object to be evaluated, e.g. a spray + -> [BaseRing b] -- ^ list of values to be substituted to its variables + -> BaseRing b -- | Flipped version of @evaluate@ -- - -- >>> x = lone 1 :: Spray Int - -- >>> y = lone 2 :: Spray Int - -- >>> spray = 2*^x^**^2 ^-^ 3*^y - -- >>> evaluateAt [2, 1] spray - -- 5 + -- prop> evaluateAt [2, 1] spray == evaluate spray [2, 1] evaluateAt :: [BaseRing b] -> b -> BaseRing b evaluateAt = flip evaluate - -- | Substitution (partial evaluation) + -- | Partial evaluation -- -- >>> x1 = lone 1 :: Spray Int -- >>> x2 = lone 2 :: Spray Int @@ -363,9 +404,12 @@ -- >>> spray' = substitute [Just 2, Nothing, Just 3] spray -- >>> putStrLn $ prettyNumSprayX1X2X3 "x" spray' -- -x2 + 6 - substitute :: [Maybe (BaseRing b)] -> b -> b + substitute :: + [Maybe (BaseRing b)] -- ^ @Just x@ to replace the variable with @x@, @Nothing@ for no replacement + -> b -- ^ function-like object to be partially evaluated + -> b - -- | Change variables + -- | Polynomial change of variables -- -- >>> x = lone 1 :: Spray Int -- >>> y = lone 2 :: Spray Int @@ -374,27 +418,27 @@ -- >>> putStrLn $ prettyNumSpray' spray' -- X^2 - Y^2 changeVariables :: - b -- ^ object with variables such as a spray + b -- ^ function-like object such as a spray -> [VariablesType b] -- ^ list of new variables -> b --- | Whether an object of class `HasVariables` is constant -isConstant :: HasVariables b => b -> Bool +-- | Whether a function-like object has a constant value +isConstant :: FunctionLike b => b -> Bool isConstant f = numberOfVariables f == 0 --- | Whether an object of class `HasVariables` is univariate; it is considered +-- | Whether a function-like object represents an univariate function; it is considered -- that it is univariate if it is constant -isUnivariate :: HasVariables b => b -> Bool +isUnivariate :: FunctionLike b => b -> Bool isUnivariate f = numberOfVariables f <= 1 --- | Whether an object of class `HasVariables` is bivariate; it is considered +-- | Whether a function-like object represents a bivariate function; it is considered -- that it is bivariate if it is univariate -isBivariate :: HasVariables b => b -> Bool +isBivariate :: FunctionLike b => b -> Bool isBivariate f = numberOfVariables f <= 2 --- | Whether an object of class `HasVariables` is trivariate; it is considered +-- | Whether a function-like object represents a trivariate function; it is considered -- that it is trivariate if it is bivariate -isTrivariate :: HasVariables b => b -> Bool +isTrivariate :: FunctionLike b => b -> Bool isTrivariate f = numberOfVariables f <= 3 @@ -422,23 +466,28 @@ -- Univariate polynomials and ratios of univariate polynomials ---------------- +-- | The new type @A a@ is used to attribute some instances to the +-- type @Polynomial a@; it is needed to avoid orphan instances. newtype A a = A a deriving (Eq, Show, AlgAdd.C, AlgRing.C, AlgField.C) +-- | The type @Rational'@ is used to introduce the univariate polynomials +-- with rational coefficients (`QPolynomial`). It is similar to the well-known +-- type @Rational@ (actually these two types are the same but @Rational'@ has +-- more instances and we need them for the univariate polynomials). type Rational' = NumberRatio.Rational -type Q = A Rational' --- | Identify a rational to a @A Rational'@ element -scalarQ :: Rational' -> Q -scalarQ = A - +-- | The type @Polynomial a@ is used to represent univariate polynomials. type Polynomial a = MathPol.T (A a) -type RatioOfPolynomials a = NumberRatio.T (Polynomial a) type QPolynomial = Polynomial Rational' + +-- The type @RatioOfPolynomials a@ is used to represent fractions of +-- univariate polynomials. +type RatioOfPolynomials a = NumberRatio.T (Polynomial a) type RatioOfQPolynomials = RatioOfPolynomials Rational' -instance (Eq a, AlgField.C a) => HasVariables (Polynomial a) where +instance (Eq a, AlgField.C a) => FunctionLike (Polynomial a) where -- numberOfVariables :: Polynomial a -> Int numberOfVariables p = case MathPol.degree p of @@ -449,6 +498,12 @@ -- type VariablesType (Polynomial a) = Polynomial a -- + (*^) :: a -> Polynomial a -> Polynomial a + (*^) lambda pol = constPoly lambda AlgRing.* pol + -- + (+>) :: a -> Polynomial a -> Polynomial a + (+>) x pol = constPoly x AlgAdd.+ pol + -- evaluate :: Polynomial a -> [a] -> a evaluate p xs = get (MathPol.evaluate p (A (xs !! 0))) where @@ -475,7 +530,7 @@ changeVariables :: Polynomial a -> [Polynomial a] -> Polynomial a changeVariables p ps = MathPol.compose p (ps !! 0) -instance (Eq a, AlgField.C a) => HasVariables (RatioOfPolynomials a) where +instance (Eq a, AlgField.C a) => FunctionLike (RatioOfPolynomials a) where numberOfVariables :: RatioOfPolynomials a -> Int numberOfVariables (p :% q) = max (numberOfVariables p) (numberOfVariables q) @@ -484,6 +539,12 @@ -- type VariablesType (RatioOfPolynomials a) = Polynomial a -- + (*^) :: a -> RatioOfPolynomials a -> RatioOfPolynomials a + (*^) lambda rOP = A lambda AlgMod.*> rOP + -- + (+>) :: a -> RatioOfPolynomials a -> RatioOfPolynomials a + (+>) x rOP = NumberRatio.fromValue (constPoly x) AlgAdd.+ rOP + -- evaluate :: RatioOfPolynomials a -> [a] -> a evaluate r xs = evaluate (NumberRatio.numerator r) xs AlgField./ evaluate (NumberRatio.denominator r) xs @@ -557,11 +618,6 @@ (<*) :: RatioOfPolynomials a -> Polynomial a -> RatioOfPolynomials a r <* p = p AlgMod.*> r -infixr 7 *. --- | Scale a ratio of univariate polynomials by a scalar -(*.) :: (Eq a, AlgField.C a) => a -> RatioOfPolynomials a -> RatioOfPolynomials a -(*.) lambda rop = A lambda AlgMod.*> rop - -- | Constant univariate polynomial constPoly :: a -> Polynomial a constPoly x = MathPol.const (A x) @@ -618,7 +674,7 @@ indices = findIndices (/= A AlgAdd.zero) coeffs get :: A a -> a get (A x) = x - terms = map (\i -> get (coeffs!!i) *^ lone' 1 i) indices + terms = [get (coeffs !! i) *^ lone' 1 i | i <- indices] qPolynomialToQSpray :: QPolynomial -> QSpray qPolynomialToQSpray pol = AlgAdd.sum terms @@ -627,7 +683,7 @@ indices = findIndices (/= A 0) coeffs get :: A Rational' -> Rational get (A x) = NumberRatio.numerator x DR.:% NumberRatio.denominator x - terms = map (\i -> get (coeffs!!i) *^ qlone' 1 i) indices + terms = [get (coeffs !! i) *^ qlone' 1 i | i <- indices] -- helper function; it encloses a string between two given delimiters bracify :: (String, String) -> String -> String @@ -877,7 +933,7 @@ evalOneParameterTerm :: (Eq a, AlgField.C a) => [a] -> Term (RatioOfPolynomials a) -> RatioOfPolynomials a evalOneParameterTerm xs (powers, coeff) = - AlgRing.product (zipWith (AlgRing.^) xs pows) *. coeff + AlgRing.product (zipWith (AlgRing.^) xs pows) *^ coeff where pows = DF.toList (fromIntegral <$> exponents powers) @@ -892,12 +948,35 @@ -- Sprays --------------------------------------------------------------------- +type Exponents = Seq Int + +-- | The type @Powers@ is used to represent the exponents of the monomial +-- occurring in a term of a spray. The integer in the field @nvariables@ is +-- the number of variables involved in this monomial (it is 3, not 2, for a +-- monomial such as @x^2.z^3@, because the exponents of this monomial is the +-- sequence @(2, 0, 3)@). Actually this integer is always the length of the +-- sequence in the field @exponents@. The reason of the presence of the field +-- @nvariables@ is that I thought that it was necessary when I started to +-- develop the package, but now I think it is useless. The type @Powers@ will +-- possibly be abandoned in a future version of the package. However we cannot +-- simply use the type `Exponents` to represent the exponents, because two +-- sequences of exponents that differ only by some trailing zeros must be +-- considered as identical, and they are considered as such with the type +-- @Powers@ thanks to its @Eq@ instance. Instead of @Powers@, a new type +-- encapsulating the `Exponents` type with such an @Eq@ instance should be +-- enough to represent the exponents. data Powers = Powers - { exponents :: Seq Int + { exponents :: Exponents , nvariables :: Int } deriving Show +nullPowers :: Powers +nullPowers = Powers S.empty 0 + +powerize :: Exponents -> Powers +powerize expnts = Powers expnts (S.length expnts) + instance Eq Powers where (==) :: Powers -> Powers -> Bool pows1 == pows2 = expts1' == expts2' @@ -909,14 +988,14 @@ hashWithSalt k pows = hashWithSalt k (exponents pows, nvariables pows) -- | append trailing zeros -growSequence :: Seq Int -> Int -> Int -> Seq Int +growSequence :: Exponents -> Int -> Int -> Exponents growSequence s m n = s >< S.replicate (n - m) 0 -growSequence' :: Int -> Seq Int -> Seq Int +growSequence' :: Int -> Exponents -> Exponents growSequence' n s = growSequence s (S.length s) n -- | append trailing zeros to get the same length -harmonize :: (Powers, Powers) -> (Seq Int, Seq Int) +harmonize :: (Powers, Powers) -> (Exponents, Exponents) harmonize (pows1, pows2) = (e1', e2') where e1 = exponents pows1 @@ -927,21 +1006,47 @@ then (growSequence e1 n1 n2, e2) else (e1, growSequence e2 n2 n1) -makePowers :: Seq Int -> Powers -makePowers expnts = Powers s (S.length s) +makePowers :: Exponents -> Powers +makePowers expnts = powerize s where s = dropWhileR (== 0) expnts -type Term a = (Powers, a) +-- | An object of type @Spray a@ represents a multivariate polynomial whose +-- coefficients are represented by the objects of type @a@, which must have +-- a ring instance in order that we can add and multiply two polynomials. type Spray a = HashMap Powers a + +-- | Most often, one deals with sprays with rational coefficients, so we +-- dedicate a type alias for such sprays. type QSpray = Spray Rational + +-- | The type `Rational'` is helpful when dealing with `OneParameterSpray` +-- sprays, but this type of sprays lost its interest in version 0.4.0.0 +-- (see CHANGELOG or README). type QSpray' = Spray Rational' -instance (AlgRing.C a, Eq a) => HasVariables (Spray a) where +type SafeSpray a = HashMap Exponents a + +-- An object of type @Term a@ represents a term of a @Spray a@ spray. Applying +-- @Data.HashMap.Strict.toList@ to a @Spray a@ spray yields a list of @Term a@ +-- objects. This type has probably no interest for the user, it is exported +-- because it possibly has an interest for internal usage in a package using +-- __hspray__. +type Term a = (Powers, a) + +instance (AlgRing.C a, Eq a) => FunctionLike (Spray a) where type BaseRing (Spray a) = a -- type VariablesType (Spray a) = Spray a -- + (*^) :: a -> Spray a -> Spray a + (*^) lambda pol = lambda AlgMod.*> pol + -- + (+>) :: a -> Spray a -> Spray a + (+>) x spray = if x == AlgAdd.zero + then spray + else addTerm spray (nullPowers, x) + -- evaluate :: Spray a -> [a] -> a evaluate spray xyz = if length xyz >= numberOfVariables spray then evalSprayHelper xyz spray @@ -1028,7 +1133,7 @@ terms = [ derivTerm term | term <- HM.toList p ] derivTerm :: Term a -> Term a derivTerm (pows, coef) = if i' >= S.length expts - then (Powers S.empty 0, AlgAdd.zero) + then (nullPowers, AlgAdd.zero) else (pows', coef') where i' = i - 1 @@ -1118,34 +1223,6 @@ signum _ = error "Prelude.Num.signum: inappropriate abstraction" -} -infixl 6 ^+^ --- | Addition of two sprays -(^+^) :: (AlgAdd.C a, Eq a) => Spray a -> Spray a -> Spray a -(^+^) p q = p AlgAdd.+ q - -infixl 6 ^-^ --- | Substraction of two sprays -(^-^) :: (AlgAdd.C a, Eq a) => Spray a -> Spray a -> Spray a -(^-^) p q = p AlgAdd.- q - -infixl 7 ^*^ --- | Multiply two sprays -(^*^) :: (AlgRing.C a, Eq a) => Spray a -> Spray a -> Spray a -(^*^) p q = p AlgRing.* q - -infixr 8 ^**^ --- | Power of a spray -(^**^) :: (AlgRing.C a, Eq a) => Spray a -> Int -> Spray a -(^**^) p n = if n >= 0 - then p AlgRing.^ fromIntegral n - else error "(^**^): negative power of a spray is not allowed." - -infixr 7 *^ --- | Scales a spray by a scalar; if you import the /Algebra.Module/ module --- then it is the same operation as @(*>)@ from this module -(*^) :: (AlgRing.C a, Eq a) => a -> Spray a -> Spray a -(*^) lambda pol = lambda AlgMod.*> pol - infixr 7 /^ -- | Divides a spray by a scalar; you can equivalently use `(/>)` if the type -- of the scalar is not ambiguous @@ -1159,7 +1236,7 @@ -- | helper function for lone and lone' lonePower :: Int -> Int -> Powers lonePower n p = if n == 0 - then Powers S.empty 0 + then nullPowers else Powers (S.replicate (n - 1) 0 |> p) n -- | The @n@-th polynomial variable @x_n@ as a spray; one usually builds a @@ -1215,11 +1292,11 @@ -> Spray a monomial nps = if null nps then unitSpray - else HM.singleton (Powers expnts (S.length expnts)) AlgRing.one + else HM.singleton (powerize expnts) AlgRing.one where nps' = nub nps nv = maximum (map fst nps') - expnts = S.fromList $ map (\i -> fromMaybe 0 (lookup i nps')) [1 .. nv] + expnts = S.fromList $ [fromMaybe 0 (lookup i nps') | i <- [1 .. nv]] -- | Monomial rational spray, a specialization of 'monomial' -- @@ -1233,7 +1310,7 @@ -- -- prop> spray ^*^ unitSpray == spray unitSpray :: AlgRing.C a => Spray a -unitSpray = HM.singleton (Powers S.empty 0) AlgRing.one +unitSpray = HM.singleton nullPowers AlgRing.one -- | The null spray -- @@ -1251,7 +1328,7 @@ constantSpray :: (Eq a, AlgAdd.C a) => a -> Spray a constantSpray c = if c == AlgAdd.zero then HM.empty - else HM.singleton (Powers S.empty 0) c + else HM.singleton nullPowers c -- | Get coefficient of a term of a spray -- @@ -1277,11 +1354,11 @@ -- -- prop> getConstantTerm p == getCoefficient [] p getConstantTerm :: AlgAdd.C a => Spray a -> a -getConstantTerm = getCoefficient' (Powers S.empty 0) +getConstantTerm = getCoefficient' nullPowers -- | remove the constant term of a spray removeConstantTerm :: Spray a -> Spray a -removeConstantTerm = HM.delete (Powers S.empty 0) +removeConstantTerm = HM.delete nullPowers -- | Whether a spray is constant; same as `isConstant` isConstantSpray :: (Eq a, AlgRing.C a) => Spray a -> Bool @@ -1312,7 +1389,7 @@ -- same as `substituteParameters` evalSpraySpray :: (Eq a, AlgRing.C a) => Spray (Spray a) -> [a] -> Spray a evalSpraySpray spray xyz = if length xyz >= n - then HM.map (evalSprayHelper xyz) spray + then removeZeroTerms $ HM.map (evalSprayHelper xyz) spray else error "evalSpraySpray: not enough values provided." where n = maximum (HM.elems $ HM.map numberOfVariables spray) @@ -1349,7 +1426,7 @@ -- X + Y + 2*Z composeSpray :: forall a. (AlgRing.C a, Eq a) => Spray a -> [Spray a] -> Spray a -composeSpray p = evalSpray (identify p) +composeSpray p = removeZeroTerms . evalSpray (identify p) where identify :: Spray a -> Spray (Spray a) identify = HM.map constantSpray @@ -1369,7 +1446,7 @@ showSpray :: (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 + -> ([Exponents] -> [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 showSpray showCoef braces showMonomials spray = @@ -1377,11 +1454,9 @@ then "0" else unpack $ intercalate (pack " + ") stringTerms where - terms = sortBy (flip compare `on` fexpts) (HM.toList spray) - fexpts term = exponents $ fst term - coeffs = map snd terms - powers = map (exponents . fst) terms - stringMonomials = showMonomials powers + terms = orderedTerms spray + (powers, coeffs) = unzip terms + stringMonomials = showMonomials (map exponents powers) stringTerms = zipWith f coeffs stringMonomials f coeff smonomial | smonomial == "" = pack scoeff' @@ -1503,10 +1578,10 @@ prettySpray' = prettySprayX1X2X3 "x" -- | showMonomialOld "x" [0, 2, 1] = x^(0, 2, 1) -showMonomialsOld :: String -> [Seq Int] -> [String] +showMonomialsOld :: String -> [Exponents] -> [String] showMonomialsOld var = map (showMonomialOld var) where - showMonomialOld :: String -> Seq Int -> String + showMonomialOld :: String -> Exponents -> String showMonomialOld a pows = unpack $ append (pack x) (cons '(' $ snoc string ')') where @@ -1532,7 +1607,7 @@ -- possible usage in other packages showNumSpray :: (Num a, Ord a) - => ([Seq Int] -> [String]) -- ^ function mapping a list of monomial exponents to a list of strings representing the monomials + => ([Exponents] -> [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 @@ -1541,7 +1616,7 @@ then "0" else concat $ zipWith (++) stringSigns stringTerms where - terms = sortBy (flip compare `on` (exponents . fst)) (HM.toList spray) + terms = orderedTerms spray coeffs = map snd terms (firstCoeff, otherCoeffs) = fromJust (uncons coeffs) firstSign = if firstCoeff > 0 then "" else "-" @@ -1559,7 +1634,7 @@ scoeff = if acoeff == 1 then "" else showCoeff acoeff -- | showMonomialX1X2X3 "X" [0, 2, 1] = "X2^2.X3" -showMonomialX1X2X3 :: String -> Seq Int -> Text +showMonomialX1X2X3 :: String -> Exponents -> Text showMonomialX1X2X3 x pows = x1x2x3 where f i p @@ -1568,15 +1643,15 @@ | otherwise = pack $ x ++ show i ++ "^" ++ show p indices = S.findIndicesL (/= 0) pows x1x2x3 = - intercalate (pack ".") (map (\i -> f (i+1) (pows `index` i)) indices) + intercalate (pack ".") [f (i+1) (pows `index` i) | i <- indices] -- | showMonomialsX1X2X3 "X" [[0, 2, 1], [1, 2]] = ["X2^2.X3", "X1.X2"] -showMonomialsX1X2X3 :: String -> [Seq Int] -> [String] +showMonomialsX1X2X3 :: String -> [Exponents] -> [String] showMonomialsX1X2X3 x = map (unpack . showMonomialX1X2X3 x) -- | showMonomialXYZ ["X", "Y", "Z"] 3 [1, 2, 1] = X.Y^2.Z -- showMonomialXYZ ["X", "Y", "Z"] 3 [1, 2, 1, 2] = X1.X2^2.X3.X4^2 -showMonomialXYZ :: [String] -> Int -> Seq Int -> Text +showMonomialXYZ :: [String] -> Int -> Exponents -> Text showMonomialXYZ letters n pows = if n <= length letters then xyz else showMonomialX1X2X3 (letters !! 0) pows @@ -1587,11 +1662,12 @@ | otherwise = pack $ letter ++ "^" ++ show p indices = S.findIndicesL (/= 0) pows xyz = intercalate (pack ".") - (map (\i -> f (letters!!i) (pows `index` i)) indices) + [f (letters !! i) (pows `index` i) | i <- indices] -- | showMonomialsXYZ ["X", "Y", "Z"] [[0, 2, 1], [1, 2]] = ["Y^2.Z", "X.Y^2"] -showMonomialsXYZ :: [String] -> [Seq Int] -> [String] -showMonomialsXYZ letters powers = map (unpack . showMonomialXYZ letters n) powers +showMonomialsXYZ :: [String] -> [Exponents] -> [String] +showMonomialsXYZ letters powers = + map (unpack . showMonomialXYZ letters n) powers where n = maximum (map S.length powers) @@ -1649,14 +1725,14 @@ -- | Prints a `QSpray`; for internal usage but exported for usage in other packages showQSpray :: - ([Seq Int] -> [String]) -- ^ function printing monomials + ([Exponents] -> [String]) -- ^ function printing monomials -> QSpray -> String showQSpray showMonomials = showNumSpray showMonomials showRatio -- | Prints a `QSpray'`; for internal usage but exported for usage in other packages showQSpray' :: - ([Seq Int] -> [String]) -- ^ function mapping a list of monomials exponents to a list of strings + ([Exponents] -> [String]) -- ^ function mapping a list of monomials exponents to a list of strings -> QSpray' -> String showQSpray' showMonomials = showNumSpray showMonomials showRatio' @@ -1744,10 +1820,25 @@ -- misc ----------------------------------------------------------------------- --- | Terms of a spray -sprayTerms :: Spray a -> HashMap (Seq Int) a -sprayTerms = HM.mapKeys exponents +-- | spray as safe spray +safeSpray :: Spray a -> SafeSpray a +safeSpray = HM.mapKeys exponents +getCoefficient'' :: AlgAdd.C a => Exponents -> SafeSpray a -> a +getCoefficient'' powers spray' = + fromMaybe AlgAdd.zero (HM.lookup powers spray') + +getConstantTerm'' :: AlgAdd.C a => SafeSpray a -> a +getConstantTerm'' = getCoefficient'' S.empty + +removeConstantTerm'' :: SafeSpray a -> SafeSpray a +removeConstantTerm'' = HM.delete S.empty + +-- | ordered terms of a spray +orderedTerms :: Spray a -> [Term a] +orderedTerms spray = + sortBy (flip compare `on` (exponents . fst)) (HM.toList spray) + -- | Spray as a list toList :: Spray a -> [([Int], a)] toList p = HM.toList $ HM.mapKeys (DF.toList . exponents) p @@ -1765,9 +1856,22 @@ collinearSprays :: (Eq a, AlgRing.C a) => Spray a -> Spray a -> Bool collinearSprays spray1 spray2 = isZeroSpray spray1 && isZeroSpray spray2 || - snd (leadingTerm spray1) *^ spray2 == snd (leadingTerm spray2) *^ spray1 + (not . isZeroSpray) spray1 && (not . isZeroSpray) spray2 && + snd (leadingTerm spray1) *^ spray2 == snd (leadingTerm spray2) *^ spray1 +-- | Checks whether the multivariate polynomial defined by a spray is homogeneous +-- and also returns the degree in case this is true +isHomogeneousSpray :: (Eq a, AlgRing.C a) => Spray a -> (Bool, Maybe Int) +isHomogeneousSpray spray + | isConstant spray = (True, Just 0) + | getConstantTerm spray /= AlgAdd.zero = (False, Nothing) + | otherwise = (check, deg) + where + degrees = map (sum . exponents) (HM.keys spray) + check = allSame degrees + deg = if check then Just (degrees !! 0) else Nothing + -- division stuff ------------------------------------------------------------- -- | index of the maximum of a list @@ -1899,7 +2003,7 @@ qtnt = (pows, coeff) expntLTP = degP `index` 0 pows = if expntLTP == expntLTB - then Powers S.empty 0 + then nullPowers else Powers (S.singleton (expntLTP - expntLTB)) 1 coeff = coeffLTP AlgField./ coeffLTB @@ -2028,13 +2132,13 @@ -- | Gröbner basis, always minimal and possibly reduced -- --- prop> groebner sprays True == reduceGroebnerBasis (groebner sprays False) -groebner :: +-- prop> groebnerBasis sprays True == reduceGroebnerBasis (groebnerBasis sprays False) +groebnerBasis :: forall a. (Eq a, AlgField.C a) => [Spray a] -- ^ list of sprays -> Bool -- ^ whether to return the reduced basis -> [Spray a] -groebner sprays reduced = +groebnerBasis sprays reduced = if reduced then reduceGroebnerBasis gbasis0 else map normalize gbasis0 where gbasis0 = groebner0 sprays @@ -2123,7 +2227,7 @@ where n = numberOfVariables spray indices = [1 .. n] - gPolys = map (\i -> esPolynomial n i ^-^ lone (n + i)) indices + gPolys = [esPolynomial n i ^-^ lone (n + i) | i <- indices] gbasis = groebner0 gPolys spray' = removeConstantTerm spray g = sprayDivisionRemainder spray' gbasis @@ -2144,10 +2248,10 @@ -- prop> isPolynomialOf p [p1, p2] == (True, Just $ x ^*^ y) isPolynomialOf :: forall a. (AlgField.C a, Eq a) => Spray a -> [Spray a] -> (Bool, Maybe (Spray a)) -isPolynomialOf spray sprays = - if isConstant spray - then (True, Just spray) - else result +isPolynomialOf spray sprays + | isConstant spray = (True, Just spray) + | null sprays = error "isPolynomialOf: the list of sprays is empty." + | otherwise = result where nov = numberOfVariables spray n = maximum $ map numberOfVariables sprays @@ -2156,7 +2260,7 @@ | otherwise = (checks, poly) where m = length sprays - yPolys = map (\i -> lone (n + i) :: Spray a) [1 .. m] + yPolys = [lone (n + i) | i <- [1 .. m]] gPolys = zipWith (^-^) sprays yPolys gbasis0 = groebner0 gPolys constantTerm = getConstantTerm spray @@ -2164,7 +2268,8 @@ g = sprayDivisionRemainder spray' gbasis0 gpowers = HM.keys g check1 = minimum (map nvariables gpowers) > n - check2 = DF.all (DF.all (0 ==)) (map (S.take n . exponents) gpowers) + check2 = + DF.all (DF.all (0 ==)) (map (S.take n . exponents) gpowers) checks = check1 && check2 poly = if checks then Just g'' @@ -2172,7 +2277,7 @@ g' = dropXis g g'' = if constantTerm == AlgAdd.zero then g' - else addTerm g' (Powers S.empty 0, constantTerm) + else addTerm g' (nullPowers, constantTerm) dropXis = HM.mapKeys f f (Powers expnnts nv) = Powers (S.drop n expnnts) (nv - n) @@ -2216,20 +2321,21 @@ else sprays where n = numberOfVariables spray - spray' = removeConstantTerm spray - (powers', coeffs') = unzip (HM.toList spray') - expnts' = map exponents powers' - constantTerm = (constantSpray . getConstantTerm) spray + spray'' = safeSpray spray + spray' = removeConstantTerm'' spray'' + (expnts', coeffs') = unzip (HM.toList spray') + constantTerm = (constantSpray . getConstantTerm'') spray'' xpows = map (`index` 0) expnts' - powers'' = map ((\s -> Powers s (S.length s)) . S.deleteAt 0) expnts' + powers'' = + map (powerize . S.deleteAt 0) expnts' sprays'' = zipWith (curry fromTerm) powers'' coeffs' imap = IM.fromListWith (^+^) (zip xpows sprays'') imap' = IM.insertWith (^+^) 0 constantTerm imap permutation = [2 .. n] ++ [1] deg = maximum xpows sprays = [ - permuteVariables permutation (fromMaybe AlgAdd.zero (IM.lookup i imap')) - | i <- [deg, deg-1 .. 0] + permuteVariables permutation (fromMaybe AlgAdd.zero (IM.lookup i imap')) + | i <- [deg, deg-1 .. 0] ] -- | Resultant of two /univariate/ sprays @@ -2240,22 +2346,24 @@ else error "resultant1: the two sprays must be univariate." where n = max (numberOfVariables p) (numberOfVariables q) + p'' = safeSpray p + q'' = safeSpray q pexpnts = - map ((`index` 0) . exponents) $ HM.keys $ removeConstantTerm p + map (`index` 0) $ HM.keys $ removeConstantTerm'' p'' qexpnts = - map ((`index` 0) . exponents) $ HM.keys $ removeConstantTerm q - p0 = getConstantTerm p - q0 = getConstantTerm q + map (`index` 0) $ HM.keys $ removeConstantTerm'' q'' + p0 = getConstantTerm'' p'' + q0 = getConstantTerm'' q'' pcoeffs = if null pexpnts then [p0] - else [getCoefficient' (Powers (S.singleton i) 1) p - | i <- [maxp, maxp-1 .. 1]] ++ [p0] + else [getCoefficient'' (S.singleton i) p'' | i <- [maxp, maxp-1 .. 1]] + ++ [p0] where maxp = maximum pexpnts qcoeffs = if null qexpnts then [q0] - else [getCoefficient' (Powers (S.singleton i) 1) q - | i <- [maxq, maxq-1 .. 1]] ++ [q0] + else [getCoefficient'' (S.singleton i) q'' | i <- [maxq, maxq-1 .. 1]] + ++ [q0] where maxq = maximum qexpnts @@ -2266,22 +2374,24 @@ else error "subresultants1: the two sprays must be univariate." where n = max (numberOfVariables p) (numberOfVariables q) + p'' = safeSpray p + q'' = safeSpray q pexpnts = - map ((`index` 0) . exponents) $ HM.keys $ removeConstantTerm p + map (`index` 0) $ HM.keys $ removeConstantTerm'' p'' qexpnts = - map ((`index` 0) . exponents) $ HM.keys $ removeConstantTerm q - p0 = getConstantTerm p - q0 = getConstantTerm q + map (`index` 0) $ HM.keys $ removeConstantTerm'' q'' + p0 = getConstantTerm'' p'' + q0 = getConstantTerm'' q'' pcoeffs = if null pexpnts then [p0] - else [getCoefficient' (Powers (S.singleton i) 1) p - | i <- [maxp, maxp-1 .. 1]] ++ [p0] + else [getCoefficient'' (S.singleton i) p'' | i <- [maxp, maxp-1 .. 1]] + ++ [p0] where maxp = maximum pexpnts qcoeffs = if null qexpnts then [q0] - else [getCoefficient' (Powers (S.singleton i) 1) q - | i <- [maxq, maxq-1 .. 1]] ++ [q0] + else [getCoefficient'' (S.singleton i) q''| i <- [maxq, maxq-1 .. 1]] + ++ [q0] where maxq = maximum qexpnts d = length pcoeffs @@ -2405,13 +2515,12 @@ | otherwise = sprays where permutation = [2 .. n] ++ [1] - spray' = permuteVariables permutation spray - spray'' = removeConstantTerm spray' - (powers', coeffs') = unzip (HM.toList spray'') - expnts' = map exponents powers' - constantTerm = getConstantTerm spray' + spray' = safeSpray $ permuteVariables permutation spray + spray'' = removeConstantTerm'' spray' + (expnts', coeffs') = unzip (HM.toList spray'') + constantTerm = getConstantTerm'' spray' xpows = map (`index` 0) expnts' - powers'' = map ((\s -> Powers s (S.length s)) . S.deleteAt 0) expnts' + powers'' = map (powerize . S.deleteAt 0) expnts' sprays'' = zipWith (curry fromTerm) powers'' coeffs' imap = IM.fromListWith (^+^) (zip xpows sprays'') imap' = IM.insertWith (^+^) 0 (constantSpray constantTerm) imap @@ -2459,8 +2568,7 @@ xpows = map (`index` 0) expnts' deg = maximum xpows is = elemIndices deg xpows - powers'' = map - ((\s -> Powers s (S.length s)) . (\i -> S.deleteAt 0 (expnts' !! i))) is + powers'' = [powerize (S.deleteAt 0 (expnts' !! i)) | i <- is] coeffs'' = [coeffs' !! i | i <- is] leadingCoeff = sumTerms (zip powers'' coeffs'') @@ -2489,6 +2597,19 @@ q = ellB ^**^ e sprayS = multSprayByTerm ellR (loneTerm' n (degR - degB)) +{- spray1,spray2 :: QSpray +spray1 = let x = qlone 1 + y = qlone 2 + z = qlone 3 + in + (-5)*^x^**^3 ^-^ 11*^(x^**^2^*^y) ^-^ 11*^(x^*^y^**^2) ^-^ 8*^(x^*^y^*^z) ^+^ 20*^(x^*^z^**^2) ^-^ 5*^y^**^3 ^+^ 20*^(y^*^z^**^2) +spray2 = let x = qlone 1 + y = qlone 2 + z = qlone 3 + in + x^*^y ^-^ x^*^z ^-^ y^*^z ^+^ z^**^2 + -} + -- | recursive GCD function gcdKX1dotsXn :: forall a. (Eq a, AlgField.C a) => Int -> Spray a -> Spray a -> Spray a @@ -2526,12 +2647,14 @@ | numberOfVariables sprayR == 0 = d | otherwise = go sprayB'' (exactDivisionBy (g ^*^ h^**^delta) sprayR) - ellA'' - (exactDivisionBy (h^**^delta) (h ^*^ g^**^delta)) + ellB'' ---- ellA'' + (exactDivisionBy (h^**^delta) (h ^*^ ellB''^**^delta)) --- g^**^delta where (_, (_, sprayR)) = pseudoDivision n' sprayA'' sprayB'' - (degA'', ellA'') = degreeAndLeadingCoefficient n' sprayA'' - degB'' = degree n' sprayB'' + -- (degA'', ellA'') = degreeAndLeadingCoefficient n' sprayA'' + -- degB'' = degree n' sprayB'' + degA'' = degree n' sprayA'' + (degB'', ellB'') = degreeAndLeadingCoefficient n' sprayB'' delta = degA'' - degB'' -- | Greatest common divisor of two sprays with coefficients in a field @@ -2619,11 +2742,17 @@ type RatioOfQSprays = RatioOfSprays Rational -instance (Eq a, AlgField.C a) => HasVariables (RatioOfSprays a) where +instance (Eq a, AlgField.C a) => FunctionLike (RatioOfSprays a) where type BaseRing (RatioOfSprays a) = a -- type VariablesType (RatioOfSprays a) = Spray a -- + (*^) :: a -> RatioOfSprays a -> RatioOfSprays a + (*^) lambda rOS = lambda AlgMod.*> rOS + -- + (+>) :: a -> RatioOfSprays a -> RatioOfSprays a + (+>) x rOS = rOS AlgAdd.+ asRatioOfSprays (constantSpray x) + -- substitute :: [Maybe a] -> RatioOfSprays a -> RatioOfSprays a substitute subs (RatioOfSprays p q) = substitute subs p %//% substitute subs q @@ -2867,14 +2996,14 @@ showTwoNumSprays :: (Num a, Ord a) => (a -> String) -- ^ function mapping a positive coefficient to a string - -> ([Seq Int] -> [String]) -- ^ prints the monomials + -> ([Exponents] -> [String]) -- ^ prints the monomials -> (Spray a, Spray a) -- ^ the two sprays to be printed -> (String, String) showTwoNumSprays showPositiveCoef showMonomials = both (showNumSpray showMonomials showPositiveCoef) showTwoQSprays :: - ([Seq Int] -> [String]) -- ^ prints the monomials + ([Exponents] -> [String]) -- ^ prints the monomials -> (QSpray, QSpray) -- ^ the two sprays to be printed -> (String, String) showTwoQSprays = showTwoNumSprays showRatio @@ -2915,7 +3044,7 @@ -- | Prints a ratio of sprays with numeric coefficients showRatioOfNumSprays :: (Num a, Ord a, AlgRing.C a) => (a -> String) -- ^ function mapping a positive coefficient to a string - -> ([Seq Int] -> [String]) -- ^ prints the monomials + -> ([Exponents] -> [String]) -- ^ prints the monomials -> (String, String) -- ^ pair of braces to enclose the numerator and the denominator -> String -- ^ represents the quotient bar -> RatioOfSprays a @@ -2925,7 +3054,7 @@ -- | Prints a ratio of sprays with rational coefficients showRatioOfQSprays :: - ([Seq Int] -> [String]) -- ^ prints the monomials + ([Exponents] -> [String]) -- ^ prints the monomials -> (String, String) -- ^ pair of braces to enclose the numerator and the denominator -> String -- ^ represents the quotient bar -> RatioOfQSprays @@ -3111,7 +3240,7 @@ -- -- >>> numberOfParameters (jacobiPolynomial 4) -- 2 -numberOfParameters :: HasVariables b => Spray b -> Int +numberOfParameters :: FunctionLike b => Spray b -> Int numberOfParameters pspray = if isZeroSpray pspray then 0 @@ -3128,7 +3257,7 @@ -- >>> b = qlone 2 -- >>> changeParameters jp [a^**^2, b^**^2] changeParameters :: - HasVariables b + (FunctionLike b, Eq b, AlgAdd.C b) => Spray b -- ^ @OneParameterSpray a@, @SimpleParametricSpray a@, or @ParametricSpray a@ -> [VariablesType b] -- ^ @[Polynomial a]@ or @[Spray a]@, the new variables -> Spray b @@ -3137,14 +3266,14 @@ then error "changeParameters: not enough new parameters provided." else - HM.map (`changeVariables` newParameters) pspray + removeZeroTerms $ HM.map (`changeVariables` newParameters) pspray -- | Substitutes some values to the parameters of a parametric spray -- -- >>> jacobi3 = jacobiPolynomial 3 -- >>> legendre3 = substituteParameters jp [0, 0] substituteParameters :: - (HasVariables b, Eq (BaseRing b), AlgAdd.C (BaseRing b)) + (FunctionLike b, Eq (BaseRing b), AlgAdd.C (BaseRing b)) => Spray b -- ^ @OneParameterSpray a@, @SimpleParametricSpray a@, or @ParametricSpray a@ -> [BaseRing b] -- ^ values of type @a@ to be substituted to the parameters -> Spray (BaseRing b) -- ^ output: a @Spray a@ spray @@ -3176,7 +3305,7 @@ -- | Substitutes some values to the parameters of a parametric spray as well as -- some values to its variables evalParametricSpray' :: - (HasVariables b, Eq (BaseRing b), AlgMod.C (BaseRing b) b) + (FunctionLike b, Eq (BaseRing b), AlgMod.C (BaseRing b) b) => Spray b -- ^ @OneParameterSpray a@, @SimpleParametricSpray a@, or @ParametricSpray a@ -> [BaseRing b] -- ^ values of type @a@ to be substituted to the parameters -> [BaseRing b] -- ^ values of type @a@ to be substituted to the variables @@ -3238,12 +3367,11 @@ toPolynomial :: Spray a -> Polynomial a toPolynomial spray = polyFromCoeffs coeffs where + spray'' = removeConstantTerm'' (safeSpray spray) coeffs = getConstantTerm spray : - [getCoefficient' (Powers (S.singleton i) 1) spray' - | i <- [1 .. deg]] + [getCoefficient'' (S.singleton i) spray'' | i <- [1 .. deg]] deg = maximum (0 : expnts) - spray' = removeConstantTerm spray - expnts = map ((`index` 0) . exponents) (HM.keys spray') + expnts = map (`index` 0) (HM.keys spray'') {- -- | division of two univariate sprays longDivision :: (Eq a, AlgField.C a) => Spray a -> Spray a -> (Spray a, Spray a) @@ -3292,14 +3420,13 @@ toQPolynomial :: QSpray -> QPolynomial toQPolynomial spray = polyFromCoeffs coeffs' where + spray'' = removeConstantTerm'' (safeSpray spray) coeffs' = f (getConstantTerm spray) : - [f $ getCoefficient' (Powers (S.singleton i) 1) spray' - | i <- [1 .. deg]] + [f $ getCoefficient'' (S.singleton i) spray'' | i <- [1 .. deg]] f :: Rational -> Rational' f r = DR.numerator r :% DR.denominator r deg = maximum (0 : map (`index` 0) expnts) - spray' = removeConstantTerm spray - expnts = map exponents (HM.keys spray') + expnts = HM.keys spray'' -- | [Gegenbauer polynomials](https://en.wikipedia.org/wiki/Gegenbauer_polynomials); -- we mainly provide them to give an example of the @SimpleParametricSpray@ type @@ -3335,31 +3462,27 @@ | n == 0 = unitSpray | n == 1 = fromSimpleParametricSpray $ - (((gamma0 +> 2) /^ 2) *^ - (x +> AlgAdd.negate AlgRing.one)) +> (alpha0 +> 1) + (((gamma0 <+ 2) /^ 2) *^ + (x <+ AlgAdd.negate AlgRing.one)) <+ (alpha0 <+ 1) | otherwise = spray ^*^ jacobiPolynomial (n-1) ^-^ rOS *^ jacobiPolynomial (n-2) where - -- there's a lot of additions with a constant so we introduce - -- an operator to do them more efficiently - (+>) :: (Eq a, AlgAdd.C a) => Spray a -> a -> Spray a - (+>) q r = addTerm q (Powers S.empty 0, r) alpha0 = qlone 1 beta0 = qlone 2 gamma0 = alpha0 ^+^ beta0 x = lone 1 :: SimpleParametricQSpray n' = toRational n - a0 = alpha0 +> (n' - 1) - b0 = beta0 +> (n' - 1) - c0 = gamma0 +> (2 * n') - c0' = c0 +> (-1) - c0'' = c0 +> (-2) - divisor = (n' *^ (c0 +> (-n'))) ^*^ c0'' + a0 = alpha0 <+ (n' - 1) + b0 = beta0 <+ (n' - 1) + c0 = gamma0 <+ (2 * n') + c0' = c0 <+ (-1) + c0'' = c0 <+ (-2) + divisor = (n' *^ (c0 <+ (-n'))) ^*^ c0'' divisor' = 2 .^ divisor divide = (`RatioOfSprays` divisor') spray = HM.fromList [ ( - Powers S.empty 0 + nullPowers , divide $ c0' ^*^ (alpha0 ^-^ beta0) ^*^ gamma0 ), ( @@ -3496,3 +3619,4 @@ prettySimpleParametricQSpray :: SimpleParametricQSpray -> String prettySimpleParametricQSpray = prettySimpleParametricQSprayABCXYZ ["a"] ["X", "Y", "Z"] +
tests/Main.hs view
@@ -11,11 +11,7 @@ import Data.Ratio ( (%) ) import Math.Algebra.Hspray ( Spray, QSpray, - (^+^), - (^-^), - (^*^), - (^**^), - (*^), + FunctionLike (..), (.^), (/>), (/^), @@ -36,7 +32,7 @@ bombieriSpray, collinearSprays, derivative, - groebner, + groebnerBasis, fromRationalSpray, esPolynomial, psPolynomial, @@ -66,7 +62,6 @@ constQPoly, constPoly, prettyOneParameterQSpray', - (*.), RatioOfSprays (..), RatioOfQSprays, (%//%), @@ -88,7 +83,6 @@ ParametricSpray, zeroRatioOfSprays, fromRatioOfQPolynomials, - HasVariables (..), numberOfParameters, changeParameters, substituteParameters, @@ -99,7 +93,9 @@ asSimpleParametricSpray, constPoly, qlone', - qmonomial + qmonomial, + isHomogeneousSpray, + psPolynomial ) import MathObj.Matrix ( fromRows ) import qualified MathObj.Matrix as MathMatrix @@ -121,8 +117,16 @@ "Testing hspray" [ - testCase "qmonomial and qlone'" $ do + testCase "power sum polynomials are homogeneous " $ do let + lambda = [4, 3, 2, 2] + sprays = map (psPolynomial 4) lambda :: [Spray Int] + spray = AlgRing.product sprays + homogeneous = isHomogeneousSpray spray + assertEqual "" homogeneous (True, Just $ sum lambda) + + , testCase "qmonomial and qlone'" $ do + let assocs = [(1, 5), (3, 7), (1, 5)] assocs0 = [(0, 4), (0, 0)] assertEqual "" @@ -140,7 +144,8 @@ let f :: (QSpray, QSpray) -> (PQS, PQS, PQS) -> PQS f (a, b) (x, y, z) = - (a %:% (a ^+^ unitSpray)) *^ x^**^2 ^+^ (b %:% (a ^+^ b)) *^ (y ^*^ z) + (a %:% (a ^+^ unitSpray)) *^ x^**^2 ^+^ + (b %:% (a ^+^ b)) *^ (y ^*^ z) pqs = f (lone 1, lone 2) (lone 1, lone 2, lone 3) s1 = prettyParametricQSprayABCXYZ ["a","b"] ["X","Y","Z"] pqs s2 = prettyParametricQSprayABCXYZ ["a"] ["X","Y","Z"] pqs @@ -275,8 +280,10 @@ x = lone 1 :: ParametricQSpray p = x ^-^ unitSpray t1 = asRatioOfSprays (((alpha0 ^+^ cst 1)^*^(alpha0 ^+^ cst 2)) /^ 2) - t2 = asRatioOfSprays (((alpha0 ^+^ cst 2)^*^(alpha0 ^+^ beta0 ^+^ cst 3)) /^ 2) - t3 = asRatioOfSprays (((alpha0 ^+^ beta0 ^+^ cst 3)^*^(alpha0 ^+^ beta0 ^+^ cst 4)) /^ 8) + t2 = asRatioOfSprays + (((alpha0 ^+^ cst 2)^*^(alpha0 ^+^ beta0 ^+^ cst 3)) /^ 2) + t3 = asRatioOfSprays + (((alpha0 ^+^ beta0 ^+^ cst 3)^*^(alpha0 ^+^ beta0 ^+^ cst 4)) /^ 8) expected = t1 *^ unitSpray ^+^ t2 *^ p ^+^ t3 *^ p^**^2 assertEqual "" jp2 expected @@ -348,22 +355,26 @@ test1 = (rOS1 AlgAdd.+ rOS2) AlgRing.* (rOS1 AlgAdd.- rOS2) == rOS1 AlgRing.^ 2 AlgAdd.- rOS2 AlgRing.^ 2 - rOS' = (3%4 :: Rational) AlgMod.*> rOS AlgRing.^ 2 AlgAdd.+ p AlgMod.*> rOS + rOS' = + (3%4 :: Rational) AlgMod.*> rOS AlgRing.^ 2 AlgAdd.+ p AlgMod.*> rOS test2 = p AlgMod.*> (rOS' %/% p) == rOS' test3 = rOS1 %/% p == p %//% q test4 = rOS' AlgField./ rOS' == unitRatioOfSprays k = 3 :: Rational test5 = (p /> k) AlgMod.*> rOS1 == p AlgMod.*> (rOS1 /> k) - assertEqual "" [test1, test2, test3, test4, test5] [True, True, True, True, True] + assertEqual "" + [test1, test2, test3, test4, test5] [True, True, True, True, True] , testCase "arithmetic on univariate ratio of sprays" $ do let x = qlone 1 y = qlone 2 f :: QSpray -> RatioOfQSprays - f p = ((p^**^4 ^-^ 3*^p^**^3 ^+^ p^**^2)^**^2 %//% (p^**^2 ^+^ unitSpray)) AlgAdd.+ - ((p^**^2 ^-^ unitSpray) %//% (p^**^2 ^+^ 3*^p)^**^2) AlgRing.* - ((p^**^3 ^-^ p^**^2 ^+^ unitSpray) %//% (2*^p^**^3 ^-^ unitSpray)) + f p = + ((p^**^4 ^-^ 3*^p^**^3 ^+^ p^**^2)^**^2 %//% (p^**^2 ^+^ unitSpray)) + AlgAdd.+ + ((p^**^2 ^-^ unitSpray) %//% (p^**^2 ^+^ 3*^p)^**^2) AlgRing.* + ((p^**^3 ^-^ p^**^2 ^+^ unitSpray) %//% (2*^p^**^3 ^-^ unitSpray)) rOSx = f x rOSy = f y assertEqual "" rOSx (swapVariables (1, 2) rOSy) @@ -411,16 +422,19 @@ z = lone 3 :: Spray Int p = 2 *^ (2 *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ 4 *^ z ^+^ 5 *^ unitSpray spray = p ^+^ p ^+^ p ^+^ p ^+^ p ^+^ p ^+^ p - assertEqual "" (7 .^ p, (-7) .^ p, 0 .^ p) (spray, AlgAdd.negate spray, zeroSpray) + assertEqual "" + (7 .^ p, (-7) .^ p, 0 .^ p) (spray, AlgAdd.negate spray, zeroSpray) , testCase "collinearSprays" $ do let x = lone 1 :: Spray Rational y = lone 2 :: Spray Rational z = lone 3 :: Spray Rational - spray1 = - (2 % 1) *^ ((2 % 1) *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ (4 % 1) *^ z ^+^ (5 % 1) *^ unitSpray - spray2 = 121 *^ spray1 + term1 = (2 % 1) *^ ((2 % 1) *^ (x ^**^ 3 ^*^ y ^**^ 2)) + term2 = (4 % 1) *^ z + term3 = (5 % 1) *^ unitSpray + spray1 = term1 ^+^ term2 ^+^ term3 + spray2 = 121 *^ (term3 ^+^ term1 ^+^ term2) assertBool "" (collinearSprays spray1 spray2) , testCase "bombieriSpray" $ do @@ -429,9 +443,11 @@ y = lone 2 :: Spray Rational z = lone 3 :: Spray Rational poly = - (2 % 1) *^ ((2 % 1) *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ (4 % 1) *^ z ^+^ (5 % 1) *^ unitSpray + (2 % 1) *^ ((2 % 1) *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ + (4 % 1) *^ z ^+^ (5 % 1) *^ unitSpray bpoly = - (24 % 1) *^ ((2 % 1) *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ (4 % 1) *^ z ^+^ (5 % 1) *^ unitSpray + (24 % 1) *^ ((2 % 1) *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ + (4 % 1) *^ z ^+^ (5 % 1) *^ unitSpray assertEqual "" bpoly (bombieriSpray poly), testCase "composeSpray" $ do @@ -454,7 +470,8 @@ y = lone 2 :: Spray Int z = lone 3 :: Spray Int p = 2 *^ (2 *^ (x^**^3 ^*^ y^**^2)) ^+^ 4 *^ z ^+^ 5 *^ unitSpray - assertEqual "" (getCoefficient [3, 2, 0] p, getCoefficient [0, 4] p) (4, 0), + assertEqual "" + (getCoefficient [3, 2, 0] p, getCoefficient [0, 4] p) (4, 0), testCase "getConstantTerm" $ do let @@ -509,7 +526,7 @@ p1 = x^**^2 ^+^ y ^+^ z ^-^ unitSpray p2 = x ^+^ y^**^2 ^+^ z ^-^ unitSpray p3 = x ^+^ y ^+^ z^**^2 ^-^ unitSpray - g = groebner [p1, p2, p3] True + g = groebnerBasis [p1, p2, p3] True xyz = [sqrt 2 - 1, sqrt 2 - 1, sqrt 2 - 1] gxyz = map ((`evalSpray` xyz) . fromRationalSpray) g sumAbsValues = sum $ map abs gxyz @@ -527,7 +544,10 @@ x = lone 1 :: Spray Rational y = lone 2 :: Spray Rational z = lone 3 :: Spray Rational - p = x^**^3 ^*^ y^**^2 ^*^ z ^+^ x^**^3 ^*^ y ^*^ z^**^2 ^+^ x^**^2 ^*^ y^**^3 ^*^ z ^+^ 2*^(x^**^2 ^*^ y^**^2 ^*^ z^**^2) ^+^ x^**^2 ^*^ y ^*^ z^**^3 ^+^ x ^*^ y^**^3 ^*^ z^**^2 ^+^ x ^*^ y^**^2 ^*^ z^**^3 + p = x^**^3 ^*^ y^**^2 ^*^ z ^+^ x^**^3 ^*^ y ^*^ z^**^2 ^+^ + x^**^2 ^*^ y^**^3 ^*^ z ^+^ 2*^(x^**^2 ^*^ y^**^2 ^*^ z^**^2) ^+^ + x^**^2 ^*^ y ^*^ z^**^3 ^+^ x ^*^ y^**^3 ^*^ z^**^2 ^+^ + x ^*^ y^**^2 ^*^ z^**^3 assertBool "" (isSymmetricSpray p), testCase "isPolynomialOf" $ do @@ -537,7 +557,8 @@ p1 = x ^+^ y p2 = x ^-^ y p = p1 ^*^ p2 ^+^ unitSpray - assertEqual "" (isPolynomialOf p [p1, p2]) (True, Just $ x ^*^ y ^+^ unitSpray), + assertEqual "" + (isPolynomialOf p [p1, p2]) (True, Just $ x ^*^ y ^+^ unitSpray), testCase "isPolynomialOf - 2" $ do let @@ -584,8 +605,10 @@ , testCase "permuteVariables of a spray" $ do let - f :: Spray Rational -> Spray Rational -> Spray Rational -> Spray Rational - f p1 p2 p3 = p1^**^4 ^+^ (2 *^ p2^**^3) ^+^ (3 *^ p3^**^2) ^-^ (4 *^ unitSpray) + 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 @@ -593,6 +616,20 @@ p' = permuteVariables [3, 1, 2] p assertEqual "" p' (f x3 x1 x2) + , testCase "permuteVariables can add a new variable" $ do + let + 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 + x4 = lone 4 :: Spray Rational + p = f x1 x2 x3 + p' = permuteVariables [2, 1, 4, 3] p + assertEqual "" p' (f x2 x1 x4) + , testCase "swapVariables of a spray" $ do let x1 = lone 1 :: Spray Rational @@ -605,7 +642,8 @@ , testCase "permuteVariables of a ratio of sprays" $ do let f :: QSpray -> QSpray -> QSpray -> RatioOfQSprays - f p1 p2 p3 = (p1^**^4 ^+^ (2 *^ p2^**^3)) %//% ((3 *^ p3^**^2) ^-^ (4 *^ unitSpray)) + f p1 p2 p3 = (p1^**^4 ^+^ (2 *^ p2^**^3)) %//% + ((3 *^ p3^**^2) ^-^ (4 *^ unitSpray)) x1 = lone 1 :: QSpray x2 = lone 2 :: QSpray x3 = lone 3 :: QSpray @@ -618,7 +656,8 @@ x1 = lone 1 :: Spray Rational x2 = lone 2 :: Spray Rational x3 = lone 3 :: Spray Rational - rOS = (x1^**^4 ^+^ (2 *^ x2^**^3)) %//% ((3 *^ x3^**^2) ^-^ (4 *^ unitSpray)) + rOS = (x1^**^4 ^+^ (2 *^ x2^**^3)) %//% + ((3 *^ x3^**^2) ^-^ (4 *^ unitSpray)) rOS' = permuteVariables [3, 2, 1] rOS assertEqual "" rOS' (swapVariables (1, 3) rOS) @@ -638,7 +677,8 @@ p = x^**^4 ^-^ x^**^3 ^+^ x^**^2 ^-^ 2*^ (x ^*^ y^**^2) ^+^ y^**^4 q = x ^-^ (2*^ y^**^2) r = resultant 2 p q - assertEqual "" r (16*^x^**^8 ^-^ 32*^x^**^7 ^+^ 24*^x^**^6 ^-^ 8*^x^**^5 ^+^ x^**^4), + assertEqual "" + r (16*^x^**^8 ^-^ 32*^x^**^7 ^+^ 24*^x^**^6 ^-^ 8*^x^**^5 ^+^ x^**^4), testCase "resultant product rule" $ do let @@ -647,7 +687,8 @@ f = x^**^4 ^-^ x^**^3 ^+^ x^**^2 ^-^ 2*^ (x ^*^ y^**^2) ^+^ y^**^4 g = x ^-^ (2*^ y^**^2) h = x^**^2 ^*^ y ^+^ y^**^3 ^+^ unitSpray - assertEqual "" (resultant 1 (f^*^g) h) (resultant 1 f h ^*^ resultant 1 g h), + assertEqual "" + (resultant 1 (f^*^g) h) (resultant 1 f h ^*^ resultant 1 g h), testCase "subresultants" $ do let @@ -656,7 +697,8 @@ p = x^**^2 ^*^ y ^*^ (y^**^2 ^-^ 5*^ x ^+^ constantSpray 6) q = x^**^2 ^*^ y ^*^ (3*^ y ^+^ constantSpray 2) sx = subresultants 1 p q - assertBool "" (sx!!0 == zeroSpray && sx!!1 == zeroSpray && sx!!2 /= zeroSpray), + assertBool "" + (sx!!0 == zeroSpray && sx!!1 == zeroSpray && sx!!2 /= zeroSpray), testCase "resultant1" $ do let @@ -724,7 +766,9 @@ b2 = 4 :: Rational sprayB1 = constantSpray b1 sprayB2 = constantSpray b2 - assertBool "" (gcdSpray sprayA sprayB1 == unitSpray && gcdSpray sprayA sprayB2 == unitSpray) + assertBool "" + (gcdSpray sprayA sprayB1 == unitSpray && + gcdSpray sprayA sprayB2 == unitSpray) , testCase "sprayDivision" $ do let @@ -752,40 +796,60 @@ sprayA = sprayD ^*^ (x^**^4 ^-^ x ^+^ y^**^2) sprayB = sprayD ^*^ y ^*^ (2*^x ^+^ unitSpray) g = gcdSpray sprayA sprayB - assertEqual "" g ((1%3) *^ sprayD), + assertEqual "" g ((1%3) *^ sprayD) - testCase "gcdSpray - trivariate example" $ do + , testCase "gcdSpray - trivariate example" $ do let x = lone 1 :: Spray Rational y = lone 2 :: Spray Rational z = lone 3 :: Spray Rational sprayD = x^**^2 ^*^ y ^-^ x ^*^ y ^+^ z ^+^ constantSpray 3 - sprayA = sprayD^**^1 ^*^ (x^**^4 ^-^ x ^+^ y ^+^ x ^*^ y ^*^ z^**^2) + sprayA = + sprayD^**^1 ^*^ (x^**^4 ^-^ x ^+^ y ^+^ x ^*^ y ^*^ z^**^2) sprayB = sprayD^**^1 ^*^ y ^*^ (2*^x ^+^ unitSpray) ^*^ z g = gcdSpray sprayA sprayB - assertEqual "" g sprayD, + assertEqual "" g sprayD - testCase "evaluation of one-parameter spray" $ do + , testCase "gcdSpray is commutative" $ do let + x = lone 1 :: Spray Rational + y = lone 2 :: Spray Rational + z = lone 3 :: Spray Rational + sprayA = (-5)*^x^**^3 ^-^ 11*^(x^**^2 ^*^ y) ^-^ 11*^(x^*^ y^**^2) ^-^ + 8*^(x ^*^ y ^*^ z) ^+^ 20*^(x ^*^ z^**^2) ^-^ 5 *^ y^**^3 ^+^ + 20*^(y ^*^ z^**^2) + sprayB = x^*^y ^-^ x^*^z ^-^ y^*^z ^+^ z^**^2 + assertEqual "" (gcdSpray sprayA sprayB) (gcdSpray sprayB sprayA) + + , testCase "evaluation of one-parameter spray" $ do + let a = qsoleParameter p = a AlgRing.^ 2 AlgAdd.- constQPoly 4 q1 = a AlgAdd.- constQPoly 3 q2 = a AlgAdd.- constQPoly 2 rop1 = p :% q1 rop2 = p :% q2 - f :: (Eq a, AlgRing.C a) => Spray a -> Spray a -> Spray a -> (Spray a, Spray a) + f :: (Eq a, AlgRing.C a) + => Spray a -> Spray a -> Spray a -> (Spray a, Spray a) f x y z = (x^**^2 ^+^ y^**^2, z) - g :: (Eq a, AlgRing.C a) => Spray a -> Spray a -> Spray a -> (a, a, a) -> (a, a) - g px py pz (x, y, z) = (evalSpray f1 [x, y, AlgAdd.zero], evalSpray f2 [AlgAdd.zero, AlgAdd.zero, z]) + g :: (Eq a, AlgRing.C a) + => Spray a -> Spray a -> Spray a -> (a, a, a) -> (a, a) + g px py pz (x, y, z) = + ( + evalSpray f1 [x, y, AlgAdd.zero] + , evalSpray f2 [AlgAdd.zero, AlgAdd.zero, z] + ) where (f1, f2) = f px py pz (r1, r2) = g (lone 1 :: QSpray') (lone 2) (lone 3) (2, 3, 4) - r = evalRatioOfPolynomials 5 rop1 AlgRing.* r1 AlgAdd.+ evalRatioOfPolynomials 5 rop2 AlgRing.* r2 + r = evalRatioOfPolynomials 5 rop1 AlgRing.* r1 AlgAdd.+ + evalRatioOfPolynomials 5 rop2 AlgRing.* r2 (f1', f2') = f (lone 1 :: OneParameterQSpray) (lone 2) (lone 3) opSpray = rop1 *^ f1' ^+^ rop2 *^ f2' r' = evalOneParameterSpray' opSpray 5 [2, 3, 4] rop1' = evalOneParameterSpray'' f1' [2, 3] rop2' = evalOneParameterSpray'' f2' [0, 0, 4] - r'' = evalRatioOfPolynomials 5 (rop1 AlgRing.* rop1' AlgAdd.+ rop2 AlgRing.* rop2') + r'' = evalRatioOfPolynomials 5 + (rop1 AlgRing.* rop1' AlgAdd.+ rop2 AlgRing.* rop2') spray = substituteParameters opSpray [5] r''' = evalSpray spray [2, 3, 4] assertEqual "" ((r, r'), r'') ((r', r''), r'''), @@ -795,7 +859,8 @@ x = lone 1 :: Spray Rational y = lone 2 :: Spray Rational z = lone 3 :: Spray Rational - p1 = ((2%3) *^ x^**^3) ^*^ y ^-^ x^**^2 ^+^ y ^*^ z ^-^ (2%3) *^ unitSpray + p1 = ((2%3) *^ x^**^3) ^*^ y ^-^ x^**^2 ^+^ + y ^*^ z ^-^ (2%3) *^ unitSpray p2 = (3%2) *^ p1 p3 = AlgAdd.negate $ swapVariables (1, 3) $ @@ -855,8 +920,9 @@ z = lone 3 :: OneParameterQSpray a = qsoleParameter sSpray - = ((4 NR.% 5) *. (a :% (a AlgRing.^ 2 AlgAdd.+ AlgRing.one))) AlgMod.*> (x^**^2 ^-^ y^**^2) - ^+^ (constQPoly (2 NR.% 3) AlgRing.* a) AlgMod.*> (y ^*^ z) + = ((4 NR.% 5) *^ (a :% (a AlgRing.^ 2 AlgAdd.+ AlgRing.one))) + *^ (x^**^2 ^-^ y^**^2) + ^+^ (constQPoly (2 NR.% 3) AlgRing.* a) AlgMod.*> (y ^*^ z) string = prettyOneParameterQSpray' "a" sSpray string' = "{ [ (4/5)*a ] %//% [ a^2 + 1 ] }*X^2 + { [ -(4/5)*a ] %//% [ a^2 + 1 ] }*Y^2 + { (2/3)*a }*Y.Z" @@ -869,14 +935,16 @@ z = lone 3 :: OneParameterQSpray a = qsoleParameter sSpray - = ((4 NR.% 5) *. (a :% (a AlgRing.^ 2 AlgAdd.+ AlgRing.one))) AlgMod.*> (x^**^2 ^-^ y^**^2) - ^+^ (constQPoly (2 NR.% 3) AlgRing.* a) AlgMod.*> (y ^*^ z) + = ((4 NR.% 5) *^ (a :% (a AlgRing.^ 2 AlgAdd.+ AlgRing.one))) + *^ (x^**^2 ^-^ y^**^2) + ^+^ (constQPoly (2 NR.% 3) AlgRing.* a) AlgMod.*> (y ^*^ z) x' = lone 1 :: ParametricSpray Rational' y' = lone 2 :: ParametricSpray Rational' z' = lone 3 :: ParametricSpray Rational' a' = lone 1 :: Spray Rational' spray - = ((4 NR.% 5 :: Rational') AlgMod.*> (a' %:% (a'^**^2 ^+^ unitSpray))) *^ (x'^**^2 ^-^ y'^**^2) + = ((4 NR.% 5 :: Rational') AlgMod.*> + (a' %:% (a'^**^2 ^+^ unitSpray))) *^ (x'^**^2 ^-^ y'^**^2) ^+^ ((2 NR.% 3) *^ a') AlgMod.*> (y' ^*^ z') assertEqual "" (parametricSprayToOneParameterSpray spray) sSpray