hspray 0.5.3.0 → 0.5.4.0

raw patch · 4 files changed

+71/−19 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• hspray.cabal +1/−1
• src/Math/Algebra/Hspray.hs +42/−16
• tests/Main.hs +18/−2

@@ -304,3 +304,13 @@ 
 * Now the denominator of a `RatioOfSprays` is always monic, i.e. it is a 
 polynomial whose leading coefficient is 1.
+
+
+## 0.5.4.0 - 2024-06-19
+
+* Now the greatest common divisor of two sprays (function `gcdSpray`) is 
+always monic, i.e. it is a polynomial whose leading coefficient is 1.
+
+* Function `evalRatioOfSprays'`, to substitute the variables of a ratio of
+sprays with some ratios of sprays.
+

@@ -1,5 +1,5 @@ name:                hspray
-version:             0.5.3.0
+version:             0.5.4.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, subresultants, Sturm-Habicht sequence, 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

@@ -128,6 +128,7 @@   , constantRatioOfSprays
   , asRatioOfSprays
   , evalRatioOfSprays
+  , evalRatioOfSprays'
   , substituteRatioOfSprays
   , fromRatioOfPolynomials
   , fromRatioOfQPolynomials
@@ -260,6 +261,7 @@                                                 , elemIndices
                                                 , nub
                                                 , foldl1'
