diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,12 @@ * New functions `toList`, `sprayTerms` and `bombieriSpray`. -* New operation `.^` to multiply a spray by an integer. +* New operation `.^`, to multiply a spray by an integer. * Added some unit tests. + + +## 0.1.2.0 - 2023-02-24 + +New function `derivSpray`, to differentiate a spray. + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,10 @@ # hspray + +[![Stack-lts](https://github.com/stla/hspray/actions/workflows/Stack-lts.yml/badge.svg)](https://github.com/stla/hspray/actions/workflows/Stack-lts.yml) +[![Stack-nightly](https://github.com/stla/hspray/actions/workflows/Stack-nightly.yml/badge.svg)](https://github.com/stla/hspray/actions/workflows/Stack-nightly.yml) + + Simple multivariate polynomials in Haskell. ___ @@ -11,8 +16,8 @@ y = lone 2 :: Spray Double z = lone 3 :: Spray Double poly = (2 *^ (x^**^3 ^*^ y ^*^ z) ^+^ x^**^2) ^*^ (4 *^ (x ^*^ y ^*^ z)) -prettySpray show "x" poly --- "(4.0) * x^(3, 1, 1) + (8.0) * x^(4, 2, 2)" +prettySpray show "X" poly +-- "(4.0) * X^(3, 1, 1) + (8.0) * X^(4, 2, 2)" ``` More generally, one can use the type `Spray a` as long as the type `a` has @@ -26,8 +31,8 @@ y = lone 2 :: Spray Rational z = lone 3 :: Spray Rational poly = ((2%3) *^ (x^**^3 ^*^ y ^*^ z) ^+^ x^**^2) ^*^ ((7%4) *^ (x ^*^ y ^*^ z)) -prettySpray show "x" poly --- "(7 % 4) * x^(3, 1, 1) + (7 % 6) * x^(4, 2, 2)" +prettySpray show "X" poly +-- "(7 % 4) * X^(3, 1, 1) + (7 % 6) * X^(4, 2, 2)" ``` Or `a = Spray Double`: @@ -55,3 +60,15 @@ -- 8.0 ``` +Differentiation: + +```haskell +import Math.Algebra.Hspray +x = lone 1 :: Spray Double +y = lone 2 :: Spray Double +z = lone 3 :: Spray Double +poly = 2 *^ (x ^*^ y ^*^ z) ^+^ (3 *^ x^**^2) +-- derivate with respect to x +prettySpray show "X" $ derivSpray 1 poly +-- "(2.0) * X^(0, 1, 1) + (6.0) * X^(1)" +``` diff --git a/hspray.cabal b/hspray.cabal --- a/hspray.cabal +++ b/hspray.cabal @@ -1,52 +1,52 @@ -cabal-version: >=1.10 -name: hspray -version: 0.1.1.0 -license: GPL-3 -license-file: LICENSE -copyright: 2022 Stéphane Laurent -maintainer: laurent_step@outlook.fr -author: Stéphane Laurent -homepage: https://github.com/stla/hspray#readme -synopsis: Multivariate polynomials. -description: Manipulation of multivariate polynomials on a ring. -category: Math, Algebra -build-type: Simple -extra-source-files: - README.md - CHANGELOG.md - -source-repository head - type: git - location: https://github.com/stla/hspray +name: hspray +version: 0.1.2.0 +synopsis: Multivariate polynomials. +description: Manipulation of multivariate polynomials on a ring. +homepage: https://github.com/stla/hspray#readme +license: GPL-3 +license-file: LICENSE +author: Stéphane Laurent +maintainer: laurent_step@outlook.fr +copyright: 2022 Stéphane Laurent +category: Math, Algebra +build-type: Simple +extra-source-files: README.md + CHANGELOG.md +cabal-version: >=1.10 library - exposed-modules: Math.Algebra.Hspray - hs-source-dirs: src - default-language: Haskell2010 - other-extensions: - ScopedTypeVariables FlexibleInstances FlexibleContexts - MultiParamTypeClasses - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - - build-depends: - base >=4.7 && <5, - containers, - hashable, - unordered-containers, - numeric-prelude, - text + hs-source-dirs: src + exposed-modules: Math.Algebra.Hspray + build-depends: base >= 4.7 && < 5 + , containers >= 0.6.4.1 + , hashable >= 1.3.4.0 + , unordered-containers >= 0.2.17.0 + , numeric-prelude >= 0.4.4 + , text >= 1.2.5.0 + other-extensions: FlexibleInstances + , FlexibleContexts + , MultiParamTypeClasses + default-language: Haskell2010 + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints 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 + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests/ + Build-Depends: base >= 4.7 && < 5 + , tasty + , tasty-hunit + , hspray + Default-Language: Haskell2010 + +source-repository head + type: git + location: https://github.com/stla/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 @@ -1,4 +1,3 @@ -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -21,6 +20,7 @@ , prettySpray , composeSpray , bombieriSpray + , derivSpray ) where import qualified Algebra.Additive as AlgAdd import qualified Algebra.Module as AlgMod @@ -29,13 +29,15 @@ import Data.Function ( on ) import Data.HashMap.Strict ( HashMap ) import qualified Data.HashMap.Strict as HM -import Data.Hashable +import Data.Hashable ( Hashable(hashWithSalt) ) import Data.List ( sortBy ) import qualified Data.Sequence as S import Data.Sequence ( (><) , Seq , dropWhileR , (|>) + , index + , adjust ) import Data.Text ( Text , append @@ -77,7 +79,7 @@ else (e1, growSequence e2 n2 n1, n1) instance Eq Powers where - pows1 == pows2 = (exponents pows1') == (exponents pows2') + pows1 == pows2 = exponents pows1' == exponents pows2' where (pows1', pows2') = harmonize (pows1, pows2) instance Hashable Powers where @@ -119,7 +121,7 @@ -- | Scale spray by an integer (.^) :: (AlgAdd.C a, Eq a) => Int -> Spray a -> Spray a -(.^) k pol = if k >= 0 +(.^) k pol = if k >= 0 then AlgAdd.sum (replicate k pol) else AlgAdd.negate $ AlgAdd.sum (replicate (-k) pol) @@ -128,7 +130,7 @@ where s = dropWhileR (== 0) (exponents pows) simplifySpray :: Spray a -> Spray a -simplifySpray p = HM.mapKeys simplifyPowers p +simplifySpray = HM.mapKeys simplifyPowers cleanSpray :: (AlgAdd.C a, Eq a) => Spray a -> Spray a cleanSpray p = HM.filter (/= AlgAdd.zero) (simplifySpray p) @@ -143,6 +145,25 @@ scaleSpray :: (AlgRing.C a, Eq a) => a -> Spray a -> Spray a scaleSpray lambda p = cleanSpray $ HM.map (lambda AlgRing.*) p +derivMonomial :: AlgRing.C a => Int -> (Powers, a) -> (Powers, a) +derivMonomial i (pows, coef) = if i' >= S.length expts + then (Powers S.empty 0, AlgAdd.zero) + else (pows', coef') + where + i' = i - 1 + expts = exponents pows + expt_i = expts `index` i' + expts' = adjust (subtract 1) i' expts + coef' = AlgAdd.sum (replicate expt_i coef) + pows' = Powers expts' (nvariables pows) + +derivSpray :: (AlgRing.C a, Eq a) => Int -> Spray a -> Spray a +derivSpray i p = cleanSpray $ HM.fromListWith (AlgAdd.+) monomials + where + p' = HM.toList p + monomials = [ derivMonomial i mp | mp <- p' ] + + multMonomial :: AlgRing.C a => (Powers, a) -> (Powers, a) -> (Powers, a) multMonomial (pows1, coef1) (pows2, coef2) = (pows, coef1 AlgRing.* coef2) where @@ -171,7 +192,7 @@ -- | Constant spray constantSpray :: (AlgRing.C a, Eq a) => a -> Spray a -constantSpray c = c *^ (lone 0) +constantSpray c = c *^ lone 0 evalMonomial :: AlgRing.C a => [a] -> (Powers, a) -> a evalMonomial xyz (powers, coeff) = coeff @@ -183,11 +204,11 @@ evalSpray p xyz = AlgAdd.sum $ map (evalMonomial xyz) (HM.toList p) identify :: (AlgRing.C a, Eq a) => Spray a -> Spray (Spray a) -identify p = HM.map constantSpray p +identify = HM.map constantSpray -- | Compose a spray with a change of variables composeSpray :: (AlgRing.C a, Eq a) => Spray a -> [Spray a] -> Spray a -composeSpray p newvars = evalSpray (identify p) newvars +composeSpray p = evalSpray (identify p) -- | Create a spray from list of terms fromList :: (AlgRing.C a, Eq a) => [([Int], a)] -> Spray a @@ -215,7 +236,7 @@ -- | Terms of a spray sprayTerms :: Spray a -> HashMap (Seq Int) a -sprayTerms p = HM.mapKeys exponents p +sprayTerms = HM.mapKeys exponents -- | Spray as list toList :: Spray a -> [([Int], a)] @@ -223,9 +244,9 @@ -- | Bombieri spray bombieriSpray :: AlgAdd.C a => Spray a -> Spray a -bombieriSpray p = HM.mapWithKey f p +bombieriSpray = HM.mapWithKey f where - f pows coef = times (pfactorial $ exponents pows) coef - pfactorial pows = product $ DF.toList $ factorial <$> (S.filter (/= 0) pows) + f pows = times (pfactorial $ exponents pows) + 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 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,6 +1,18 @@ module Main where -import Data.Ratio -import Math.Algebra.Hspray +import Data.Ratio ( (%) ) +import Math.Algebra.Hspray ( Spray, + (^+^), + (^*^), + (^**^), + (*^), + lone, + unitSpray, + evalSpray, + composeSpray, + fromList, + toList, + bombieriSpray, + derivSpray ) import Test.Tasty ( defaultMain , testGroup ) @@ -24,7 +36,7 @@ assertEqual "" bpoly (bombieriSpray poly), testCase "composeSpray" $ do - let + let x = lone 1 :: Spray Int y = lone 2 :: Spray Int z = lone 3 :: Spray Int @@ -34,15 +46,28 @@ pz = y ^**^ 2 q = composeSpray p [px, py, pz] xyz = [2, 3, 4] - pxyz = map (\poly -> evalSpray poly xyz) [px, py, pz] + pxyz = map (`evalSpray` xyz) [px, py, pz] assertEqual "" (evalSpray p pxyz) (evalSpray q xyz), testCase "fromList . toList = identity" $ do - let + 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) + assertEqual "" p (fromList . toList $ p), + + testCase "derivSpray" $ do + let + x = lone 1 :: Spray Int + y = lone 2 :: Spray Int + z = lone 3 :: Spray Int + p1 = x ^+^ y ^*^ z ^**^ 3 + p2 = (x ^*^ y ^*^ z) ^+^ (2 *^ (x ^**^ 3 ^*^ y ^**^ 2)) + q = p1 ^*^ p2 + p1' = derivSpray 1 p1 + p2' = derivSpray 1 p2 + q' = derivSpray 1 q + assertEqual "" q' ((p1' ^*^ p2) ^+^ (p1 ^*^ p2')) ]