removed semi-unbounded intervals (does not work)

stla · May 4, 2024 · a18864d · a18864d
1 parent d553695
commit a18864d
Show file tree

Hide file tree

Showing 2 changed files with 33 additions and 31 deletions.
diff --git a/src/Math/Algebra/Hspray.hs b/src/Math/Algebra/Hspray.hs
@@ -2682,55 +2682,48 @@ signVariations' = _signVariations signFunc
       | otherwise                      = '-' 
 
 _numberOfRealRootsInOpenInterval :: 
-  (AlgRing.C a, Ord a) => ([a] -> Int) -> Spray a -> a -> Maybe a -> Int
+  (AlgRing.C a, Ord a) => ([a] -> Int) -> Spray a -> a -> a -> Int
 _numberOfRealRootsInOpenInterval signVariationsFunc spray alpha beta 
   | isConstantSpray spray =
     if isZeroSpray spray 
       then error "numberOfRealRootsInInterval: the spray is null."
       else 0
-  | betaIsJust = 
-    if alpha == beta'
+  | otherwise = 
+    if alpha == beta
       then 0
       else
-        if alpha > beta' 
+        if alpha > beta
           then 
             error "numberOfRealRootsInInterval: the bounds are not ordered."
           else 
             if isZeroAtBeta then svDiff - 1 else svDiff
-  | otherwise = svAtAlpha
   where
-    betaIsJust = isJust beta
-    beta' = if betaIsJust then fromJust beta else undefined
     (ginit, glast) = 
       fromJust $ unsnoc $ filter (not . isZeroSpray) (sturmHabichtSequence 1 spray)
     sprayAtAlpha = evaluateAt [alpha] glast
