hspray 0.2.1.1 → 0.2.2.0

raw patch · 4 files changed

+44/−28 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• hspray.cabal +1/−1
• src/Math/Algebra/Hspray.hs +30/−27
• tests/Main.hs +8/−0

@@ -62,3 +62,8 @@ * Improved the documentation.
 
 * Flipped the order of appearance of the terms in the output of the `prettySpray` functions.
+
+
+## 0.2.2.0 - 2024-03-26
+
+* Fixed an error in `esPolynomial`, which resulted to a bug in `isSymmetricSpray`.

@@ -1,5 +1,5 @@ name:                hspray
-version:             0.2.1.1
+version:             0.2.2.0
 synopsis:            Multivariate polynomials.
 description:         Manipulation of multivariate polynomials on a ring and Gröbner bases.
 homepage:            https://github.com/stla/hspray#readme

@@ -99,12 +99,12 @@ import           Data.Ord                       ( comparing )
 import qualified Data.Sequence                 as S
 import           Data.Sequence                  ( (><)
-                                                , Seq (Empty, (:<|))
+                                                , Seq 
                                                 , dropWhileR
                                                 , (|>)
-                                                , (<|)
                                                 , index
                                                 , adjust
+                                                , fromFunction
                                                 )
 import           Data.Text                      ( Text
                                                 , append
@@ -798,33 +798,36 @@ 
 -- elementary symmetric polynomials -------------------------------------------
 
+-- | combinations of k elements among a list
+combinationsOf :: Int -> [a] -> [[a]]
+combinationsOf _ []        = error "combinationsOf: should not happen."
+combinationsOf 1 as        = map pure as
+combinationsOf k as@(_:xs) = 
+  run (l-1) (k-1) as $ combinationsOf (k-1) xs
+  where
+    l = length as
+    run :: Int -> Int -> [a] -> [[a]] -> [[a]]
+    run n i ys cs 
+      | n == i    = map (ys ++) cs
+      | otherwise = map (q:) cs ++ run (n-1) i qs (drop dc cs)
+      where
+        f :: [a] -> (a, [a])
+        f []     = error "should not happen"
+        f (b:bs) = (b, bs)
+        (q, qs) = f (take (n-i+1) ys)
+        dc      = product [(n-k+1) .. (n-1)] `div` product [1 .. i-1]
+
 -- | generate all permutations of a binary sequence
-permutationsBinarySequence :: Int -> Int -> [Seq Int] 
-permutationsBinarySequence nzeros nones = unfold1 next z 
+permutationsBinarySequence :: Int -> Int -> [Seq Int]
+permutationsBinarySequence nzeros nones = 
+  let n = nzeros + nones in 
+    map (binarySequence n) (combinationsOf nones [0 .. n-1])
   where
-    z = (><) (S.replicate nzeros False) (S.replicate nones True)
-    unfold1 :: (Seq Bool -> Maybe (Seq Bool)) -> Seq Bool -> [Seq Int]
-    unfold1 f x = case f x of 
-      Nothing -> [x'] 
-      Just y  -> x' : unfold1 f y 
+    binarySequence :: Int -> [Int] -> Seq Int
+    binarySequence n combo = fromFunction n f 
       where
-        x' = fmap fromEnum x
-    next :: Seq Bool -> Maybe (Seq Bool)
-    next xs = case findj (S.reverse xs, S.empty) of 
-      Nothing -> Nothing
-      Just ( l:<|ls , rs ) -> Just $ inc l ls (S.reverse rs, S.empty) 
-      Just ( Empty , _ ) -> error "permutationsBinarySequence: should not happen"
-    findj :: (Seq Bool, Seq Bool) -> Maybe (Seq Bool, Seq Bool)   
-    findj ( xxs@(x:<|xs), yys@(_:<|_) ) = if x 
-      then findj ( xs, True <| yys )
-      else Just ( xxs, yys )
-    findj ( x:<|xs, Empty ) = findj ( xs, S.singleton x )
-    findj ( Empty , _ ) = Nothing
-    inc :: Bool -> Seq Bool -> (Seq Bool, Seq Bool) -> Seq Bool
-    inc !u us ( x:<|xs , yys ) = if u
-      then inc True us ( xs , x <| yys ) 
-      else (><) (S.reverse (True <| us)) ((><) (S.reverse (u <| yys)) xs)
-    inc _ _ ( Empty , _ ) = error "permutationsBinarySequence: should not happen"
+        f :: Int -> Int
+        f i = fromEnum (i `elem` combo)
 
 -- | Elementary symmetric polynomial
 --
@@ -852,7 +855,7 @@     esPolys = map (\i -> esPolynomial n i :: Spray a) indices
     yPolys = map (\i -> lone (n + i) :: Spray a) indices
     gPolys = zipWith (^-^) esPolys yPolys
-    gbasis = groebner0 gPolys
+    gbasis = groebner gPolys False
     g = sprayDivision spray gbasis
     gpowers = HM.keys g
     check1 = minimum (map nvariables gpowers) > n

@@ -118,6 +118,14 @@         p = e2^**^2 ^+^ (2*^ e3)
       assertBool "" (isSymmetricSpray p),
 
+    testCase "Schur polynomial is symmetric" $ do
+      let
+        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
+      assertBool "" (isSymmetricSpray p),
+
     testCase "isPolynomialOf" $ do
       let
         x = lone 1 :: Spray Rational