From c0c0734f8c4ec7ec7749fae2c04f7b2b0bc2bb6f Mon Sep 17 00:00:00 2001
From: stla <laurent_step@yahoo.fr>
Date: Sun, 5 May 2024 05:23:43 +0200
Subject: [PATCH] fix principalSturmHabichtSequence

---
 hspray.cabal               |  2 +-
 src/Math/Algebra/Hspray.hs |  6 +++---
 tests/Main.hs              | 24 ++++++++++++++++++++++++
 3 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/hspray.cabal b/hspray.cabal
index 774f379..383fbba 100644
--- a/hspray.cabal
+++ b/hspray.cabal
@@ -1,7 +1,7 @@
 name:                hspray
 version:             0.5.2.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.
+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
 license:             GPL-3
 license-file:        LICENSE
diff --git a/src/Math/Algebra/Hspray.hs b/src/Math/Algebra/Hspray.hs
index d0a6029..4425b0e 100644
--- a/src/Math/Algebra/Hspray.hs
+++ b/src/Math/Algebra/Hspray.hs
@@ -5,7 +5,7 @@ Copyright   : (c) Stéphane Laurent, 2022-2024
 License     : GPL-3
 Maintainer  : laurent_step@outlook.fr
 
-Deals with multivariate polynomials on a commutative ring. 
+Deals with multivariate polynomials over a commutative ring. 
 See README for examples.
 -}
 {-# LANGUAGE BangPatterns #-}
@@ -192,7 +192,7 @@ module Math.Algebra.Hspray
   , substituteSpray
   , composeSpray
   , evalSpraySpray
-  -- * Division of a spray
+  -- * Division of sprays
   , sprayDivision
   , sprayDivisionRemainder
   , pseudoDivision
@@ -2636,7 +2636,7 @@ principalSturmHabichtSequence var spray
     sHS = sturmHabichtSequence var spray
     permutation  = [d - var + 1 .. d] ++ [1 .. d - var]
     permutation' = [var + 1 .. d] ++ [1 .. var] 
-    jcoeff j = if isZeroSpray sHSj 
+    jcoeff j = if isZeroSpray sHSj || j >= length coeffs
       then zeroSpray
       else permuteVariables permutation' (coeffs !! j)
       where
diff --git a/tests/Main.hs b/tests/Main.hs
index 0831413..bf739e3 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -838,6 +838,30 @@ main = defaultMain $ testGroup
           ]
         )
 
+    , testCase "principalSturmHabichtSequence" $ do
+      let
+        x = qlone 1
+        y = qlone 2
+        p = x^**^4 ^*^ y ^+^ y^**^2
+        psh1 = principalSturmHabichtSequence 1 p
+        psh2 = principalSturmHabichtSequence 2 p
+      assertEqual "" 
+        (psh1, psh2)
+        (
+          [
+              256 *^ y^**^10
+            , zeroSpray
+            , zeroSpray
+            , 4 *^ y
+            , y
+          ],
+          [
+              x^**^8
+            , constantSpray 2
+            , constantSpray 1
+          ]
+        )
+
     , testCase "sturmHabichtSequence & principalSturmHabichtSequence" $ do
       let
         x = qlone 1