-    sprayAtBeta  = evaluateAt [beta'] glast
+    sprayAtBeta  = evaluateAt [beta] glast
     isZeroAtBeta = sprayAtBeta == AlgAdd.zero
     galpha = map (evaluateAt [alpha]) ginit ++ [sprayAtAlpha]
-    gbeta  = map (evaluateAt [beta']) ginit ++ [sprayAtBeta]
+    gbeta  = map (evaluateAt [beta]) ginit ++ [sprayAtBeta]
     svAtAlpha = signVariationsFunc galpha
     svAtBeta  = signVariationsFunc gbeta
     svDiff    = svAtAlpha - svAtBeta
 
 _numberOfRealRootsInClosedInterval :: 
-  (AlgRing.C a, Ord a) => ([a] -> Int) -> Spray a -> a -> Maybe a -> Int
+  (AlgRing.C a, Ord a) => ([a] -> Int) -> Spray a -> a -> a -> Int
 _numberOfRealRootsInClosedInterval signVariationsFunc spray alpha beta = 
   _numberOfRealRootsInOpenInterval signVariationsFunc spray alpha beta + toAdd
   where
-    betaIsJust = isJust beta
-    beta' = if betaIsJust then fromJust beta else undefined
     isZeroAtAlpha = evaluateAt [alpha] spray == AlgAdd.zero
-    isZeroAtBeta  = evaluateAt [beta'] spray == AlgAdd.zero
-    toAdd = if betaIsJust
-      then if alpha == beta' 
-        then fromEnum isZeroAtAlpha
-        else fromEnum isZeroAtAlpha + fromEnum isZeroAtBeta
-      else fromEnum isZeroAtAlpha
+    isZeroAtBeta  = evaluateAt [beta] spray == AlgAdd.zero
+    toAdd = if alpha == beta 
+      then fromEnum isZeroAtAlpha
+      else fromEnum isZeroAtAlpha + fromEnum isZeroAtBeta
 
 -- | Number of real roots of a spray in an open interval (that makes sense 
 -- only for a spray on a ring embeddable in the real numbers).
 numberOfRealRootsInOpenInterval :: 
-  (Num a, AlgRing.C a, Ord a) => Spray a -> a -> Maybe a -> Int
+  (Num a, AlgRing.C a, Ord a) => Spray a -> a -> a -> Int
 numberOfRealRootsInOpenInterval spray = 
   if isUnivariate spray 
     then _numberOfRealRootsInOpenInterval signVariations spray
@@ -2740,7 +2733,7 @@ numberOfRealRootsInOpenInterval spray =
 -- only for a spray on a ring embeddable in the real numbers). The roots are 
 -- not counted with their multiplicity.
 numberOfRealRootsInClosedInterval :: 
-  (Num a, AlgRing.C a, Ord a) => Spray a -> a -> Maybe a -> Int
+  (Num a, AlgRing.C a, Ord a) => Spray a -> a -> a -> Int
 numberOfRealRootsInClosedInterval spray = 
   if isUnivariate spray 
     then _numberOfRealRootsInClosedInterval signVariations spray
@@ -2749,7 +2742,7 @@ numberOfRealRootsInClosedInterval spray =
 -- | Number of real roots of a spray in an open interval (that makes sense 
 -- only for a spray on a ring embeddable in the real numbers).
 numberOfRealRootsInOpenInterval' :: 
-  (AlgAbs.C a, Ord a) => Spray a -> a -> Maybe a -> Int
+  (AlgAbs.C a, Ord a) => Spray a -> a -> a -> Int
 numberOfRealRootsInOpenInterval' spray =
   if isUnivariate spray 
     then _numberOfRealRootsInOpenInterval signVariations' spray
@@ -2759,7 +2752,7 @@ numberOfRealRootsInOpenInterval' spray =
 -- only for a spray on a ring embeddable in the real numbers). The roots are 
 -- not counted with their multiplicity.
 numberOfRealRootsInClosedInterval' :: 
-  (AlgAbs.C a, Ord a) => Spray a -> a -> Maybe a -> Int
+  (AlgAbs.C a, Ord a) => Spray a -> a -> a -> Int
 numberOfRealRootsInClosedInterval' spray =
   if isUnivariate spray 
     then _numberOfRealRootsInClosedInterval signVariations' spray

diff --git a/tests/Main.hs b/tests/Main.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TupleSections #-}
 module Main (main) where
 import qualified Algebra.Additive               as AlgAdd
 import qualified Algebra.Module                 as AlgMod
@@ -888,15 +887,25 @@ main = defaultMain $ testGroup
         x = qlone 1
         factors = [x ^-^ constantSpray (toRational i) | i <- [1::Int .. 5]]
         spray = productOfSprays factors
-        intervals = [(0, Just 9), (1, Just 6), (2, Just 3), (0, Just 4), (2 + (1%4), Just $ 3 - (1%4))]
-        nroots = map (uncurry (numberOfRealRootsInClosedInterval spray)) intervals
-        nroots' = map (uncurry (numberOfRealRootsInOpenInterval spray)) intervals
-        infiniteIntervals = map (, Nothing) [0, 1, 2, 2 + (1%4), 5]
-        nroots'' = map (uncurry (numberOfRealRootsInClosedInterval spray)) infiniteIntervals
-        nroots''' = map (uncurry (numberOfRealRootsInOpenInterval spray)) infiniteIntervals
+        intervals = [
+            (0, 9)
+          , (1, 6)
+          , (2, 3)
+          , (0, 4)
+          , (2 + (1%4), 3 - (1%4))
+          ]
+        nroots = 
+          map (uncurry (numberOfRealRootsInClosedInterval spray)) intervals
+        nroots' = 
+          map (uncurry (numberOfRealRootsInOpenInterval spray)) intervals
+        -- infiniteIntervals = map (, Nothing) [0, 1, 2, 2 + (1%4), 5]
+        -- nroots'' = map (uncurry (numberOfRealRootsInClosedInterval spray)) 
+        --                 infiniteIntervals
+        -- nroots''' = map (uncurry (numberOfRealRootsInOpenInterval spray)) 
+        --                   infiniteIntervals
       assertEqual "" 
-        (nroots, nroots', nroots'', nroots''') 
-        ([5, 5, 2, 4, 0], [5, 4, 0, 3, 0], [5, 5, 4, 3, 1], [5, 4, 3, 3, 0])
+        (nroots, nroots') -- , nroots'', nroots''') 
+        ([5, 5, 2, 4, 0], [5, 4, 0, 3, 0]) -- , [5, 5, 4, 3, 1], [5, 4, 3, 3, 0])
 
     , testCase "number of real roots" $ do
       let