diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,3 +10,12 @@ ## 0.1.0.0 - 2022-12-11 First release. + + +## 0.1.1.0 - 2022-12-12 + +* New functions `toList`, `sprayTerms` and `bombieriSpray`. + +* New operation `.^` to multiply a spray by an integer. + +* Added some unit tests. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,6 +4,7 @@ ___ + ```haskell import Math.Algebra.Hspray x = lone 1 :: Spray Double @@ -36,7 +37,7 @@ p = lone 1 :: Spray Double x = lone 1 :: Spray (Spray Double) y = lone 2 :: Spray (Spray Double) -poly = ((p *^ x) ^+^ (p *^ y)) ^**^ 2 +poly = ((p *^ x) ^+^ (p *^ y))^**^2 prettySpray (prettySpray show "a") "X" poly -- "((1.0) * a^(2)) * X^(0, 2) + ((2.0) * a^(2)) * X^(1, 1) + ((1.0) * a^(2)) * X^(2)" ``` diff --git a/hspray.cabal b/hspray.cabal --- a/hspray.cabal +++ b/hspray.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: hspray -version: 0.1.0.0 +version: 0.1.1.0 license: GPL-3 license-file: LICENSE copyright: 2022 Stéphane Laurent @@ -39,3 +39,14 @@ unordered-containers, numeric-prelude, text + +test-suite unit-tests + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests/ + default-language: Haskell2010 + build-depends: + base >=4.7 && <5, + tasty, + tasty-hunit, + hspray diff --git a/src/Math/Algebra/Hspray.hs b/src/Math/Algebra/Hspray.hs --- a/src/Math/Algebra/Hspray.hs +++ b/src/Math/Algebra/Hspray.hs @@ -4,24 +4,28 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Math.Algebra.Hspray - ( fromList - , Spray + ( Spray , lone , unitSpray , constantSpray + , fromList + , toList + , sprayTerms , (*^) + , (.^) , (^+^) , (^-^) , (^*^) , (^**^) , evalSpray - , composeSpray , prettySpray + , composeSpray + , bombieriSpray ) where import qualified Algebra.Additive as AlgAdd import qualified Algebra.Module as AlgMod import qualified Algebra.Ring as AlgRing -import Data.Foldable ( toList ) +import qualified Data.Foldable as DF import Data.Function ( on ) import Data.HashMap.Strict ( HashMap ) import qualified Data.HashMap.Strict as HM @@ -43,7 +47,7 @@ ) -infixr 7 *^ +infixr 7 *^, .^ infixl 6 ^+^, ^-^ @@ -113,6 +117,12 @@ (*^) :: (AlgRing.C a, Eq a) => a -> Spray a -> Spray a (*^) lambda pol = lambda AlgMod.*> pol +-- | Scale spray by an integer +(.^) :: (AlgAdd.C a, Eq a) => Int -> Spray a -> Spray a +(.^) k pol = if k >= 0 + then AlgAdd.sum (replicate k pol) + else AlgAdd.negate $ AlgAdd.sum (replicate (-k) pol) + simplifyPowers :: Powers -> Powers simplifyPowers pows = Powers s (S.length s) where s = dropWhileR (== 0) (exponents pows) @@ -159,13 +169,14 @@ unitSpray :: AlgRing.C a => Spray a unitSpray = lone 0 +-- | Constant spray constantSpray :: (AlgRing.C a, Eq a) => a -> Spray a constantSpray c = c *^ (lone 0) evalMonomial :: AlgRing.C a => [a] -> (Powers, a) -> a evalMonomial xyz (powers, coeff) = coeff AlgRing.* AlgRing.product (zipWith (AlgRing.^) xyz pows) - where pows = toList (fromIntegral <$> exponents powers) + where pows = DF.toList (fromIntegral <$> exponents powers) -- | Evaluate a spray evalSpray :: AlgRing.C a => Spray a -> [a] -> a @@ -178,7 +189,7 @@ composeSpray :: (AlgRing.C a, Eq a) => Spray a -> [Spray a] -> Spray a composeSpray p newvars = evalSpray (identify p) newvars --- | Create a spray +-- | Create a spray from list of terms fromList :: (AlgRing.C a, Eq a) => [([Int], a)] -> Spray a fromList x = cleanSpray $ HM.fromList $ map (\(expts, coef) -> (Powers (S.fromList expts) (length expts), coef)) x @@ -199,5 +210,22 @@ (snoc (snoc (cons '(' $ snoc stringCoef ')') ' ') '*') (prettyPowers var pows) where - pows = toList $ exponents (fst term) + pows = DF.toList $ exponents (fst term) stringCoef = pack $ prettyCoef (snd term) + +-- | Terms of a spray +sprayTerms :: Spray a -> HashMap (Seq Int) a +sprayTerms p = HM.mapKeys exponents p + +-- | Spray as list +toList :: Spray a -> [([Int], a)] +toList p = HM.toList $ HM.mapKeys (DF.toList . exponents) p + +-- | Bombieri spray +bombieriSpray :: AlgAdd.C a => Spray a -> Spray a +bombieriSpray p = HM.mapWithKey f p + where + f pows coef = times (pfactorial $ exponents pows) coef + pfactorial pows = product $ DF.toList $ factorial <$> (S.filter (/= 0) pows) + factorial n = product [1 .. n] + times k x = AlgAdd.sum (replicate k x) diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,48 @@ +module Main where +import Data.Ratio +import Math.Algebra.Hspray +import Test.Tasty ( defaultMain + , testGroup + ) +import Test.Tasty.HUnit ( assertEqual + , testCase + ) + +main :: IO () +main = defaultMain $ testGroup + "Testing hspray" + + [ testCase "bombieriSpray" $ do + let + x = lone 1 :: Spray Rational + 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 + bpoly = + (24 % 1) *^ ((2 % 1) *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ (4 % 1) *^ z ^+^ (5 % 1) *^ unitSpray + assertEqual "" bpoly (bombieriSpray poly), + + testCase "composeSpray" $ do + let + x = lone 1 :: Spray Int + y = lone 2 :: Spray Int + z = lone 3 :: Spray Int + p = 2 *^ (2 *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ 4 *^ z ^+^ 5 *^ unitSpray + px = x ^+^ y ^+^ z + py = x ^*^ y ^*^ z + pz = y ^**^ 2 + q = composeSpray p [px, py, pz] + xyz = [2, 3, 4] + pxyz = map (\poly -> evalSpray poly xyz) [px, py, pz] + assertEqual "" (evalSpray p pxyz) (evalSpray q xyz), + + testCase "fromList . toList = identity" $ do + let + x = lone 1 :: Spray Int + y = lone 2 :: Spray Int + z = lone 3 :: Spray Int + p = 2 *^ (2 *^ (x ^**^ 3 ^*^ y ^**^ 2)) ^+^ 4 *^ z ^+^ 5 *^ unitSpray + assertEqual "" p (fromList . toList $ p) + + ]