+                                                , foldl'
                                                 , uncons
                                                 )
 import           Data.List.Extra                ( allSame
@@ -2023,8 +2025,15 @@   -> Spray a            -- ^ divisor
   -> (Spray a, Spray a) -- ^ (quotient, remainder)
 sprayDivision0 sprayA sprayB =
+--  both ((*^) coeff) (ogo sprayA' zeroSpray zeroSpray)
   ogo sprayA zeroSpray zeroSpray
   where
+    -- q'*(sprayB) + r' = sprayA * lc sprayB / lc sprayA
+    -- (q' * lc sprayA / lc sprayB) * sprayB + r' * lc sprayA / lc sprayB = sprayA 
+--    lcA = snd (leadingTerm sprayA)
+--    coeff = lcA AlgField./ snd ltB
+--    sprayA' =  sprayA /> coeff
+
     ltB = leadingTerm sprayB
     ogo :: Spray a -> Spray a -> Spray a -> (Spray a, Spray a)
     ogo !p !q !r 
@@ -3010,31 +3019,18 @@         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
 gcdKX1dotsXn n sprayA sprayB
   | n == 0              = constantSpray $ gcdKX0 sprayA sprayB
   | degB > degA         = gcdKX1dotsXn n sprayB sprayA 
-  | isZeroSpray sprayB  = sprayA
+  | isZeroSpray sprayB  = normalize sprayA
   | otherwise           = go sprayA' sprayB' unitSpray unitSpray
   where
     gcdKX0 :: Spray a -> Spray a -> a
     gcdKX0 = const $ const AlgRing.one 
-    n' = max (numberOfVariables sprayA) (numberOfVariables sprayB)
+    n' = n -- max (numberOfVariables sprayA) (numberOfVariables sprayB)
     degA = degree n' sprayA
     degB = degree n' sprayB
     gcdKX1dotsXm = gcdKX1dotsXn (n-1)
@@ -3049,6 +3045,9 @@         (quo, remainder) = sprayDivision a b
     reduceSpray :: Spray a -> Spray a
     reduceSpray spray = exactDivisionBy (content spray) spray 
+    normalize :: Spray a -> Spray a
+    normalize spray = 
+     let leadingCoeff = snd $ leadingTerm spray in spray /> leadingCoeff
     contA   = content sprayA
     contB   = content sprayB
     d       = gcdKX1dotsXm contA contB 
@@ -3056,7 +3055,7 @@     sprayB' = exactDivisionBy contB sprayB 
     go :: Spray a -> Spray a -> Spray a -> Spray a -> Spray a
     go sprayA'' sprayB'' g h 
-      | isZeroSpray sprayR            = d ^*^ reduceSpray sprayB''
+      | isZeroSpray sprayR            = d ^*^ reduceSpray (normalize sprayB'')
       | numberOfVariables sprayR == 0 = d
       | otherwise = go sprayB'' 
                        (exactDivisionBy (g ^*^ h^**^delta) sprayR)
@@ -3346,6 +3345,33 @@ -- | Evaluates a ratio of sprays; same as `evaluate`
 evalRatioOfSprays :: (Eq a, AlgField.C a) => RatioOfSprays a -> [a] -> a
 evalRatioOfSprays = evaluate
+
+-- | Substitutes the variables of a ratio of sprays with some ratios of sprays
+evalRatioOfSprays' :: 
+  (Eq a, AlgField.C a) => RatioOfSprays a -> [RatioOfSprays a] -> RatioOfSprays a
+evalRatioOfSprays' (RatioOfSprays spray1 spray2) listOfROS = 
+  if length listOfROS >= 
+      max (numberOfVariables spray1) (numberOfVariables spray2)
+    then
+      eval_spray spray1 AlgField./ eval_spray spray2
+    else
+      error "evalRatioOfSprays': not enough ratios of sprays provided."
+  where
+    seqOfROS = S.fromList listOfROS
+    evalTermOfSpray powers coeff = 
+      coeff AlgMod.*> 
+        foldl' 
+          (AlgRing.*) 
+            unitRatioOfSprays 
+              (S.zipWith 
+                (\ros e -> 
+                  ros AlgRing.^ (fromIntegral e)) seqOfROS (exponents powers)
+              )
+    eval_spray spray = 
+      HM.foldl' 
+        (AlgAdd.+) 
+          zeroRatioOfSprays 
+            (HM.mapWithKey evalTermOfSpray spray)
 
 -- | Substitutes some values to some variables of a ratio of sprays; same as `substitute`
 substituteRatioOfSprays :: 

@@ -78,6 +78,7 @@                                                   constantRatioOfSprays,
                                                   isPolynomialRatioOfSprays,
                                                   evalRatioOfSprays,
+                                                  evalRatioOfSprays',
                                                   substituteRatioOfSprays,
                                                   prettyRatioOfQSprays,
                                                   characteristicPolynomial,
@@ -422,6 +423,21 @@         r = evalRatioOfSprays rOS values
       assertEqual "" r (f r1 r2)
 
+    , testCase "evalRatioOfSprays'" $ do
+      let
+        x = qlone 1
+        y = qlone 2
+        z = qlone 3
+        p = x ^+^ y
+        q = x ^-^ y
+        rOS = p %//% q
+        rOS1 = x %//% y
+        rOS2 = z %//% x
+        obtained = evalRatioOfSprays' rOS [rOS1, rOS2]
+        expected = 
+          (rOS1 AlgAdd.+ rOS2) AlgField./ (rOS1 AlgAdd.- rOS2)
+      assertEqual "" obtained expected
+
     , testCase "Gegenbauer: differential equation and Chebyshev case" $ do
       let
         n = 5
@@ -961,7 +977,7 @@         sprayA = sprayD ^*^ (x^**^4 ^-^ x) 
         sprayB = sprayD ^*^ (2*^x ^+^ unitSpray)
         sprayGCD = gcdSpray sprayA sprayB
-      assertEqual "" sprayGCD (9 *^ sprayD),
+      assertEqual "" sprayGCD sprayD,
 
     testCase "gcdSpray with a constant spray" $ do
       let
@@ -1001,7 +1017,7 @@         sprayA = sprayD ^*^ (x^**^4  ^-^  x  ^+^  y^**^2) 
         sprayB = sprayD ^*^ y ^*^ (2*^x  ^+^  unitSpray)
         g = gcdSpray sprayA sprayB
-      assertEqual "" g ((1%3) *^ sprayD)
+      assertEqual "" g sprayD
 
     , testCase "gcdSpray - trivariate example" $ do
       let