{-|
Module      : Math.Algebra.Hspray
Description : Multivariate polynomials on a ring.
Copyright   : (c) Stéphane Laurent, 2023
License     : GPL-3
Maintainer  : laurent_step@outlook.fr

Deals with multivariate polynomials on a commutative ring. 
See README for examples.
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Math.Algebra.Hspray
  ( 
  -- * Types

    Powers (..)
  , Spray
  , QSpray
  , Monomial
  -- * Basic sprays

  , lone
  , unitSpray
  , zeroSpray
  , constantSpray
  -- * Operations on sprays

  , (*^)
  , (.^)
  , (^+^)
  , (^-^)
  , (^*^)
  , (^**^)
  -- * Showing a spray

  , prettySpray
  , prettySpray'
  , prettySpray''
  , prettySprayXYZ
  -- * Univariate polynomials 

  , A (..)
  , Rational'
  , Q
  , scalarQ
  , Polynomial 
  , RatioOfPolynomials
  , QPolynomial 
  , RatioOfQPolynomials
  , prettyRatioOfPolynomials
  , prettyRatioOfQPolynomials
  , (*.)
  , constPoly
  , polyFromCoeffs
  , outerVariable
  , constQPoly
  , qpolyFromCoeffs
  , outerQVariable
  , evalRatioOfPolynomials
  -- * Symbolic sprays (with univariate polynomials coefficients)

  , SymbolicSpray
  , SymbolicQSpray
  , prettySymbolicSpray
  , prettySymbolicQSpray
  , simplifySymbolicSpray
  , evalSymbolicSpray
  , evalSymbolicSpray'
  , evalSymbolicSpray''
  -- * Queries on a spray

  , getCoefficient
  , getConstantTerm
  , sprayTerms
  -- * Evaluation of a spray

  , evalSpray
  , substituteSpray
  , composeSpray
  -- * Differentiation of a spray

  , derivSpray
  -- * Permutation of the variables of a spray

  , permuteVariables
  , swapVariables
  -- * Division of a spray

  , sprayDivision
  , sprayDivisionRemainder
  -- * Gröbner basis

  , groebner
  , reduceGroebnerBasis
  -- * Symmetric polynomials

  , esPolynomial
  , psPolynomial
  , isSymmetricSpray
  -- * Resultant and subresultants

  , resultant
  , resultant'
  , resultant1
  , subresultants
  , subresultants1
  -- * Greatest common divisor

  , gcdSpray
  -- * Miscellaneous

  , fromList
  , toList
  , fromRationalSpray
  , leadingTerm
  , isPolynomialOf
  , bombieriSpray
  ) where
import qualified Algebra.Additive              as AlgAdd
import qualified Algebra.Field                 as AlgField
import qualified Algebra.Module                as AlgMod
import qualified Algebra.Ring                  as AlgRing
import qualified Algebra.ZeroTestable          as AlgZT
import qualified Data.Foldable                 as DF
import           Data.Function                  ( on )
import           Data.HashMap.Strict            ( HashMap )
import qualified Data.HashMap.Strict           as HM
import           Data.Hashable                  ( Hashable(hashWithSalt) )
import qualified Data.IntMap.Strict            as IM
import           Data.List                      ( sortBy
                                                , maximumBy 
                                                , (\\)
                                                , findIndices
                                                , elemIndices
                                                , nub
                                                , foldl1'
                                                )
import           Data.Matrix                    ( Matrix 
                                                , fromLists
                                                , minorMatrix
                                                , nrows
                                                , submatrix
                                                )
import qualified Data.Matrix                   as DM
import           Data.Maybe                     ( isJust
                                                , fromJust, fromMaybe
                                                )
import           Data.Ord                       ( comparing )
import qualified Data.Sequence                 as S
import           Data.Sequence                  ( (><)
                                                , Seq 
                                                , dropWhileR
                                                , (|>)
                                                , index
                                                , adjust
                                                , fromFunction
                                                )
import           Data.Text                      ( Text
                                                , append
                                                , cons
                                                , intercalate
                                                , pack
                                                , snoc
                                                , unpack
                                                )
import qualified MathObj.Polynomial            as MathPol
import qualified Number.Ratio                  as NumberRatio
-- import qualified Algebra.PrincipalIdealDomain  as AlgPID

-- import qualified Algebra.Units  as AlgUnits

-- import qualified Algebra.IntegralDomain  as AlgID



-- Univariate polynomials -----------------------------------------------------


newtype A a = A a 
  deriving
    (A a -> A a -> Bool
(A a -> A a -> Bool) -> (A a -> A a -> Bool) -> Eq (A a)
forall a. Eq a => A a -> A a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => A a -> A a -> Bool
== :: A a -> A a -> Bool
$c/= :: forall a. Eq a => A a -> A a -> Bool
/= :: A a -> A a -> Bool
Eq, A a
A a -> A a
A a -> A a -> A a
A a
-> (A a -> A a -> A a)
-> (A a -> A a -> A a)
-> (A a -> A a)
-> C (A a)
forall a. a -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> C a
forall a. C a => A a
forall a. C a => A a -> A a
forall a. C a => A a -> A a -> A a
$czero :: forall a. C a => A a
zero :: A a
$c+ :: forall a. C a => A a -> A a -> A a
+ :: A a -> A a -> A a
$c- :: forall a. C a => A a -> A a -> A a
- :: A a -> A a -> A a
$cnegate :: forall a. C a => A a -> A a
negate :: A a -> A a
AlgAdd.C, C (A a)
A a
Integer -> A a
C (A a) =>
(A a -> A a -> A a)
-> A a -> (Integer -> A a) -> (A a -> Integer -> A a) -> C (A a)
A a -> Integer -> A a
A a -> A a -> A a
forall a.
C a =>
(a -> a -> a) -> a -> (Integer -> a) -> (a -> Integer -> a) -> C a
forall a. C a => C (A a)
forall a. C a => A a
forall a. C a => Integer -> A a
forall a. C a => A a -> Integer -> A a
forall a. C a => A a -> A a -> A a
$c* :: forall a. C a => A a -> A a -> A a
* :: A a -> A a -> A a
$cone :: forall a. C a => A a
one :: A a
$cfromInteger :: forall a. C a => Integer -> A a
fromInteger :: Integer -> A a
$c^ :: forall a. C a => A a -> Integer -> A a
^ :: A a -> Integer -> A a
AlgRing.C, C (A a)
C (A a) =>
(A a -> A a -> A a)
-> (A a -> A a)
-> (Rational' -> A a)
-> (A a -> Integer -> A a)
-> C (A a)
Rational' -> A a
A a -> A a
A a -> Integer -> A a
A a -> A a -> A a
forall a.
C a =>
(a -> a -> a)
-> (a -> a) -> (Rational' -> a) -> (a -> Integer -> a) -> C a
forall a. C a => C (A a)
forall a. C a => Rational' -> A a
forall a. C a => A a -> A a
forall a. C a => A a -> Integer -> A a
forall a. C a => A a -> A a -> A a
$c/ :: forall a. C a => A a -> A a -> A a
/ :: A a -> A a -> A a
$crecip :: forall a. C a => A a -> A a
recip :: A a -> A a
$cfromRational' :: forall a. C a => Rational' -> A a
fromRational' :: Rational' -> A a
$c^- :: forall a. C a => A a -> Integer -> A a
^- :: A a -> Integer -> A a
AlgField.C)

type Rational' = NumberRatio.Rational
type Q = A Rational'

-- | Identify a rational to a @A Rational'@ element

scalarQ :: Rational' -> Q
scalarQ :: Rational' -> Q
scalarQ = Rational' -> Q
forall a. a -> A a
A 

type Polynomial a         = MathPol.T (A a)
type RatioOfPolynomials a = NumberRatio.T (Polynomial a)
type QPolynomial          = Polynomial Rational'
type RatioOfQPolynomials  = RatioOfPolynomials Rational'

instance (Eq a, AlgField.C a) => AlgZT.C (A a) where
  isZero :: A a -> Bool
  isZero :: A a -> Bool
isZero (A a
r) = a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
AlgAdd.zero

instance (Eq a, AlgField.C a) => AlgMod.C (A a) (RatioOfPolynomials a) where
  (*>) :: A a -> RatioOfPolynomials a -> RatioOfPolynomials a
  A a
r *> :: A a -> RatioOfPolynomials a -> RatioOfPolynomials a
*> RatioOfPolynomials a
rop = T (A a) -> RatioOfPolynomials a -> RatioOfPolynomials a
forall a. C a => a -> T a -> T a
NumberRatio.scale (A a -> T (A a)
forall a. a -> T a
MathPol.const A a
r) RatioOfPolynomials a
rop 

instance (Eq a, AlgField.C a) => AlgMod.C (Polynomial a) (RatioOfPolynomials a) where
  (*>) :: Polynomial a -> RatioOfPolynomials a -> RatioOfPolynomials a
  Polynomial a
p *> :: Polynomial a -> RatioOfPolynomials a -> RatioOfPolynomials a
*> RatioOfPolynomials a
r = Polynomial a -> RatioOfPolynomials a -> RatioOfPolynomials a
forall a. C a => a -> T a -> T a
NumberRatio.scale Polynomial a
p RatioOfPolynomials a
r 

instance (Eq a, AlgField.C a) => AlgMod.C (Polynomial a) (SymbolicSpray a) where
  (*>) :: Polynomial a -> SymbolicSpray a -> SymbolicSpray a
  Polynomial a
p *> :: Polynomial a -> SymbolicSpray a -> SymbolicSpray a
*> SymbolicSpray a
r = T (Polynomial a) -> SymbolicSpray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray (Polynomial a
p Polynomial a -> Polynomial a -> T (Polynomial a)
forall a. a -> a -> T a
NumberRatio.:% Polynomial a
forall a. C a => a
AlgRing.one) SymbolicSpray a -> SymbolicSpray a -> SymbolicSpray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ SymbolicSpray a
r

infixr 7 *.
-- | Scale a ratio of univariate polynomials by a scalar

(*.) :: (Eq a, AlgField.C a) => a -> RatioOfPolynomials a -> RatioOfPolynomials a
*. :: forall a.
(Eq a, C a) =>
a -> RatioOfPolynomials a -> RatioOfPolynomials a
(*.) a
scalar RatioOfPolynomials a
rop = a -> A a
forall a. a -> A a
A a
scalar A a -> RatioOfPolynomials a -> RatioOfPolynomials a
forall a v. C a v => a -> v -> v
AlgMod.*> RatioOfPolynomials a
rop

-- | Constant univariate polynomial

constPoly :: a -> Polynomial a
constPoly :: forall a. a -> Polynomial a
constPoly a
x = A a -> T (A a)
forall a. a -> T a
MathPol.const (a -> A a
forall a. a -> A a
A a
x)

-- | Univariate polynomial from its coefficients (ordered by increasing degrees)

polyFromCoeffs :: [a] -> Polynomial a
polyFromCoeffs :: forall a. [a] -> Polynomial a
polyFromCoeffs [a]
as = [A a] -> T (A a)
forall a. [a] -> T a
MathPol.fromCoeffs ((a -> A a) -> [a] -> [A a]
forall a b. (a -> b) -> [a] -> [b]
map a -> A a
forall a. a -> A a
A [a]
as)

-- | The variable of a univariate polynomial; it is called \"outer\" because this is the variable 

-- occuring in the polynomial coefficients of a `SymbolicSpray` 

outerVariable :: AlgRing.C a => Polynomial a
outerVariable :: forall a. C a => Polynomial a
outerVariable = [a] -> Polynomial a
forall a. [a] -> Polynomial a
polyFromCoeffs [a
forall a. C a => a
AlgAdd.zero, a
forall a. C a => a
AlgRing.one] 

-- | Constant rational univariate polynomial

-- 

-- >>> import Number.Ratio ( (%) )

-- >>> constQPoly (2 % 3)

constQPoly :: Rational' -> QPolynomial
constQPoly :: Rational' -> QPolynomial
constQPoly = Rational' -> QPolynomial
forall a. a -> Polynomial a
constPoly

-- | Rational univariate polynomial from coefficients

-- 

-- >>> import Number.Ratio ( (%) )

-- >>> qpolyFromCoeffs [2 % 3, 5, 7 % 4]

qpolyFromCoeffs :: [Rational'] -> QPolynomial
qpolyFromCoeffs :: [Rational'] -> QPolynomial
qpolyFromCoeffs = [Rational'] -> QPolynomial
forall a. [a] -> Polynomial a
polyFromCoeffs

-- | The variable of a univariate qpolynomial; it is called \"outer\" because this is the variable 

-- occuring in the polynomial coefficients of a `SymbolicQSpray` 

--

-- prop> outerQVariable == qpolyFromCoeffs [0, 1] 

outerQVariable :: QPolynomial
outerQVariable :: QPolynomial
outerQVariable = [Rational'] -> QPolynomial
qpolyFromCoeffs [Rational'
0, Rational'
1] 

-- show a ratio

showQ :: (Eq a, Num a, Show a) => NumberRatio.T a -> String
showQ :: forall a. (Eq a, Num a, Show a) => T a -> String
showQ T a
q = if a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 
  then a -> String
forall a. Show a => a -> String
show a
n 
  else a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
d
  where
    n :: a
n = T a -> a
forall a. T a -> a
NumberRatio.numerator T a
q
    d :: a
d = T a -> a
forall a. T a -> a
NumberRatio.denominator T a
q 

-- | helper function for prettyRatioOfPolynomials (and prettySymbolicSpray)

showQpol :: forall a. (Eq a, AlgField.C a) 
         => Polynomial a -> String -> (a -> String) -> Bool -> String
showQpol :: forall a.
(Eq a, C a) =>
Polynomial a -> String -> (a -> String) -> Bool -> String
showQpol Polynomial a
pol String
variable a -> String
showCoeff Bool
brackets = if Bool
brackets 
  then Char
'[' Char -> String -> String
forall a. a -> [a] -> [a]
: String
polyString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
  else String
polyString
  where
    showCoeff' :: Int -> A a -> String
    showCoeff' :: Int -> A a -> String
showCoeff' Int
i (A a
coeff) = case Int
i of 
      Int
0 -> Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
showCoeff a
coeff String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
      Int
_ -> if a
coeff a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
AlgRing.one 
        then String
"" 
        else Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
showCoeff a
coeff String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    coeffs :: [A a]
coeffs   = Polynomial a -> [A a]
forall a. T a -> [a]
MathPol.coeffs Polynomial a
pol
    nonzeros :: [Int]
nonzeros = (A a -> Bool) -> [A a] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (A a -> A a -> Bool
forall a. Eq a => a -> a -> Bool
/= a -> A a
forall a. a -> A a
A a
forall a. C a => a
AlgAdd.zero) [A a]
coeffs
    terms :: [Text]
terms    = (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
showTerm) [Int]
nonzeros
      where
        showTerm :: Int -> String
showTerm Int
i = case Int
i of 
          Int
0 -> Int -> A a -> String
showCoeff' Int
0 ([A a]
coeffs [A a] -> Int -> A a
forall a. HasCallStack => [a] -> Int -> a
!! Int
0)
          Int
1 -> Int -> A a -> String
showCoeff' Int
1 ([A a]
coeffs [A a] -> Int -> A a
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
variable
          Int
_ -> Int -> A a -> String
showCoeff' Int
i ([A a]
coeffs [A a] -> Int -> A a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
variable String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
    polyString :: String
polyString = Text -> String
unpack (Text -> [Text] -> Text
intercalate (String -> Text
pack String
" + ") [Text]
terms)

-- | helper function for prettyRatioOfPolynomials (and prettySymbolicSpray)

showQpolysRatio :: forall a. (Eq a, AlgField.C a) 
                   => String -> (a -> String) -> RatioOfPolynomials a -> String
showQpolysRatio :: forall a.
(Eq a, C a) =>
String -> (a -> String) -> RatioOfPolynomials a -> String
showQpolysRatio String
var a -> String
showCoeff RatioOfPolynomials a
polysRatio = String
numeratorString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
denominatorString
  where
    denominator :: Polynomial a
denominator       = RatioOfPolynomials a -> Polynomial a
forall a. T a -> a
NumberRatio.denominator RatioOfPolynomials a
polysRatio
    brackets :: Bool
brackets          = Polynomial a
denominator Polynomial a -> Polynomial a -> Bool
forall a. Eq a => a -> a -> Bool
/= A a -> Polynomial a
forall a. a -> T a
MathPol.const (a -> A a
forall a. a -> A a
A a
forall a. C a => a
AlgRing.one)
    numeratorString :: String
numeratorString   = Polynomial a -> String -> (a -> String) -> Bool -> String
forall a.
(Eq a, C a) =>
Polynomial a -> String -> (a -> String) -> Bool -> String
showQpol (RatioOfPolynomials a -> Polynomial a
forall a. T a -> a
NumberRatio.numerator RatioOfPolynomials a
polysRatio) String
var a -> String
showCoeff Bool
brackets
    denominatorString :: String
denominatorString = if Bool -> Bool
not Bool
brackets
      then String
""
      else String
" / " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Polynomial a -> String -> (a -> String) -> Bool -> String
forall a.
(Eq a, C a) =>
Polynomial a -> String -> (a -> String) -> Bool -> String
showQpol Polynomial a
denominator String
var a -> String
showCoeff Bool
True

-- | Pretty form of a ratio of univariate polynomials

prettyRatioOfPolynomials :: (Eq a, AlgField.C a, Show a) 
  => String               -- ^ a string to denote the variable, e.g. @"a"@

  -> RatioOfPolynomials a 
  -> String 
prettyRatioOfPolynomials :: forall a.
(Eq a, C a, Show a) =>
String -> RatioOfPolynomials a -> String
prettyRatioOfPolynomials String
var = String -> (a -> String) -> RatioOfPolynomials a -> String
forall a.
(Eq a, C a) =>
String -> (a -> String) -> RatioOfPolynomials a -> String
showQpolysRatio String
var a -> String
forall a. Show a => a -> String
show 

-- | Pretty form of a ratio of univariate qpolynomials

prettyRatioOfQPolynomials 
  :: String               -- ^ a string to denote the variable, e.g. @"a"@ 

  -> RatioOfQPolynomials 
  -> String 
prettyRatioOfQPolynomials :: String -> RatioOfQPolynomials -> String
prettyRatioOfQPolynomials String
var = String -> (Rational' -> String) -> RatioOfQPolynomials -> String
forall a.
(Eq a, C a) =>
String -> (a -> String) -> RatioOfPolynomials a -> String
showQpolysRatio String
var Rational' -> String
forall a. (Eq a, Num a, Show a) => T a -> String
showQ

-- | Evaluates a ratio of univariate polynomials

evalRatioOfPolynomials :: AlgField.C a 
  => a                    -- ^ the value at which the evaluation is desired

  -> RatioOfPolynomials a 
  -> a
evalRatioOfPolynomials :: forall a. C a => a -> RatioOfPolynomials a -> a
evalRatioOfPolynomials a
value RatioOfPolynomials a
polysRatio = 
  a
resultNumerator a -> a -> a
forall a. C a => a -> a -> a
AlgField./ a
resultDenominator
  where
    A a
resultNumerator   = T (A a) -> A a -> A a
forall a. C a => T a -> a -> a
MathPol.evaluate (RatioOfPolynomials a -> T (A a)
forall a. T a -> a
NumberRatio.numerator RatioOfPolynomials a
polysRatio) (a -> A a
forall a. a -> A a
A a
value)
    A a
resultDenominator = T (A a) -> A a -> A a
forall a. C a => T a -> a -> a
MathPol.evaluate (RatioOfPolynomials a -> T (A a)
forall a. T a -> a
NumberRatio.denominator RatioOfPolynomials a
polysRatio) (a -> A a
forall a. a -> A a
A a
value)


-- Symbolic sprays ------------------------------------------------------------


type SymbolicSpray a = Spray (RatioOfPolynomials a)
type SymbolicQSpray  = SymbolicSpray Rational'

-- | Simplifies the coefficients (the ratio of univariate polynomials) of a 

-- symbolic spray

simplifySymbolicSpray :: 
  (Eq a, AlgField.C a) => SymbolicSpray a -> SymbolicSpray a
simplifySymbolicSpray :: forall a. (Eq a, C a) => SymbolicSpray a -> SymbolicSpray a
simplifySymbolicSpray = (RatioOfPolynomials a -> RatioOfPolynomials a)
-> HashMap Powers (RatioOfPolynomials a)
-> HashMap Powers (RatioOfPolynomials a)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (RatioOfPolynomials a
-> RatioOfPolynomials a -> RatioOfPolynomials a
forall a. C a => a -> a -> a
AlgAdd.+ RatioOfPolynomials a
forall a. C a => a
AlgAdd.zero)

-- | Pretty form of a symbolic spray

prettySymbolicSpray 
  :: (Eq a, Show a, AlgField.C a) 
  => String          -- ^ a string to denote the outer variable of the spray, e.g. @"a"@

  -> SymbolicSpray a -- ^ a symbolic spray; note that this function does not simplify it

  -> String 
prettySymbolicSpray :: forall a.
(Eq a, Show a, C a) =>
String -> SymbolicSpray a -> String
prettySymbolicSpray String
var = (RatioOfPolynomials a -> String)
-> Spray (RatioOfPolynomials a) -> String
forall a. (a -> String) -> Spray a -> String
prettySpray'' (String -> (a -> String) -> RatioOfPolynomials a -> String
forall a.
(Eq a, C a) =>
String -> (a -> String) -> RatioOfPolynomials a -> String
showQpolysRatio String
var a -> String
forall a. Show a => a -> String
show)

-- | Pretty form of a symbolic qspray

prettySymbolicQSpray 
  :: String          -- ^ a string to denote the outer variable of the spray, e.g. @"a"@

  -> SymbolicQSpray  -- ^ a symbolic qspray; note that this function does not simplify it

  -> String 
prettySymbolicQSpray :: String -> SymbolicQSpray -> String
prettySymbolicQSpray String
var = (RatioOfQPolynomials -> String) -> SymbolicQSpray -> String
forall a. (a -> String) -> Spray a -> String
prettySpray'' (String -> (Rational' -> String) -> RatioOfQPolynomials -> String
forall a.
(Eq a, C a) =>
String -> (a -> String) -> RatioOfPolynomials a -> String
showQpolysRatio String
var Rational' -> String
forall a. (Eq a, Num a, Show a) => T a -> String
showQ)

-- | Substitutes a value to the outer variable of a symbolic spray

evalSymbolicSpray :: AlgField.C a => SymbolicSpray a -> a -> Spray a
evalSymbolicSpray :: forall a. C a => SymbolicSpray a -> a -> Spray a
evalSymbolicSpray SymbolicSpray a
spray a
x = (RatioOfPolynomials a -> a) -> SymbolicSpray a -> HashMap Powers a
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (a -> RatioOfPolynomials a -> a
forall a. C a => a -> RatioOfPolynomials a -> a
evalRatioOfPolynomials a
x) SymbolicSpray a
spray 

-- | Substitutes a value to the outer variable of a symbolic spray as well 

-- as some values to the inner variables of this spray

evalSymbolicSpray' :: AlgField.C a 
  => SymbolicSpray a -- ^ symbolic spray to be evaluated

  -> a               -- ^ a value for the outer variable

  -> [a]             -- ^ some values for the inner variables 

  -> a
evalSymbolicSpray' :: forall a. C a => SymbolicSpray a -> a -> [a] -> a
evalSymbolicSpray' SymbolicSpray a
spray a
x [a]
xs = if [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SymbolicSpray a -> Int
forall a. Spray a -> Int
numberOfVariables SymbolicSpray a
spray 
  then Spray a -> [a] -> a
forall a. C a => Spray a -> [a] -> a
evalSpray (SymbolicSpray a -> a -> Spray a
forall a. C a => SymbolicSpray a -> a -> Spray a
evalSymbolicSpray SymbolicSpray a
spray a
x) [a]
xs
  else String -> a
forall a. HasCallStack => String -> a
error String
"evalSymbolicSpray': not enough values provided."

-- helper function for evalSymbolicSpray''

evalSymbolicMonomial :: (Eq a, AlgField.C a) 
  => [a] -> Monomial (RatioOfPolynomials a) -> RatioOfPolynomials a
evalSymbolicMonomial :: forall a.
(Eq a, C a) =>
[a] -> Monomial (RatioOfPolynomials a) -> RatioOfPolynomials a
evalSymbolicMonomial [a]
xs (Powers
powers, RatioOfPolynomials a
coeff) = 
  [a] -> a
forall a. C a => [a] -> a
AlgRing.product ((a -> Integer -> a) -> [a] -> [Integer] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> Integer -> a
forall a. C a => a -> Integer -> a
(AlgRing.^) [a]
xs [Integer]
pows) a -> RatioOfPolynomials a -> RatioOfPolynomials a
forall a.
(Eq a, C a) =>
a -> RatioOfPolynomials a -> RatioOfPolynomials a
*. RatioOfPolynomials a
coeff
  where 
    pows :: [Integer]
pows = Seq Integer -> [Integer]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Seq Int -> Seq Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Powers -> Seq Int
exponents Powers
powers)

-- | Substitutes some values to the inner variables of a symbolic spray

evalSymbolicSpray'' 
  :: (Eq a, AlgField.C a) => SymbolicSpray a -> [a] -> RatioOfPolynomials a
evalSymbolicSpray'' :: forall a.
(Eq a, C a) =>
SymbolicSpray a -> [a] -> RatioOfPolynomials a
evalSymbolicSpray'' SymbolicSpray a
spray [a]
xs = if [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SymbolicSpray a -> Int
forall a. Spray a -> Int
numberOfVariables SymbolicSpray a
spray
  then [RatioOfPolynomials a] -> RatioOfPolynomials a
forall a. C a => [a] -> a
AlgAdd.sum ([RatioOfPolynomials a] -> RatioOfPolynomials a)
-> [RatioOfPolynomials a] -> RatioOfPolynomials a
forall a b. (a -> b) -> a -> b
$ (Monomial (RatioOfPolynomials a) -> RatioOfPolynomials a)
-> [Monomial (RatioOfPolynomials a)] -> [RatioOfPolynomials a]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> Monomial (RatioOfPolynomials a) -> RatioOfPolynomials a
forall a.
(Eq a, C a) =>
[a] -> Monomial (RatioOfPolynomials a) -> RatioOfPolynomials a
evalSymbolicMonomial [a]
xs) (SymbolicSpray a -> [Monomial (RatioOfPolynomials a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList SymbolicSpray a
spray)
  else String -> RatioOfPolynomials a
forall a. HasCallStack => String -> a
error String
"evalSymbolicSpray'': not enough values provided."


-- Sprays ---------------------------------------------------------------------


data Powers = Powers
  { Powers -> Seq Int
exponents  :: Seq Int
  , Powers -> Int
nvariables :: Int
  }
  deriving Int -> Powers -> String -> String
[Powers] -> String -> String
Powers -> String
(Int -> Powers -> String -> String)
-> (Powers -> String)
-> ([Powers] -> String -> String)
-> Show Powers
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Powers -> String -> String
showsPrec :: Int -> Powers -> String -> String
$cshow :: Powers -> String
show :: Powers -> String
$cshowList :: [Powers] -> String -> String
showList :: [Powers] -> String -> String
Show

instance Eq Powers where
  (==) :: Powers -> Powers -> Bool
  Powers
pows1 == :: Powers -> Powers -> Bool
== Powers
pows2 = Powers -> Seq Int
exponents Powers
pows1' Seq Int -> Seq Int -> Bool
forall a. Eq a => a -> a -> Bool
== Powers -> Seq Int
exponents Powers
pows2'
    where 
      (Powers
pows1', Powers
pows2') = (Powers, Powers) -> (Powers, Powers)
harmonize (Powers
pows1, Powers
pows2)

instance Hashable Powers where
  hashWithSalt :: Int -> Powers -> Int
  hashWithSalt :: Int -> Powers -> Int
hashWithSalt Int
k Powers
pows = Int -> (Seq Int, Int) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
k (Powers -> Seq Int
exponents Powers
pows, Powers -> Int
nvariables Powers
pows)

-- | append trailing zeros

growSequence :: Seq Int -> Int -> Int -> Seq Int
growSequence :: Seq Int -> Int -> Int -> Seq Int
growSequence Seq Int
s Int
m Int
n = Seq Int
s Seq Int -> Seq Int -> Seq Int
forall a. Seq a -> Seq a -> Seq a
>< Seq Int
t where t :: Seq Int
t = Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Int
0

growSequence' :: Int -> Seq Int -> Seq Int
growSequence' :: Int -> Seq Int -> Seq Int
growSequence' Int
n Seq Int
s = Seq Int -> Int -> Int -> Seq Int
growSequence Seq Int
s (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
s) Int
n

-- | append trailing zeros to get the same length

harmonize :: (Powers, Powers) -> (Powers, Powers)
harmonize :: (Powers, Powers) -> (Powers, Powers)
harmonize (Powers
pows1, Powers
pows2) = (Seq Int -> Int -> Powers
Powers Seq Int
e1' Int
n, Seq Int -> Int -> Powers
Powers Seq Int
e2' Int
n)
 where
  e1 :: Seq Int
e1            = Powers -> Seq Int
exponents Powers
pows1
  e2 :: Seq Int
e2            = Powers -> Seq Int
exponents Powers
pows2
  n1 :: Int
n1            = Powers -> Int
nvariables Powers
pows1
  n2 :: Int
n2            = Powers -> Int
nvariables Powers
pows2
  (Seq Int
e1', Seq Int
e2', Int
n) = if Int
n1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n2
    then (Seq Int -> Int -> Int -> Seq Int
growSequence Seq Int
e1 Int
n1 Int
n2, Seq Int
e2, Int
n2)
    else (Seq Int
e1, Seq Int -> Int -> Int -> Seq Int
growSequence Seq Int
e2 Int
n2 Int
n1, Int
n1)

-- | drop trailing zeros

simplifyPowers :: Powers -> Powers
simplifyPowers :: Powers -> Powers
simplifyPowers Powers
pows = Seq Int -> Int -> Powers
Powers Seq Int
s (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
s)
  where 
    s :: Seq Int
s = (Int -> Bool) -> Seq Int -> Seq Int
forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileR (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Powers -> Seq Int
exponents Powers
pows)

type Monomial a = (Powers, a)
type Spray a = HashMap Powers a
type QSpray = Spray Rational'

-- | addition of two sprays

addSprays :: (AlgAdd.C a, Eq a) => Spray a -> Spray a -> Spray a
addSprays :: forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
addSprays Spray a
p Spray a
q = Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a
cleanSpray (Spray a -> Spray a) -> Spray a -> Spray a
forall a b. (a -> b) -> a -> b
$ (Spray a -> Powers -> a -> Spray a)
-> Spray a -> Spray a -> Spray a
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' Spray a -> Powers -> a -> Spray a
forall {k} {v}.
(Hashable k, C v) =>
HashMap k v -> k -> v -> HashMap k v
f Spray a
p Spray a
q
  where 
    f :: HashMap k v -> k -> v -> HashMap k v
f HashMap k v
s k
powers v
coef = (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith v -> v -> v
forall a. C a => a -> a -> a
(AlgAdd.+) k
powers v
coef HashMap k v
s

-- | opposite spray

negateSpray :: AlgAdd.C a => Spray a -> Spray a
negateSpray :: forall a. C a => Spray a -> Spray a
negateSpray = (a -> a) -> HashMap Powers a -> HashMap Powers a
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> a
forall a. C a => a -> a
AlgAdd.negate

-- | scale a spray by a scalar

scaleSpray :: (AlgRing.C a, Eq a) => a -> Spray a -> Spray a
scaleSpray :: forall a. (C a, Eq a) => a -> Spray a -> Spray a
scaleSpray a
lambda Spray a
p = Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a
cleanSpray (Spray a -> Spray a) -> Spray a -> Spray a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Spray a -> Spray a
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (a
lambda a -> a -> a
forall a. C a => a -> a -> a
AlgRing.*) Spray a
p

-- | multiply two monomials

multMonomial :: AlgRing.C a => Monomial a -> Monomial a -> Monomial a
multMonomial :: forall a. C a => Monomial a -> Monomial a -> Monomial a
multMonomial (Powers
pows1, a
coef1) (Powers
pows2, a
coef2) = (Powers
pows, a
coef1 a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* a
coef2)
 where
  (Powers
pows1', Powers
pows2') = (Powers, Powers) -> (Powers, Powers)
harmonize (Powers
pows1, Powers
pows2)
  expts :: Seq Int
expts            = (Int -> Int -> Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Powers -> Seq Int
exponents Powers
pows1') (Powers -> Seq Int
exponents Powers
pows2')
  pows :: Powers
pows             = Seq Int -> Int -> Powers
Powers Seq Int
expts (Powers -> Int
nvariables Powers
pows1')

-- | multiply two sprays

multSprays :: (AlgRing.C a, Eq a) => Spray a -> Spray a -> Spray a
multSprays :: forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
multSprays Spray a
p Spray a
q = Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a
cleanSpray (Spray a -> Spray a) -> Spray a -> Spray a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [(Powers, a)] -> Spray a
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HM.fromListWith a -> a -> a
forall a. C a => a -> a -> a
(AlgAdd.+) [(Powers, a)]
prods
 where
  p' :: [(Powers, a)]
p'    = Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
p
  q' :: [(Powers, a)]
q'    = Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
q
  prods :: [(Powers, a)]
prods = [ (Powers, a) -> (Powers, a) -> (Powers, a)
forall a. C a => Monomial a -> Monomial a -> Monomial a
multMonomial (Powers, a)
mp (Powers, a)
mq | (Powers, a)
mp <- [(Powers, a)]
p', (Powers, a)
mq <- [(Powers, a)]
q' ]

instance (AlgAdd.C a, Eq a) => AlgAdd.C (Spray a) where
  (+) :: Spray a -> Spray a -> Spray a
  Spray a
p + :: Spray a -> Spray a -> Spray a
+ Spray a
q  = Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
addSprays Spray a
p Spray a
q
  zero :: Spray a
  zero :: Spray a
zero   = Spray a
forall k v. HashMap k v
HM.empty
  negate :: Spray a -> Spray a
  negate :: Spray a -> Spray a
negate = Spray a -> Spray a
forall a. C a => Spray a -> Spray a
negateSpray

instance (AlgRing.C a, Eq a) => AlgMod.C a (Spray a) where
  (*>) :: a -> Spray a -> Spray a
  a
lambda *> :: a -> Spray a -> Spray a
*> Spray a
p = a -> Spray a -> Spray a
forall a. (C a, Eq a) => a -> Spray a -> Spray a
scaleSpray a
lambda Spray a
p

instance (AlgRing.C a, Eq a) => AlgRing.C (Spray a) where
  (*) :: Spray a -> Spray a -> Spray a
  Spray a
p * :: Spray a -> Spray a -> Spray a
* Spray a
q = Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
multSprays Spray a
p Spray a
q
  one :: Spray a
  one :: Spray a
one   = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
0

{- instance (AlgRing.C a, Eq a) => Num (Spray a) where
  p + q = addSprays p q
  negate = negateSpray
  p * q = multSprays p q
  fromInteger n = fromInteger n .^ AlgRing.one
  abs _ = error "Prelude.Num.abs: inappropriate abstraction"
  signum _ = error "Prelude.Num.signum: inappropriate abstraction"
 -} 

infixl 6 ^+^
-- | Addition of two sprays

(^+^) :: (AlgAdd.C a, Eq a) => Spray a -> Spray a -> Spray a
^+^ :: forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^+^) Spray a
p Spray a
q = Spray a
p Spray a -> Spray a -> Spray a
forall a. C a => a -> a -> a
AlgAdd.+ Spray a
q

infixl 6 ^-^
-- | Substraction of two sprays

(^-^) :: (AlgAdd.C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ :: forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^-^) Spray a
p Spray a
q = Spray a
p Spray a -> Spray a -> Spray a
forall a. C a => a -> a -> a
AlgAdd.- Spray a
q

infixl 7 ^*^
-- | Multiply two sprays

(^*^) :: (AlgRing.C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ :: forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^*^) Spray a
p Spray a
q = Spray a
p Spray a -> Spray a -> Spray a
forall a. C a => a -> a -> a
AlgRing.* Spray a
q

infixr 8 ^**^
-- | Power of a spray

(^**^) :: (AlgRing.C a, Eq a) => Spray a -> Int -> Spray a
^**^ :: forall a. (C a, Eq a) => Spray a -> Int -> Spray a
(^**^) Spray a
p Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 
  then [Spray a] -> Spray a
forall a. C a => [a] -> a
AlgRing.product (Int -> Spray a -> [Spray a]
forall a. Int -> a -> [a]
replicate Int
n Spray a
p)
  else String -> Spray a
forall a. HasCallStack => String -> a
error String
"(^**^): negative power of a spray is not allowed."

infixr 7 *^
-- | Scale a spray by a scalar

(*^) :: (AlgRing.C a, Eq a) => a -> Spray a -> Spray a
*^ :: forall a. (C a, Eq a) => a -> Spray a -> Spray a
(*^) a
lambda Spray a
pol = a
lambda a -> Spray a -> Spray a
forall a v. C a v => a -> v -> v
AlgMod.*> Spray a
pol

infixr 7 .^
-- | Scale a spray by an integer

--

-- prop> 3 .^ p == p ^+^ p ^+^ p

(.^) :: (AlgAdd.C a, Eq a) => Int -> Spray a -> Spray a
.^ :: forall a. (C a, Eq a) => Int -> Spray a -> Spray a
(.^) Int
k Spray a
pol = if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
  then [Spray a] -> Spray a
forall a. C a => [a] -> a
AlgAdd.sum (Int -> Spray a -> [Spray a]
forall a. Int -> a -> [a]
replicate Int
k Spray a
pol)
  else Spray a -> Spray a
forall a. C a => a -> a
AlgAdd.negate (Spray a -> Spray a) -> Spray a -> Spray a
forall a b. (a -> b) -> a -> b
$ [Spray a] -> Spray a
forall a. C a => [a] -> a
AlgAdd.sum (Int -> Spray a -> [Spray a]
forall a. Int -> a -> [a]
replicate (-Int
k) Spray a
pol)

-- | drop trailing zeros in the powers of a spray

simplifySpray :: Spray a -> Spray a
simplifySpray :: forall a. Spray a -> Spray a
simplifySpray = (Powers -> Powers) -> HashMap Powers a -> HashMap Powers a
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HM.mapKeys Powers -> Powers
simplifyPowers

-- | simplify powers and remove zero terms

cleanSpray :: (AlgAdd.C a, Eq a) => Spray a -> Spray a
cleanSpray :: forall a. (C a, Eq a) => Spray a -> Spray a
cleanSpray Spray a
p = (a -> Bool) -> Spray a -> Spray a
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. C a => a
AlgAdd.zero) (Spray a -> Spray a
forall a. Spray a -> Spray a
simplifySpray Spray a
p)

-- | derivative of a monomial

derivMonomial :: AlgRing.C a => Int -> Monomial a -> Monomial a 
derivMonomial :: forall a. C a => Int -> Monomial a -> Monomial a
derivMonomial Int
i (Powers
pows, a
coef) = if Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
expts 
  then (Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0, a
forall a. C a => a
AlgAdd.zero)
  else (Powers
pows', a
coef')
   where
    i' :: Int
i'     = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    expts :: Seq Int
expts  = Powers -> Seq Int
exponents Powers
pows
    expt_i :: Int
expt_i = Seq Int
expts Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
i'
    expts' :: Seq Int
expts' = (Int -> Int) -> Int -> Seq Int -> Seq Int
forall a. (a -> a) -> Int -> Seq a -> Seq a
adjust (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) Int
i' Seq Int
expts
    coef' :: a
coef'  = [a] -> a
forall a. C a => [a] -> a
AlgAdd.sum (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
expt_i a
coef)
    pows' :: Powers
pows'  = Seq Int -> Int -> Powers
Powers Seq Int
expts' (Powers -> Int
nvariables Powers
pows) 

-- | Derivative of a spray

derivSpray 
  :: (AlgRing.C a, Eq a) 
  => Int     -- ^ index of the variable of differentiation (starting at 1)

  -> Spray a -- ^ the spray to be derivated

  -> Spray a -- ^ the derivated spray

derivSpray :: forall a. (C a, Eq a) => Int -> Spray a -> Spray a
derivSpray Int
i Spray a
p = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 
  then Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a
cleanSpray (Spray a -> Spray a) -> Spray a -> Spray a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [(Powers, a)] -> Spray a
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HM.fromListWith a -> a -> a
forall a. C a => a -> a -> a
(AlgAdd.+) [(Powers, a)]
monomials
  else String -> Spray a
forall a. HasCallStack => String -> a
error String
"derivSpray: invalid index."
 where
  p' :: [(Powers, a)]
p'        = Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
p
  monomials :: [(Powers, a)]
monomials = [ Int -> (Powers, a) -> (Powers, a)
forall a. C a => Int -> Monomial a -> Monomial a
derivMonomial Int
i (Powers, a)
mp | (Powers, a)
mp <- [(Powers, a)]
p' ]

-- | Spray corresponding to the basic monomial x_n

--

-- >>> x :: lone 1 :: Spray Int

-- >>> y :: lone 2 :: Spray Int

-- >>> p = 2*^x^**^2 ^-^ 3*^y

-- >>> putStrLn $ prettySpray' p

-- (2) x1^2 + (-3) x2

--

-- prop> lone 0 == unitSpray

lone :: AlgRing.C a => Int -> Spray a
lone :: forall a. C a => Int -> Spray a
lone Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 
  then Powers -> a -> HashMap Powers a
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Powers
pows a
forall a. C a => a
AlgRing.one
  else String -> HashMap Powers a
forall a. HasCallStack => String -> a
error String
"lone: invalid index."
 where
  pows :: Powers
pows = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0
    else Seq Int -> Int -> Powers
Powers (Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
forall a. C a => a
AlgAdd.zero Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
forall a. C a => a
AlgRing.one) Int
n

-- | The unit spray

--

-- prop> p ^*^ unitSpray == p

unitSpray :: AlgRing.C a => Spray a
unitSpray :: forall a. C a => Spray a
unitSpray = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
0

-- | The null spray

--

-- prop> p ^+^ zeroSpray == p

zeroSpray :: (Eq a, AlgAdd.C a) => Spray a
zeroSpray :: forall a. (Eq a, C a) => Spray a
zeroSpray = Spray a
forall a. C a => a
AlgAdd.zero

-- | Constant spray

--

-- prop> constantSpray 3 == 3 *^ unitSpray

constantSpray :: (AlgRing.C a, Eq a) => a -> Spray a
constantSpray :: forall a. (C a, Eq a) => a -> Spray a
constantSpray a
c = a
c a -> Spray a -> Spray a
forall a. (C a, Eq a) => a -> Spray a -> Spray a
*^ Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
0

-- | Get coefficient of a term of a spray 

--

-- >>> 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

-- >>> getCoefficient [3, 2, 0] p

-- 4

-- >>> getCoefficient [0, 4] p

-- 0

getCoefficient :: AlgAdd.C a => [Int] -> Spray a -> a
getCoefficient :: forall a. C a => [Int] -> Spray a -> a
getCoefficient [Int]
expnts Spray a
spray = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Powers
powers Spray a
spray)
  where
    expnts' :: Seq Int
expnts' = (Int -> Bool) -> Seq Int -> Seq Int
forall a. (a -> Bool) -> Seq a -> Seq a
S.dropWhileR (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) ([Int] -> Seq Int
forall a. [a] -> Seq a
S.fromList [Int]
expnts)
    powers :: Powers
powers  = Seq Int -> Int -> Powers
Powers Seq Int
expnts' (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
expnts')

-- | Get the constant term of a spray

--

-- prop> getConstantTerm p == getCoefficient [] p 

getConstantTerm :: AlgAdd.C a => Spray a -> a
getConstantTerm :: forall a. C a => Spray a -> a
getConstantTerm Spray a
spray = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Powers
powers Spray a
spray)
  where
    powers :: Powers
powers  = Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0

-- | number of variables in a spray

numberOfVariables :: Spray a -> Int
numberOfVariables :: forall a. Spray a -> Int
numberOfVariables Spray a
spray =
  if [Powers] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Powers]
powers then Int
0 else [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Powers -> Int) -> [Powers] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Int
nvariables [Powers]
powers)
  where
    powers :: [Powers]
powers = Spray a -> [Powers]
forall k v. HashMap k v -> [k]
HM.keys Spray a
spray

-- | evaluates a monomial

evalMonomial :: AlgRing.C a => [a] -> Monomial a -> a
evalMonomial :: forall a. C a => [a] -> Monomial a -> a
evalMonomial [a]
xyz (Powers
powers, a
coeff) = 
  a
coeff a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* [a] -> a
forall a. C a => [a] -> a
AlgRing.product ((a -> Integer -> a) -> [a] -> [Integer] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> Integer -> a
forall a. C a => a -> Integer -> a
(AlgRing.^) [a]
xyz [Integer]
pows)
  where 
    pows :: [Integer]
pows = Seq Integer -> [Integer]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Seq Int -> Seq Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Powers -> Seq Int
exponents Powers
powers)

-- | Evaluates a spray

--

-- >>> x :: lone 1 :: Spray Int

-- >>> y :: lone 2 :: Spray Int

-- >>> p = 2*^x^**^2 ^-^ 3*^y

-- >>> evalSpray p [2, 1]

-- 5

evalSpray :: AlgRing.C a => Spray a -> [a] -> a
evalSpray :: forall a. C a => Spray a -> [a] -> a
evalSpray Spray a
p [a]
xyz = if [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xyz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
p
  then [a] -> a
forall a. C a => [a] -> a
AlgAdd.sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (Monomial a -> a) -> [Monomial a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> Monomial a -> a
forall a. C a => [a] -> Monomial a -> a
evalMonomial [a]
xyz) (Spray a -> [Monomial a]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
p)
  else String -> a
forall a. HasCallStack => String -> a
error String
"evalSpray: not enough values provided."

-- | spray from monomial

fromMonomial :: Monomial a -> Spray a
fromMonomial :: forall a. Monomial a -> Spray a
fromMonomial (Powers
pows, a
coeff) = Powers -> a -> HashMap Powers a
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Powers
pows a
coeff

-- | substitute some variables in a monomial

substituteMonomial :: AlgRing.C a => [Maybe a] -> Monomial a -> Monomial a
substituteMonomial :: forall a. C a => [Maybe a] -> Monomial a -> Monomial a
substituteMonomial [Maybe a]
subs (Powers
powers, a
coeff) = (Powers
powers'', a
coeff')
  where
    pows :: Seq Int
pows     = Powers -> Seq Int
exponents Powers
powers
    n :: Int
n        = Powers -> Int
nvariables Powers
powers
    indices :: [Int]
indices  = (Maybe a -> Bool) -> [Maybe a] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Int -> [Maybe a] -> [Maybe a]
forall a. Int -> [a] -> [a]
take Int
n [Maybe a]
subs)
    pows' :: [Integer]
pows'    = [Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seq Int
pows Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
i) | Int
i <- [Int]
indices]
    xyz :: [a]
xyz      = [Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe a]
subs [Maybe a] -> Int -> Maybe a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) | Int
i <- [Int]
indices]
    coeff' :: a
coeff'   = a
coeff a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* [a] -> a
forall a. C a => [a] -> a
AlgRing.product ((a -> Integer -> a) -> [a] -> [Integer] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> Integer -> a
forall a. C a => a -> Integer -> a
(AlgRing.^) [a]
xyz [Integer]
pows')
    f :: Int -> a -> a
f Int
i a
a    = if Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
indices then a
0 else a
a
    pows'' :: Seq Int
pows''   = (Int -> Int -> Int) -> Seq Int -> Seq Int
forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex Int -> Int -> Int
forall {a}. Num a => Int -> a -> a
f Seq Int
pows
    powers'' :: Powers
powers'' = Powers -> Powers
simplifyPowers (Powers -> Powers) -> Powers -> Powers
forall a b. (a -> b) -> a -> b
$ Seq Int -> Int -> Powers
Powers Seq Int
pows'' Int
n

-- | Substitutes some variables in a spray by some values

--

-- >>> x1 :: lone 1 :: Spray Int

-- >>> x2 :: lone 2 :: Spray Int

-- >>> x3 :: lone 3 :: Spray Int

-- >>> p = x1^**^2 ^-^ x2 ^+^ x3 ^-^ unitSpray

-- >>> p' = substituteSpray [Just 2, Nothing, Just 3] p

-- >>> putStrLn $ prettySpray' p'

-- (-1) x2 + (6) 

substituteSpray :: (Eq a, AlgRing.C a) => [Maybe a] -> Spray a -> Spray a
substituteSpray :: forall a. (Eq a, C a) => [Maybe a] -> Spray a -> Spray a
substituteSpray [Maybe a]
subs Spray a
spray = if [Maybe a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe a]
subs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n 
  then Spray a
spray'
  else String -> Spray a
forall a. HasCallStack => String -> a
error String
"substituteSpray: incorrect length of the substitutions list."
  where
    n :: Int
n         = Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray
    monomials :: [(Powers, a)]
monomials = Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
spray
    spray' :: Spray a
spray'    = 
      (Spray a -> Spray a -> Spray a) -> [Spray a] -> Spray a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^+^) (((Powers, a) -> Spray a) -> [(Powers, a)] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map ((Powers, a) -> Spray a
forall a. Monomial a -> Spray a
fromMonomial ((Powers, a) -> Spray a)
-> ((Powers, a) -> (Powers, a)) -> (Powers, a) -> Spray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> (Powers, a) -> (Powers, a)
forall a. C a => [Maybe a] -> Monomial a -> Monomial a
substituteMonomial [Maybe a]
subs) [(Powers, a)]
monomials)

-- | Converts a spray with rational coefficients to a spray with double 

-- coefficients (useful for evaluation)

fromRationalSpray :: Spray Rational -> Spray Double
fromRationalSpray :: Spray Rational -> Spray Double
fromRationalSpray = (Rational -> Double) -> Spray Rational -> Spray Double
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Rational -> Double
forall a. Fractional a => Rational -> a
fromRational

-- | Sustitutes the variables of a spray with some sprays 

-- (e.g. change of variables)

--

-- >>> x :: lone 1 :: Spray Int

-- >>> y :: lone 2 :: Spray Int

-- >>> z :: lone 3 :: Spray Int

-- >>> p = x ^+^ y

-- >>> q = composeSpray p [z, x ^+^ y ^+^ z]

-- >>> putStrLn $ prettySprayXYZ q

-- (1) X + (1) Y + (2) Z

composeSpray :: forall a. (AlgRing.C a, Eq a) 
                => Spray a -> [Spray a] -> Spray a
composeSpray :: forall a. (C a, Eq a) => Spray a -> [Spray a] -> Spray a
composeSpray Spray a
p = Spray (Spray a) -> [Spray a] -> Spray a
forall a. C a => Spray a -> [a] -> a
evalSpray (Spray a -> Spray (Spray a)
identify Spray a
p)
  where 
    identify :: Spray a -> Spray (Spray a)
    identify :: Spray a -> Spray (Spray a)
identify = (a -> Spray a) -> Spray a -> Spray (Spray a)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map a -> Spray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray

-- | Creates a spray from a list of terms

fromList :: (AlgRing.C a, Eq a) => [([Int], a)] -> Spray a
fromList :: forall a. (C a, Eq a) => [([Int], a)] -> Spray a
fromList [([Int], a)]
x = Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a
cleanSpray (Spray a -> Spray a) -> Spray a -> Spray a
forall a b. (a -> b) -> a -> b
$ [(Powers, a)] -> Spray a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Powers, a)] -> Spray a) -> [(Powers, a)] -> Spray a
forall a b. (a -> b) -> a -> b
$ (([Int], a) -> (Powers, a)) -> [([Int], a)] -> [(Powers, a)]
forall a b. (a -> b) -> [a] -> [b]
map
  (\([Int]
expts, a
coef) -> (Seq Int -> Int -> Powers
Powers ([Int] -> Seq Int
forall a. [a] -> Seq a
S.fromList [Int]
expts) ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
expts), a
coef)) [([Int], a)]
x

-- | Permutes the variables of a spray

--

-- >>> f :: Spray Rational -> Spray Rational -> Spray Rational -> Spray Rational

-- >>> f p1 p2 p3 = p1^**^4 ^+^ (2*^p2^**^3) ^+^ (3*^p3^**^2) ^-^ (4*^unitSpray)

-- >>> x1 = lone 1 :: Spray Rational

-- >>> x2 = lone 2 :: Spray Rational

-- >>> x3 = lone 3 :: Spray Rational

-- >>> p = f x1 x2 x3

--

-- prop> permuteVariables [3, 1, 2] p == f x3 x1 x2

permuteVariables :: [Int] -> Spray a -> Spray a
permuteVariables :: forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation Spray a
spray = 
  if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n Bool -> Bool -> Bool
&& [Int] -> Bool
forall {a}. (Ord a, Num a) => [a] -> Bool
isPermutation [Int]
permutation  
    then Spray a
spray'
    else String -> Spray a
forall a. HasCallStack => String -> a
error String
"permuteVariables: invalid permutation."
  where
    n :: Int
n  = Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray
    n' :: Int
n' = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
permutation
    isPermutation :: [a] -> Bool
isPermutation [a]
pmtn = [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [a]
pmtn a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 Bool -> Bool -> Bool
&& [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
pmtn) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n'
    intmap :: IntMap Int
intmap         = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
IM.fromList ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
permutation [Int
1 .. Int
n'])
    invpermutation :: [Int]
invpermutation = [IntMap Int
intmap IntMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
IM.! Int
i | Int
i <- [Int
1 .. Int
n']]
    permuteSeq :: Seq a -> Seq a
permuteSeq Seq a
x   = 
      (Int -> a -> a) -> Seq a -> Seq a
forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex (\Int
i a
_ -> Seq a
x Seq a -> Int -> a
forall a. Seq a -> Int -> a
`index` ([Int]
invpermutation [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Seq a
x 
    ([Powers]
powers, [a]
coeffs) = [(Powers, a)] -> ([Powers], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip (Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
spray)
    expnts :: [Seq Int]
expnts  = (Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents [Powers]
powers
    expnts' :: [Seq Int]
expnts' = (Seq Int -> Seq Int) -> [Seq Int] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Seq Int
forall {a}. Seq a -> Seq a
permuteSeq (Seq Int -> Seq Int) -> (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq Int -> Seq Int
growSequence' Int
n') [Seq Int]
expnts
    powers' :: [Powers]
powers' = (Seq Int -> Powers) -> [Seq Int] -> [Powers]
forall a b. (a -> b) -> [a] -> [b]
map (\Seq Int
exps -> Powers -> Powers
simplifyPowers (Seq Int -> Int -> Powers
Powers Seq Int
exps Int
n')) [Seq Int]
expnts'
    spray' :: Spray a
spray'  = [(Powers, a)] -> Spray a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([Powers] -> [a] -> [(Powers, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Powers]
powers' [a]
coeffs)

-- | Swaps two variables of a spray

-- 

-- prop> swapVariables (1, 3) p == permuteVariables [3, 2, 1] p

swapVariables :: (Int, Int) -> Spray a -> Spray a
swapVariables :: forall a. (Int, Int) -> Spray a -> Spray a
swapVariables (Int
i, Int
j) Spray a
spray = 
  if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
1 Bool -> Bool -> Bool
&& Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
1  
    then Spray a
spray'
    else String -> Spray a
forall a. HasCallStack => String -> a
error String
"swapVariables: invalid indices."
  where
    n :: Int
n = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray, Int
i, Int
j]
    f :: Int -> Int
f Int
k | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i    = Int
j
        | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j    = Int
i
        | Bool
otherwise = Int
k
    transposition :: [Int]
transposition = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
f [Int
1 .. Int
n]
    permuteSeq :: Seq a -> Seq a
permuteSeq Seq a
x  = 
      (Int -> a -> a) -> Seq a -> Seq a
forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex (\Int
ii a
_ -> Seq a
x Seq a -> Int -> a
forall a. Seq a -> Int -> a
`index` ([Int]
transposition [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
ii Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Seq a
x 
    ([Powers]
powers, [a]
coeffs) = [(Powers, a)] -> ([Powers], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip (Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
spray)
    expnts :: [Seq Int]
expnts  = (Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents [Powers]
powers
    expnts' :: [Seq Int]
expnts' = (Seq Int -> Seq Int) -> [Seq Int] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Seq Int
forall {a}. Seq a -> Seq a
permuteSeq (Seq Int -> Seq Int) -> (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq Int -> Seq Int
growSequence' Int
n) [Seq Int]
expnts
    powers' :: [Powers]
powers' = (Seq Int -> Powers) -> [Seq Int] -> [Powers]
forall a b. (a -> b) -> [a] -> [b]
map (\Seq Int
exps -> Powers -> Powers
simplifyPowers (Seq Int -> Int -> Powers
Powers Seq Int
exps Int
n)) [Seq Int]
expnts'
    spray' :: Spray a
spray'  = [(Powers, a)] -> Spray a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([Powers] -> [a] -> [(Powers, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Powers]
powers' [a]
coeffs)


-- pretty stuff ---------------------------------------------------------------


-- | prettyPowers "x" [0, 2, 1] = x^(0, 2, 1)

prettyPowers :: String -> [Int] -> Text
prettyPowers :: String -> [Int] -> Text
prettyPowers String
var [Int]
pows = Text -> Text -> Text
append (String -> Text
pack String
x) (Char -> Text -> Text
cons Char
'(' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
snoc Text
string Char
')')
 where
  x :: String
x      = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^"
  string :: Text
string = Text -> [Text] -> Text
intercalate (String -> Text
pack String
", ") ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int]
pows)

-- | Pretty form of a spray

--

-- >>> x :: lone 1 :: Spray Int

-- >>> y :: lone 2 :: Spray Int

-- >>> z :: lone 3 :: Spray Int

-- >>> p = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3

-- >>> putStrLn $ prettySpray show "x" p

-- (2) * x^(1) + (3) * x^(0, 2) + (-4) * x^(0, 0, 3)

prettySpray 
  :: (a -> String) -- ^ function mapping a coefficient to a string, typically 'show'

  -> String        -- ^ a string denoting the variable, e.g. \"x\"

  -> Spray a       -- ^ the spray

  -> String
prettySpray :: forall a. (a -> String) -> String -> Spray a -> String
prettySpray a -> String
prettyCoef String
var Spray a
p = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate (String -> Text
pack String
" + ") [Text]
stringTerms
 where
  stringTerms :: [Text]
stringTerms     = 
    ((Powers, a) -> Text) -> [(Powers, a)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Powers, a) -> Text
stringTerm (((Powers, a) -> (Powers, a) -> Ordering)
-> [(Powers, a)] -> [(Powers, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Seq Int -> Seq Int -> Ordering) -> Seq Int -> Seq Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq Int -> Seq Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Seq Int -> Seq Int -> Ordering)
-> ((Powers, a) -> Seq Int)
-> (Powers, a)
-> (Powers, a)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Powers, a) -> Seq Int
forall {b}. (Powers, b) -> Seq Int
fexpts) (Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
p))
  fexpts :: (Powers, b) -> Seq Int
fexpts (Powers, b)
term     = Powers -> Seq Int
exponents (Powers -> Seq Int) -> Powers -> Seq Int
forall a b. (a -> b) -> a -> b
$ (Powers, b) -> Powers
forall a b. (a, b) -> a
fst (Powers, b)
term
  stringTerm :: (Powers, a) -> Text
stringTerm (Powers, a)
term = Text -> Text -> Text
append
    (Text -> Char -> Text
snoc (Text -> Char -> Text
snoc (Char -> Text -> Text
cons Char
'(' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
snoc Text
stringCoef Char
')') Char
' ') Char
'*')
    (String -> [Int] -> Text
prettyPowers String
var [Int]
pows)
   where
    pows :: [Int]
pows       = Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq Int -> [Int]) -> Seq Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Powers -> Seq Int
exponents ((Powers, a) -> Powers
forall a b. (a, b) -> a
fst (Powers, a)
term)
    stringCoef :: Text
stringCoef = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
prettyCoef ((Powers, a) -> a
forall a b. (a, b) -> b
snd (Powers, a)
term)

-- | prettyPowers' [0, 2, 1] = "x2^2x3"

prettyPowers' :: Seq Int -> Text
prettyPowers' :: Seq Int -> Text
prettyPowers' Seq Int
pows = String -> Text
pack String
x1x2x3
 where
  n :: Int
n = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
pows
  f :: a -> a -> String
f a
i a
p 
    | a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0    = String
""
    | a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1    = String
"x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
    | Bool
otherwise = String
"x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
p
  x1x2x3 :: String
x1x2x3 = (Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
i -> Int -> Int -> String
forall {a} {a}. (Eq a, Num a, Show a, Show a) => a -> a -> String
f Int
i (Seq Int
pows Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))) [Int
1 .. Int
n]

-- | Pretty form of a spray, with monomials shown as "x1x3^2"

--

-- >>> x :: lone 1 :: Spray Int

-- >>> y :: lone 2 :: Spray Int

-- >>> z :: lone 3 :: Spray Int

-- >>> p = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3

-- >>> putStrLn $ prettySpray' p

-- (2) x1 + (3) x2^2 + (-4) x3^3 

prettySpray' :: Show a => Spray a -> String
prettySpray' :: forall a. Show a => Spray a -> String
prettySpray' Spray a
spray = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate (String -> Text
pack String
" + ") [Text]
terms
 where
  terms :: [Text]
terms           = ((Powers, a) -> Text) -> [(Powers, a)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Powers, a) -> Text
forall {a}. Show a => (Powers, a) -> Text
stringTerm 
                        (((Powers, a) -> (Powers, a) -> Ordering)
-> [(Powers, a)] -> [(Powers, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Seq Int -> Seq Int -> Ordering) -> Seq Int -> Seq Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq Int -> Seq Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Seq Int -> Seq Int -> Ordering)
-> ((Powers, a) -> Seq Int)
-> (Powers, a)
-> (Powers, a)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Powers, a) -> Seq Int
forall {b}. (Powers, b) -> Seq Int
fexpts) (Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
spray))
  fexpts :: (Powers, b) -> Seq Int
fexpts (Powers, b)
term     = Powers -> Seq Int
exponents (Powers -> Seq Int) -> Powers -> Seq Int
forall a b. (a -> b) -> a -> b
$ (Powers, b) -> Powers
forall a b. (a, b) -> a
fst (Powers, b)
term
  stringTerm :: (Powers, a) -> Text
stringTerm (Powers, a)
term = Text -> Text -> Text
append Text
stringCoef'' (Seq Int -> Text
prettyPowers' Seq Int
pows)
   where
    pows :: Seq Int
pows         = Powers -> Seq Int
exponents ((Powers, a) -> Powers
forall a b. (a, b) -> a
fst (Powers, a)
term)
    constant :: Bool
constant     = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
pows Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    stringCoef :: Text
stringCoef   = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show ((Powers, a) -> a
forall a b. (a, b) -> b
snd (Powers, a)
term)
    stringCoef' :: Text
stringCoef'  = Char -> Text -> Text
cons Char
'(' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
snoc Text
stringCoef Char
')'
    stringCoef'' :: Text
stringCoef'' = if Bool
constant then Text
stringCoef' else Text -> Char -> Text
snoc Text
stringCoef' Char
' '

-- | Pretty form of a spray, with monomials shown as "x1x3^2", and with 

-- a user-defined showing function for the coefficients

--

-- prop> prettySpray' p == prettySpray'' show p

prettySpray'' :: (a -> String) -> Spray a -> String
prettySpray'' :: forall a. (a -> String) -> Spray a -> String
prettySpray'' a -> String
showCoeff Spray a
spray = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate (String -> Text
pack String
" + ") [Text]
terms
 where
  terms :: [Text]
terms           = ((Powers, a) -> Text) -> [(Powers, a)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Powers, a) -> Text
stringTerm 
                        (((Powers, a) -> (Powers, a) -> Ordering)
-> [(Powers, a)] -> [(Powers, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Seq Int -> Seq Int -> Ordering) -> Seq Int -> Seq Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq Int -> Seq Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Seq Int -> Seq Int -> Ordering)
-> ((Powers, a) -> Seq Int)
-> (Powers, a)
-> (Powers, a)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Powers, a) -> Seq Int
forall {b}. (Powers, b) -> Seq Int
fexpts) (Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
spray))
  fexpts :: (Powers, b) -> Seq Int
fexpts (Powers, b)
term     = Powers -> Seq Int
exponents (Powers -> Seq Int) -> Powers -> Seq Int
forall a b. (a -> b) -> a -> b
$ (Powers, b) -> Powers
forall a b. (a, b) -> a
fst (Powers, b)
term
  stringTerm :: (Powers, a) -> Text
stringTerm (Powers, a)
term = Text -> Text -> Text
append Text
stringCoef'' (Seq Int -> Text
prettyPowers' Seq Int
pows)
   where
    pows :: Seq Int
pows         = Powers -> Seq Int
exponents ((Powers, a) -> Powers
forall a b. (a, b) -> a
fst (Powers, a)
term)
    constant :: Bool
constant     = Seq Int -> Bool
forall a. Seq a -> Bool
S.null Seq Int
pows
    stringCoef :: Text
stringCoef   = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
showCoeff ((Powers, a) -> a
forall a b. (a, b) -> b
snd (Powers, a)
term)
    stringCoef' :: Text
stringCoef'  = Char -> Text -> Text
cons Char
'(' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
snoc Text
stringCoef Char
')'
    stringCoef'' :: Text
stringCoef'' = if Bool
constant then Text
stringCoef' else Text -> Char -> Text
snoc Text
stringCoef' Char
'*'

-- | prettyPowersXYZ [1, 2, 1] = XY^2Z

prettyPowersXYZ :: Seq Int -> Text
prettyPowersXYZ :: Seq Int -> Text
prettyPowersXYZ Seq Int
pows = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 
  then String -> Text
pack String
xyz
  else String -> Text
forall a. HasCallStack => String -> a
error String
"prettyPowersXYZ: there is more than three variables"
 where
  n :: Int
n     = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
pows
  gpows :: Seq Int
gpows = Seq Int -> Int -> Int -> Seq Int
growSequence Seq Int
pows Int
n Int
3
  f :: String -> a -> String
f String
letter a
p 
    | a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0    = String
""
    | a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1    = String
letter
    | Bool
otherwise = String
letter String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
p
  x :: String
x   = String -> Int -> String
forall {a}. (Eq a, Num a, Show a) => String -> a -> String
f String
"X" (Seq Int
gpows Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
0)
  y :: String
y   = String -> Int -> String
forall {a}. (Eq a, Num a, Show a) => String -> a -> String
f String
"Y" (Seq Int
gpows Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
1)
  z :: String
z   = String -> Int -> String
forall {a}. (Eq a, Num a, Show a) => String -> a -> String
f String
"Z" (Seq Int
gpows Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
2)
  xyz :: String
xyz = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
z

-- | Pretty form of a spray having at more three variables

--

-- >>> x :: lone 1 :: Spray Int

-- >>> y :: lone 2 :: Spray Int

-- >>> z :: lone 3 :: Spray Int

-- >>> p = 2*^x ^+^ 3*^y^**^2 ^-^ 4*^z^**^3

-- >>> putStrLn $ prettySprayXYZ p

-- (2) X + (3) Y^2 + (-4) Z^3

prettySprayXYZ :: (Show a) => Spray a -> String
prettySprayXYZ :: forall a. Show a => Spray a -> String
prettySprayXYZ Spray a
spray = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate (String -> Text
pack String
" + ") [Text]
terms
 where
  terms :: [Text]
terms = ((Powers, a) -> Text) -> [(Powers, a)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Powers, a) -> Text
forall {a}. Show a => (Powers, a) -> Text
stringTerm (((Powers, a) -> (Powers, a) -> Ordering)
-> [(Powers, a)] -> [(Powers, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Seq Int -> Seq Int -> Ordering) -> Seq Int -> Seq Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq Int -> Seq Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Seq Int -> Seq Int -> Ordering)
-> ((Powers, a) -> Seq Int)
-> (Powers, a)
-> (Powers, a)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Powers, a) -> Seq Int
forall {b}. (Powers, b) -> Seq Int
fexpts) (Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
spray))
  fexpts :: (Powers, b) -> Seq Int
fexpts (Powers, b)
term = Powers -> Seq Int
exponents (Powers -> Seq Int) -> Powers -> Seq Int
forall a b. (a -> b) -> a -> b
$ (Powers, b) -> Powers
forall a b. (a, b) -> a
fst (Powers, b)
term
  stringTerm :: (Powers, a) -> Text
stringTerm (Powers, a)
term = Text -> Text -> Text
append Text
stringCoef'' (Seq Int -> Text
prettyPowersXYZ Seq Int
pows)
   where
    pows :: Seq Int
pows         = Powers -> Seq Int
exponents ((Powers, a) -> Powers
forall a b. (a, b) -> a
fst (Powers, a)
term)
    constant :: Bool
constant     = Seq Int -> Bool
forall a. Seq a -> Bool
S.null Seq Int
pows
    stringCoef :: Text
stringCoef   = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show ((Powers, a) -> a
forall a b. (a, b) -> b
snd (Powers, a)
term)
    stringCoef' :: Text
stringCoef'  = Char -> Text -> Text
cons Char
'(' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char -> Text
snoc Text
stringCoef Char
')'
    stringCoef'' :: Text
stringCoef'' = if Bool
constant then Text
stringCoef' else Text -> Char -> Text
snoc Text
stringCoef' Char
' '


-- misc -----------------------------------------------------------------------


-- | Terms of a spray

sprayTerms :: Spray a -> HashMap (Seq Int) a
sprayTerms :: forall a. Spray a -> HashMap (Seq Int) a
sprayTerms = (Powers -> Seq Int) -> HashMap Powers a -> HashMap (Seq Int) a
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HM.mapKeys Powers -> Seq Int
exponents

-- | Spray as a list

toList :: Spray a -> [([Int], a)]
toList :: forall a. Spray a -> [([Int], a)]
toList Spray a
p = HashMap [Int] a -> [([Int], a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap [Int] a -> [([Int], a)])
-> HashMap [Int] a -> [([Int], a)]
forall a b. (a -> b) -> a -> b
$ (Powers -> [Int]) -> Spray a -> HashMap [Int] a
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HM.mapKeys (Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq Int -> [Int]) -> (Powers -> Seq Int) -> Powers -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Powers -> Seq Int
exponents) Spray a
p

-- | Bombieri spray (for internal usage in the \'scubature\' library)

bombieriSpray :: AlgAdd.C a => Spray a -> Spray a
bombieriSpray :: forall a. C a => Spray a -> Spray a
bombieriSpray = (Powers -> a -> a) -> HashMap Powers a -> HashMap Powers a
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey Powers -> a -> a
forall {a}. C a => Powers -> a -> a
f
 where
  f :: Powers -> a -> a
f Powers
pows          = Int -> a -> a
forall {a}. C a => Int -> a -> a
times (Seq Int -> Int
forall {a}. (Num a, Enum a, Eq a) => Seq a -> a
pfactorial (Seq Int -> Int) -> Seq Int -> Int
forall a b. (a -> b) -> a -> b
$ Powers -> Seq Int
exponents Powers
pows)
  pfactorial :: Seq a -> a
pfactorial Seq a
pows = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Seq a -> [a]) -> Seq a -> [a]
forall a b. (a -> b) -> a -> b
$ a -> a
forall {a}. (Num a, Enum a) => a -> a
factorial (a -> a) -> Seq a -> Seq a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Bool) -> Seq a -> Seq a
forall a. (a -> Bool) -> Seq a -> Seq a
S.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0) Seq a
pows
  factorial :: a -> a
factorial a
n     = [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a
1 .. a
n]
  times :: Int -> a -> a
times Int
k a
x       = [a] -> a
forall a. C a => [a] -> a
AlgAdd.sum (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
k a
x)


-- division stuff -------------------------------------------------------------


-- | index of the maximum of a list

maxIndex :: Ord a => [a] -> Int
maxIndex :: forall a. Ord a => [a] -> Int
maxIndex = (Int, a) -> Int
forall a b. (a, b) -> a
fst ((Int, a) -> Int) -> ([a] -> (Int, a)) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a) -> (Int, a) -> Ordering) -> [(Int, a)] -> (Int, a)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Int, a) -> a) -> (Int, a) -> (Int, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, a) -> a
forall a b. (a, b) -> b
snd) ([(Int, a)] -> (Int, a)) -> ([a] -> [(Int, a)]) -> [a] -> (Int, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. ]

-- | Leading term of a spray 

leadingTerm :: Spray a -> Monomial a
leadingTerm :: forall a. Spray a -> Monomial a
leadingTerm Spray a
p = (Powers
biggest, Spray a
p Spray a -> Powers -> a
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! Powers
biggest) 
  where
    powers :: [Powers]
powers  = Spray a -> [Powers]
forall k v. HashMap k v -> [k]
HM.keys Spray a
p
    i :: Int
i       = [Seq Int] -> Int
forall a. Ord a => [a] -> Int
maxIndex ([Seq Int] -> Int) -> [Seq Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents [Powers]
powers
    biggest :: Powers
biggest = [Powers]
powers [Powers] -> Int -> Powers
forall a. HasCallStack => [a] -> Int -> a
!! Int
i

-- | whether a monomial divides another monomial

divides :: Monomial a -> Monomial a -> Bool
divides :: forall a. Monomial a -> Monomial a -> Bool
divides (Powers
powsP, a
_) (Powers
powsQ, a
_) = Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
expntsP Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
expntsQ Bool -> Bool -> Bool
&& Bool
lower
  where
    expntsP :: Seq Int
expntsP = Powers -> Seq Int
exponents Powers
powsP
    expntsQ :: Seq Int
expntsQ = Powers -> Seq Int
exponents Powers
powsQ
    lower :: Bool
lower   = ((Int, Int) -> Bool) -> Seq (Int, Int) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
DF.all ((Int -> Int -> Bool) -> (Int, Int) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=)) (Seq Int -> Seq Int -> Seq (Int, Int)
forall a b. Seq a -> Seq b -> Seq (a, b)
S.zip Seq Int
expntsP Seq Int
expntsQ)

-- | quotient of monomial Q by monomial p, assuming P divides Q

quotient :: AlgField.C a => Monomial a -> Monomial a -> Monomial a
quotient :: forall a. C a => Monomial a -> Monomial a -> Monomial a
quotient (Powers
powsQ, a
coeffQ) (Powers
powsP, a
coeffP) = (Powers
pows, a
coeff)
  where
    (Powers
powsP', Powers
powsQ') = (Powers, Powers) -> (Powers, Powers)
harmonize (Powers
powsP, Powers
powsQ)
    expntsP :: Seq Int
expntsP          = Powers -> Seq Int
exponents Powers
powsP'
    expntsQ :: Seq Int
expntsQ          = Powers -> Seq Int
exponents Powers
powsQ'
    expnts :: Seq Int
expnts           = (Int -> Int -> Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith (-) Seq Int
expntsQ Seq Int
expntsP
    n :: Int
n                = Powers -> Int
nvariables Powers
powsP'
    pows :: Powers
pows             = Seq Int -> Int -> Powers
Powers Seq Int
expnts Int
n
    coeff :: a
coeff            = a
coeffQ a -> a -> a
forall a. C a => a -> a -> a
AlgField./ a
coeffP

-- | Remainder of the division of a spray by a list of divisors, 

-- using the lexicographic ordering of the monomials

sprayDivisionRemainder :: forall a. (Eq a, AlgField.C a) 
                          => Spray a -> [Spray a] -> Spray a
sprayDivisionRemainder :: forall a. (Eq a, C a) => Spray a -> [Spray a] -> Spray a
sprayDivisionRemainder Spray a
p [Spray a]
qs = 
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
    then String -> Spray a
forall a. HasCallStack => String -> a
error String
"sprayDivisionRemainder: the list of divisors is empty." 
    else (Spray a, Spray a) -> Spray a
forall a b. (a, b) -> b
snd ((Spray a, Spray a) -> Spray a) -> (Spray a, Spray a) -> Spray a
forall a b. (a -> b) -> a -> b
$ Spray a -> Spray a -> (Spray a, Spray a)
ogo Spray a
p Spray a
forall a. C a => a
AlgAdd.zero
  where
    n :: Int
n = [Spray a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Spray a]
qs
    qsltqs :: [(Spray a, Monomial a)]
qsltqs = [Spray a] -> [Monomial a] -> [(Spray a, Monomial a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Spray a]
qs ((Spray a -> Monomial a) -> [Spray a] -> [Monomial a]
forall a b. (a -> b) -> [a] -> [b]
map Spray a -> Monomial a
forall a. Spray a -> Monomial a
leadingTerm [Spray a]
qs)
    g :: Monomial a -> Spray a -> Spray a -> (Spray a, Spray a)
    g :: Monomial a -> Spray a -> Spray a -> (Spray a, Spray a)
g Monomial a
lts Spray a
s Spray a
r = (Spray a
s Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ Spray a
ltsspray, Spray a
r Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^+^ Spray a
ltsspray)
      where
        ltsspray :: Spray a
ltsspray = Monomial a -> Spray a
forall a. Monomial a -> Spray a
fromMonomial Monomial a
lts 
    go :: Monomial a -> Spray a -> Spray a -> Int -> Bool -> (Spray a, Spray a)
    go :: Monomial a
-> Spray a -> Spray a -> Int -> Bool -> (Spray a, Spray a)
go Monomial a
lts !Spray a
s Spray a
r !Int
i !Bool
divoccured
      | Bool
divoccured = (Spray a
s, Spray a
r)
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n     = Monomial a -> Spray a -> Spray a -> (Spray a, Spray a)
g Monomial a
lts Spray a
s Spray a
r 
      | Bool
otherwise  = Monomial a
-> Spray a -> Spray a -> Int -> Bool -> (Spray a, Spray a)
go Monomial a
lts Spray a
news Spray a
r (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool
newdivoccured
        where
          (Spray a
q, Monomial a
ltq)      = [(Spray a, Monomial a)]
qsltqs [(Spray a, Monomial a)] -> Int -> (Spray a, Monomial a)
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
          newdivoccured :: Bool
newdivoccured = Monomial a -> Monomial a -> Bool
forall a. Monomial a -> Monomial a -> Bool
divides Monomial a
ltq Monomial a
lts
          news :: Spray a
news          = if Bool
newdivoccured
            then Spray a
s Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ (Monomial a -> Spray a
forall a. Monomial a -> Spray a
fromMonomial (Monomial a -> Monomial a -> Monomial a
forall a. C a => Monomial a -> Monomial a -> Monomial a
quotient Monomial a
lts Monomial a
ltq) Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
q)
            else Spray a
s
    ogo :: Spray a -> Spray a -> (Spray a, Spray a)
    ogo :: Spray a -> Spray a -> (Spray a, Spray a)
ogo !Spray a
s !Spray a
r 
      | Spray a
s Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. C a => a
AlgAdd.zero = (Spray a
s, Spray a
r)
      | Bool
otherwise        = Spray a -> Spray a -> (Spray a, Spray a)
ogo Spray a
s' Spray a
r'
        where
          (Spray a
s', Spray a
r') = Monomial a
-> Spray a -> Spray a -> Int -> Bool -> (Spray a, Spray a)
go (Spray a -> Monomial a
forall a. Spray a -> Monomial a
leadingTerm Spray a
s) Spray a
s Spray a
r Int
0 Bool
False

-- | Division of a spray by a spray

sprayDivision :: forall a. (Eq a, AlgField.C a) 
  => Spray a            -- ^ dividend 

  -> Spray a            -- ^ divisor

  -> (Spray a, Spray a) -- ^ (quotient, remainder)

sprayDivision :: forall a. (Eq a, C a) => Spray a -> Spray a -> (Spray a, Spray a)
sprayDivision Spray a
sprayA Spray a
sprayB =
  if Spray a
sprayB Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. C a => a
AlgAdd.zero 
    then String -> (Spray a, Spray a)
forall a. HasCallStack => String -> a
error String
"sprayDivision: division by zero."
    else Spray a -> Spray a -> Spray a -> (Spray a, Spray a)
ogo Spray a
sprayA Spray a
forall a. C a => a
AlgAdd.zero Spray a
forall a. C a => a
AlgAdd.zero
  where
    go :: Monomial a -> Spray a -> Spray a -> Spray a -> Int -> Bool 
          -> (Spray a, Spray a, Spray a)
    go :: Monomial a
-> Spray a
-> Spray a
-> Spray a
-> Int
-> Bool
-> (Spray a, Spray a, Spray a)
go Monomial a
ltp !Spray a
p !Spray a
q Spray a
r !Int
i !Bool
divoccured
      | Bool
divoccured = (Spray a
p, Spray a
q, Spray a
r)
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1     = (Spray a
p Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ Spray a
ltpspray, Spray a
q, Spray a
r Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^+^ Spray a
ltpspray)
      | Bool
otherwise  = Monomial a
-> Spray a
-> Spray a
-> Spray a
-> Int
-> Bool
-> (Spray a, Spray a, Spray a)
go Monomial a
ltp Spray a
newp Spray a
newq Spray a
r Int
1 Bool
newdivoccured
        where
          ltpspray :: Spray a
ltpspray      = Monomial a -> Spray a
forall a. Monomial a -> Spray a
fromMonomial Monomial a
ltp
          ltB :: Monomial a
ltB           = Spray a -> Monomial a
forall a. Spray a -> Monomial a
leadingTerm Spray a
sprayB
          newdivoccured :: Bool
newdivoccured = Monomial a -> Monomial a -> Bool
forall a. Monomial a -> Monomial a -> Bool
divides Monomial a
ltB Monomial a
ltp
          (Spray a
newp, Spray a
newq)  = if Bool
newdivoccured
            then (Spray a
p Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ (Spray a
qtnt Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
sprayB), Spray a
q Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^+^ Spray a
qtnt)
            else (Spray a
p, Spray a
q)
            where
              qtnt :: Spray a
qtnt = Monomial a -> Spray a
forall a. Monomial a -> Spray a
fromMonomial (Monomial a -> Spray a) -> Monomial a -> Spray a
forall a b. (a -> b) -> a -> b
$ Monomial a -> Monomial a -> Monomial a
forall a. C a => Monomial a -> Monomial a -> Monomial a
quotient Monomial a
ltp Monomial a
ltB
    ogo :: Spray a -> Spray a -> Spray a -> (Spray a, Spray a)
    ogo :: Spray a -> Spray a -> Spray a -> (Spray a, Spray a)
ogo !Spray a
p !Spray a
q !Spray a
r 
      | Spray a
p Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. C a => a
AlgAdd.zero = (Spray a
q, Spray a
r)
      | Bool
otherwise        = Spray a -> Spray a -> Spray a -> (Spray a, Spray a)
ogo Spray a
p' Spray a
q' Spray a
r'
        where
          (Spray a
p', Spray a
q', Spray a
r') = Monomial a
-> Spray a
-> Spray a
-> Spray a
-> Int
-> Bool
-> (Spray a, Spray a, Spray a)
go (Spray a -> Monomial a
forall a. Spray a -> Monomial a
leadingTerm Spray a
p) Spray a
p Spray a
q Spray a
r Int
0 Bool
False


-- Groebner stuff -------------------------------------------------------------


-- | slight modification of `sprayDivisionRemainder` to speed up groebner00

sprayDivisionRemainder' 
  :: forall a. (Eq a, AlgField.C a) 
  => Spray a -> HashMap Int (Spray a, Monomial a) -> Spray a
sprayDivisionRemainder' :: forall a.
(Eq a, C a) =>
Spray a -> HashMap Int (Spray a, Monomial a) -> Spray a
sprayDivisionRemainder' Spray a
p HashMap Int (Spray a, Monomial a)
qsltqs = (Spray a, Spray a) -> Spray a
forall a b. (a, b) -> b
snd ((Spray a, Spray a) -> Spray a) -> (Spray a, Spray a) -> Spray a
forall a b. (a -> b) -> a -> b
$ Spray a -> Spray a -> (Spray a, Spray a)
ogo Spray a
p Spray a
forall a. C a => a
AlgAdd.zero
  where
    n :: Int
n = HashMap Int (Spray a, Monomial a) -> Int
forall k v. HashMap k v -> Int
HM.size HashMap Int (Spray a, Monomial a)
qsltqs
    g :: Monomial a -> Spray a -> Spray a -> (Spray a, Spray a)
    g :: Monomial a -> Spray a -> Spray a -> (Spray a, Spray a)
g Monomial a
lts Spray a
s Spray a
r = (Spray a
s Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ Spray a
ltsspray, Spray a
r Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^+^ Spray a
ltsspray)
      where
        ltsspray :: Spray a
ltsspray = Monomial a -> Spray a
forall a. Monomial a -> Spray a
fromMonomial Monomial a
lts 
    go :: Monomial a -> Spray a -> Spray a -> Int -> Bool -> (Spray a, Spray a)
    go :: Monomial a
-> Spray a -> Spray a -> Int -> Bool -> (Spray a, Spray a)
go Monomial a
lts !Spray a
s Spray a
r !Int
i !Bool
divoccured
      | Bool
divoccured = (Spray a
s, Spray a
r)
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n     = Monomial a -> Spray a -> Spray a -> (Spray a, Spray a)
g Monomial a
lts Spray a
s Spray a
r 
      | Bool
otherwise  = Monomial a
-> Spray a -> Spray a -> Int -> Bool -> (Spray a, Spray a)
go Monomial a
lts Spray a
news Spray a
r (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool
newdivoccured
        where
          (Spray a
q, Monomial a
ltq)      = HashMap Int (Spray a, Monomial a)
qsltqs HashMap Int (Spray a, Monomial a) -> Int -> (Spray a, Monomial a)
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! Int
i
          newdivoccured :: Bool
newdivoccured = Monomial a -> Monomial a -> Bool
forall a. Monomial a -> Monomial a -> Bool
divides Monomial a
ltq Monomial a
lts
          news :: Spray a
news = if Bool
newdivoccured
            then Spray a
s Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ (Monomial a -> Spray a
forall a. Monomial a -> Spray a
fromMonomial (Monomial a -> Monomial a -> Monomial a
forall a. C a => Monomial a -> Monomial a -> Monomial a
quotient Monomial a
lts Monomial a
ltq) Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
q)
            else Spray a
s
    ogo :: Spray a -> Spray a -> (Spray a, Spray a)
    ogo :: Spray a -> Spray a -> (Spray a, Spray a)
ogo !Spray a
s !Spray a
r 
      | Spray a
s Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. C a => a
AlgAdd.zero = (Spray a
s, Spray a
r)
      | Bool
otherwise        = Spray a -> Spray a -> (Spray a, Spray a)
ogo Spray a
s' Spray a
r'
        where
          (Spray a
s', Spray a
r') = Monomial a
-> Spray a -> Spray a -> Int -> Bool -> (Spray a, Spray a)
go (Spray a -> Monomial a
forall a. Spray a -> Monomial a
leadingTerm Spray a
s) Spray a
s Spray a
r Int
0 Bool
False

-- combinations of two among n

combn2 :: Int -> Int -> HashMap Int (Int, Int)
combn2 :: Int -> Int -> HashMap Int (Int, Int)
combn2 Int
n Int
s = [(Int, (Int, Int))] -> HashMap Int (Int, Int)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([Int] -> [(Int, Int)] -> [(Int, (Int, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
range0 ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
row1 [Int]
row2)) 
  where
    range0 :: [Int]
range0 = [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2]
    range1 :: [Int]
range1 = [Int
1 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
    row1 :: [Int]
row1   = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
s ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
i -> [Int
0 .. Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) [Int]
range1 
    row2 :: [Int]
row2   = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
s ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
i -> Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
i Int
i) [Int]
range1

-- the "S polynomial"

sPolynomial :: (Eq a, AlgField.C a) 
               => (Spray a, Monomial a) -> (Spray a, Monomial a) -> Spray a
sPolynomial :: forall a.
(Eq a, C a) =>
(Spray a, Monomial a) -> (Spray a, Monomial a) -> Spray a
sPolynomial (Spray a, Monomial a)
pltp (Spray a, Monomial a)
qltq = Spray a
wp Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
p Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ Spray a
wq Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
q
  where
    p :: Spray a
p                 = (Spray a, Monomial a) -> Spray a
forall a b. (a, b) -> a
fst (Spray a, Monomial a)
pltp
    q :: Spray a
q                 = (Spray a, Monomial a) -> Spray a
forall a b. (a, b) -> a
fst (Spray a, Monomial a)
qltq
    (Powers
lpowsP, a
lcoefP)  = (Spray a, Monomial a) -> Monomial a
forall a b. (a, b) -> b
snd (Spray a, Monomial a)
pltp
    (Powers
lpowsQ, a
lcoefQ)  = (Spray a, Monomial a) -> Monomial a
forall a b. (a, b) -> b
snd (Spray a, Monomial a)
qltq
    (Powers
lpowsP', Powers
lpowsQ') = (Powers, Powers) -> (Powers, Powers)
harmonize (Powers
lpowsP, Powers
lpowsQ)
    lexpntsP :: Seq Int
lexpntsP           = Powers -> Seq Int
exponents Powers
lpowsP'
    lexpntsQ :: Seq Int
lexpntsQ           = Powers -> Seq Int
exponents Powers
lpowsQ'
    gamma :: Seq Int
gamma = (Int -> Int -> Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Seq Int
lexpntsP Seq Int
lexpntsQ
    betaP :: Seq Int
betaP = (Int -> Int -> Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith (-) Seq Int
gamma Seq Int
lexpntsP
    betaQ :: Seq Int
betaQ = (Int -> Int -> Int) -> Seq Int -> Seq Int -> Seq Int
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
S.zipWith (-) Seq Int
gamma Seq Int
lexpntsQ
    n :: Int
n  = Powers -> Int
nvariables Powers
lpowsP'
    wp :: Spray a
wp = Monomial a -> Spray a
forall a. Monomial a -> Spray a
fromMonomial (Seq Int -> Int -> Powers
Powers Seq Int
betaP Int
n, a -> a
forall a. C a => a -> a
AlgField.recip a
lcoefP)
    wq :: Spray a
wq = Monomial a -> Spray a
forall a. Monomial a -> Spray a
fromMonomial (Seq Int -> Int -> Powers
Powers Seq Int
betaQ Int
n, a -> a
forall a. C a => a -> a
AlgField.recip a
lcoefQ)

-- | groebner basis, not minimal and not reduced

groebner00 :: forall a. (Eq a, AlgField.C a) => [Spray a] -> [Spray a]
groebner00 :: forall a. (Eq a, C a) => [Spray a] -> [Spray a]
groebner00 [Spray a]
sprays = Int
-> Int
-> HashMap Int (Int, Int)
-> HashMap Int (Spray a, Monomial a)
-> [Spray a]
go Int
0 Int
j0 HashMap Int (Int, Int)
combins0 HashMap Int (Spray a, Monomial a)
spraysMap
  where
    j0 :: Int
j0       = [Spray a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Spray a]
sprays
    combins0 :: HashMap Int (Int, Int)
combins0 = Int -> Int -> HashMap Int (Int, Int)
combn2 Int
j0 Int
0
    ltsprays :: [Monomial a]
ltsprays       = (Spray a -> Monomial a) -> [Spray a] -> [Monomial a]
forall a b. (a -> b) -> [a] -> [b]
map Spray a -> Monomial a
forall a. Spray a -> Monomial a
leadingTerm [Spray a]
sprays
    spraysltsprays :: [(Spray a, Monomial a)]
spraysltsprays = [Spray a] -> [Monomial a] -> [(Spray a, Monomial a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Spray a]
sprays [Monomial a]
ltsprays 
    spraysMap :: HashMap Int (Spray a, Monomial a)
spraysMap      = [(Int, (Spray a, Monomial a))] -> HashMap Int (Spray a, Monomial a)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([Int] -> [(Spray a, Monomial a)] -> [(Int, (Spray a, Monomial a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. Int
j0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [(Spray a, Monomial a)]
spraysltsprays)
    go :: Int -> Int -> HashMap Int (Int, Int) 
          -> HashMap Int (Spray a, Monomial a) -> [Spray a]
    go :: Int
-> Int
-> HashMap Int (Int, Int)
-> HashMap Int (Spray a, Monomial a)
-> [Spray a]
go !Int
i !Int
j !HashMap Int (Int, Int)
combins !HashMap Int (Spray a, Monomial a)
gpolysMap
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== HashMap Int (Int, Int) -> Int
forall a. HashMap Int a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashMap Int (Int, Int)
combins = ((Spray a, Monomial a) -> Spray a)
-> [(Spray a, Monomial a)] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (Spray a, Monomial a) -> Spray a
forall a b. (a, b) -> a
fst (HashMap Int (Spray a, Monomial a) -> [(Spray a, Monomial a)]
forall k v. HashMap k v -> [v]
HM.elems HashMap Int (Spray a, Monomial a)
gpolysMap)
      | Bool
otherwise           = Int
-> Int
-> HashMap Int (Int, Int)
-> HashMap Int (Spray a, Monomial a)
-> [Spray a]
go Int
i' Int
j' HashMap Int (Int, Int)
combins' HashMap Int (Spray a, Monomial a)
gpolysMap'
        where
          (Int
k, Int
l)   = HashMap Int (Int, Int)
combins HashMap Int (Int, Int) -> Int -> (Int, Int)
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! Int
i
          sfg :: Spray a
sfg      = (Spray a, Monomial a) -> (Spray a, Monomial a) -> Spray a
forall a.
(Eq a, C a) =>
(Spray a, Monomial a) -> (Spray a, Monomial a) -> Spray a
sPolynomial (HashMap Int (Spray a, Monomial a)
gpolysMap HashMap Int (Spray a, Monomial a) -> Int -> (Spray a, Monomial a)
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! Int
k) (HashMap Int (Spray a, Monomial a)
gpolysMap HashMap Int (Spray a, Monomial a) -> Int -> (Spray a, Monomial a)
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! Int
l)
          sbarfg :: Spray a
sbarfg   = Spray a -> HashMap Int (Spray a, Monomial a) -> Spray a
forall a.
(Eq a, C a) =>
Spray a -> HashMap Int (Spray a, Monomial a) -> Spray a
sprayDivisionRemainder' Spray a
sfg HashMap Int (Spray a, Monomial a)
gpolysMap
          ltsbarfg :: Monomial a
ltsbarfg = Spray a -> Monomial a
forall a. Spray a -> Monomial a
leadingTerm Spray a
sbarfg
          (Int
i', Int
j', HashMap Int (Spray a, Monomial a)
gpolysMap', HashMap Int (Int, Int)
combins') = if Spray a
sbarfg Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. C a => a
AlgAdd.zero
            then
              (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
j, HashMap Int (Spray a, Monomial a)
gpolysMap, HashMap Int (Int, Int)
combins)
            else
              ( Int
0
              , Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
              , Int
-> (Spray a, Monomial a)
-> HashMap Int (Spray a, Monomial a)
-> HashMap Int (Spray a, Monomial a)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Int
j (Spray a
sbarfg, Monomial a
ltsbarfg) HashMap Int (Spray a, Monomial a)
gpolysMap
              , Int -> Int -> HashMap Int (Int, Int)
combn2 (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
              )

-- | groebner basis, minimal but not reduced

groebner0 :: forall a. (Eq a, AlgField.C a) => [Spray a] -> [Spray a]
groebner0 :: forall a. (Eq a, C a) => [Spray a] -> [Spray a]
groebner0 [Spray a]
sprays = 
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then [Spray a]
sprays else [[Spray a]
basis00 [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! Int
k | Int
k <- [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
discard]
  where
    n :: Int
n       = [Spray a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Spray a]
basis00
    basis00 :: [Spray a]
basis00 = [Spray a] -> [Spray a]
forall a. (Eq a, C a) => [Spray a] -> [Spray a]
groebner00 [Spray a]
sprays
    go :: Int -> [Int] -> [Int]
    go :: Int -> [Int] -> [Int]
go !Int
i [Int]
toRemove
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n    = [Int]
toRemove
      | Bool
otherwise = Int -> [Int] -> [Int]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Int]
toRemove'
        where
          ltf :: Monomial a
ltf    = Spray a -> Monomial a
forall a. Spray a -> Monomial a
leadingTerm ([Spray a]
basis00 [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i)
          toDrop :: [Int]
toDrop = [Int]
toRemove [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i]
          igo :: Int -> Bool
          igo :: Int -> Bool
igo !Int
j 
            | Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n          = Bool
False
            | Int
j Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
toDrop = Int -> Bool
igo (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            | Bool
otherwise       = Bool
ok Bool -> Bool -> Bool
|| Int -> Bool
igo (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
              where 
                ok :: Bool
ok = Monomial a -> Monomial a -> Bool
forall a. Monomial a -> Monomial a -> Bool
divides (Spray a -> Monomial a
forall a. Spray a -> Monomial a
leadingTerm ([Spray a]
basis00 [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! Int
j)) Monomial a
ltf
          toRemove' :: [Int]
toRemove' = if Int -> Bool
igo Int
0 then [Int]
toDrop else [Int]
toRemove
    discard :: [Int]
discard = Int -> [Int] -> [Int]
go Int
0 []

-- | Reduces a Groebner basis

reduceGroebnerBasis :: forall a. (Eq a, AlgField.C a) => [Spray a] -> [Spray a]
reduceGroebnerBasis :: forall a. (Eq a, C a) => [Spray a] -> [Spray a]
reduceGroebnerBasis [Spray a]
gbasis = 
  if [Spray a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Spray a]
gbasis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 
    then (Int -> Spray a) -> [Int] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Spray a
reduction [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] 
    else [Spray a]
ngbasis
  where
    normalize :: Spray a -> Spray a
    normalize :: Spray a -> Spray a
normalize Spray a
spray = a -> a
forall a. C a => a -> a
AlgField.recip a
coef a -> Spray a -> Spray a
forall a. (C a, Eq a) => a -> Spray a -> Spray a
*^ Spray a
spray
      where
        (Powers
_, a
coef) = Spray a -> (Powers, a)
forall a. Spray a -> Monomial a
leadingTerm Spray a
spray
    ngbasis :: [Spray a]
ngbasis = (Spray a -> Spray a) -> [Spray a] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map Spray a -> Spray a
normalize [Spray a]
gbasis
    n :: Int
n       = [Spray a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Spray a]
ngbasis
    reduction :: Int -> Spray a
    reduction :: Int -> Spray a
reduction Int
i = Spray a -> [Spray a] -> Spray a
forall a. (Eq a, C a) => Spray a -> [Spray a] -> Spray a
sprayDivisionRemainder ([Spray a]
ngbasis [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) [Spray a]
rest
      where
        rest :: [Spray a]
rest = [[Spray a]
ngbasis [Spray a] -> Int -> Spray a
forall a. HasCallStack => [a] -> Int -> a
!! Int
k | Int
k <- [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Int
i]]

-- | Groebner basis (always minimal and possibly reduced)

--

-- prop> groebner sprays True == reduceGroebnerBasis (groebner sprays False)

groebner 
  :: forall a. (Eq a, AlgField.C a) 
  => [Spray a] -- ^ list of sprays 

  -> Bool      -- ^ whether to return the reduced basis

  -> [Spray a]
groebner :: forall a. (Eq a, C a) => [Spray a] -> Bool -> [Spray a]
groebner [Spray a]
sprays Bool
reduced = 
  if Bool
reduced then [Spray a] -> [Spray a]
forall a. (Eq a, C a) => [Spray a] -> [Spray a]
reduceGroebnerBasis [Spray a]
gbasis0 else (Spray a -> Spray a) -> [Spray a] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map Spray a -> Spray a
normalize [Spray a]
gbasis0
  where
    gbasis0 :: [Spray a]
gbasis0 = [Spray a] -> [Spray a]
forall a. (Eq a, C a) => [Spray a] -> [Spray a]
groebner0 [Spray a]
sprays
    normalize :: Spray a -> Spray a
    normalize :: Spray a -> Spray a
normalize Spray a
spray = a -> a
forall a. C a => a -> a
AlgField.recip a
coef a -> Spray a -> Spray a
forall a. (C a, Eq a) => a -> Spray a -> Spray a
*^ Spray a
spray
      where
        (Powers
_, a
coef) = Spray a -> (Powers, a)
forall a. Spray a -> Monomial a
leadingTerm Spray a
spray


-- elementary symmetric polynomials -------------------------------------------


-- | combinations of k elements among a list

combinationsOf :: Int -> [a] -> [[a]]
combinationsOf :: forall a. Int -> [a] -> [[a]]
combinationsOf Int
_ []        = String -> [[a]]
forall a. HasCallStack => String -> a
error String
"combinationsOf: should not happen."
combinationsOf Int
1 [a]
as        = (a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
as
combinationsOf Int
k as :: [a]
as@(a
_:[a]
xs) = 
  Int -> Int -> [a] -> [[a]] -> [[a]]
forall a. Int -> Int -> [a] -> [[a]] -> [[a]]
run (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
as ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs
  where
    l :: Int
l = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as
    run :: Int -> Int -> [a] -> [[a]] -> [[a]]
    run :: forall a. Int -> Int -> [a] -> [[a]] -> [[a]]
run Int
n Int
i [a]
ys [[a]]
cs 
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i    = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ([a]
ys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) [[a]]
cs
      | Bool
otherwise = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
qa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [[a]]
cs [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [a] -> [[a]] -> [[a]]
forall a. Int -> Int -> [a] -> [[a]] -> [[a]]
run (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
i [a]
qs (Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
drop Int
dc [[a]]
cs)
      where
        f :: [a] -> (a, [a])
        f :: forall a. [a] -> (a, [a])
f []     = String -> (a, [a])
forall a. HasCallStack => String -> a
error String
"combinationsOf: should not happen."
        f (a
b:[a]
bs) = (a
b, [a]
bs)
        (a
q, [a]
qs)  = [a] -> (a, [a])
forall a. [a] -> (a, [a])
f (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [a]
ys)
        dc :: Int
dc       = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) .. (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int
1 .. Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]

-- | generates all permutations of a binary sequence

permutationsBinarySequence :: Int -> Int -> [Seq Int]
permutationsBinarySequence :: Int -> Int -> [Seq Int]
permutationsBinarySequence Int
nzeros Int
nones = 
  let n :: Int
n = Int
nzeros Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nones in 
    ([Int] -> Seq Int) -> [[Int]] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Int] -> Seq Int
binarySequence Int
n) (Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
nones [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1])
  where
    binarySequence :: Int -> [Int] -> Seq Int
    binarySequence :: Int -> [Int] -> Seq Int
binarySequence Int
n [Int]
combo = Int -> (Int -> Int) -> Seq Int
forall a. Int -> (Int -> a) -> Seq a
fromFunction Int
n Int -> Int
f 
      where
        f :: Int -> Int
        f :: Int -> Int
f Int
i = Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
combo)

-- | Elementary symmetric polynomial

--

-- >>> putStrLn $ prettySpray' (esPolynomial 3 2)

-- (1) x1x2 + (1) x1x3 + (1) x2x3

esPolynomial 
  :: (AlgRing.C a, Eq a) 
  => Int -- ^ number of variables

  -> Int -- ^ index

  -> Spray a
esPolynomial :: forall a. (C a, Eq a) => Int -> Int -> Spray a
esPolynomial Int
n Int
k
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 
    = String -> Spray a
forall a. HasCallStack => String -> a
error String
"esPolynomial: both arguments must be positive integers."
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n     = Spray a
forall a. C a => a
AlgAdd.zero
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Spray a
forall a. C a => Spray a
unitSpray
  | Bool
otherwise = Spray a -> Spray a
forall a. Spray a -> Spray a
simplifySpray Spray a
spray
  where
    perms :: [Seq Int]
perms = Int -> Int -> [Seq Int]
permutationsBinarySequence (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) Int
k
    spray :: Spray a
spray = [(Powers, a)] -> Spray a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Powers, a)] -> Spray a) -> [(Powers, a)] -> Spray a
forall a b. (a -> b) -> a -> b
$ (Seq Int -> (Powers, a)) -> [Seq Int] -> [(Powers, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Seq Int
expts -> (Seq Int -> Int -> Powers
Powers Seq Int
expts Int
n, a
forall a. C a => a
AlgRing.one)) [Seq Int]
perms

-- | Power sum polynomial

psPolynomial 
  :: forall a. (AlgRing.C a, Eq a) 
  => Int -- ^ number of variables

  -> Int -- ^ power

  -> Spray a
psPolynomial :: forall a. (C a, Eq a) => Int -> Int -> Spray a
psPolynomial Int
n Int
k
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 
    = String -> Spray a
forall a. HasCallStack => String -> a
error String
"psPolynomial: both arguments must be positive integers."
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n     = Spray a
forall a. C a => a
AlgAdd.zero
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Int
n Int -> Spray a -> Spray a
forall a. (C a, Eq a) => Int -> Spray a -> Spray a
.^ Spray a
forall a. C a => Spray a
unitSpray
  | Bool
otherwise = Spray a
spray
  where
    spray :: Spray a
spray = [(Powers, a)] -> Spray a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Powers, a)] -> Spray a) -> [(Powers, a)] -> Spray a
forall a b. (a -> b) -> a -> b
$ (Int -> (Powers, a)) -> [Int] -> [(Powers, a)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Powers, a)
f [Int
1 .. Int
n]
    f :: Int -> (Powers, a)
    f :: Int -> (Powers, a)
f Int
j = (Seq Int -> Int -> Powers
Powers Seq Int
expts Int
j, a
forall a. C a => a
AlgRing.one)
      where
        expts :: Seq Int
expts = Int -> Int -> Seq Int
forall a. Int -> a -> Seq a
S.replicate (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0 Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
k

-- | Whether a spray is a symmetric polynomial

isSymmetricSpray :: forall a. (AlgField.C a, Eq a) => Spray a -> Bool
isSymmetricSpray :: forall a. (C a, Eq a) => Spray a -> Bool
isSymmetricSpray Spray a
spray = Bool
check1 Bool -> Bool -> Bool
&& Bool
check2 
  where
    n :: Int
n = Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray
    indices :: [Int]
indices = [Int
1 .. Int
n]
    gPolys :: [Spray a]
gPolys = (Int -> Spray a) -> [Int] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> Int -> Spray a
forall a. (C a, Eq a) => Int -> Int -> Spray a
esPolynomial Int
n Int
i Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ Int -> Spray a
forall a. C a => Int -> Spray a
lone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)) [Int]
indices
    gbasis :: [Spray a]
gbasis  = [Spray a] -> [Spray a]
forall a. (Eq a, C a) => [Spray a] -> [Spray a]
groebner0 [Spray a]
gPolys
    spray' :: Spray a
spray'  = Spray a
spray Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ (a -> Spray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray (Spray a -> a
forall a. C a => Spray a -> a
getConstantTerm Spray a
spray))
    g :: Spray a
g       = Spray a -> [Spray a] -> Spray a
forall a. (Eq a, C a) => Spray a -> [Spray a] -> Spray a
sprayDivisionRemainder Spray a
spray' [Spray a]
gbasis
    gpowers :: [Powers]
gpowers = Spray a -> [Powers]
forall k v. HashMap k v -> [k]
HM.keys Spray a
g
    check1 :: Bool
check1  = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((Powers -> Int) -> [Powers] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Int
nvariables [Powers]
gpowers) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n
    expnts :: [Seq Int]
expnts  = (Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents [Powers]
gpowers
    check2 :: Bool
check2  = (Seq Int -> Bool) -> [Seq Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
DF.all ((Int -> Bool) -> Seq Int -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
DF.all (Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==)) ((Seq Int -> Seq Int) -> [Seq Int] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.take Int
n) [Seq Int]
expnts) 

-- | Whether a spray can be written as a polynomial of a given list of sprays

-- (the sprays in the list must belong to the same polynomial ring as the spray); 

-- this polynomial is returned if this is true

--

-- >>> x = lone 1 :: Spray Rational

-- >>> y = lone 2 :: Spray Rational

-- >>> p1 = x ^+^ y

-- >>> p2 = x ^-^ y

-- >>> p = p1 ^*^ p2

-- 

-- prop> isPolynomialOf p [p1, p2] == (True, Just $ x ^*^ y)

isPolynomialOf :: forall a. (AlgField.C a, Eq a) 
                  => Spray a -> [Spray a] -> (Bool, Maybe (Spray a))
isPolynomialOf :: forall a.
(C a, Eq a) =>
Spray a -> [Spray a] -> (Bool, Maybe (Spray a))
isPolynomialOf Spray a
spray [Spray a]
sprays = (Bool, Maybe (Spray a))
result 
  where
    n :: Int
n = Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray
    n' :: Int
n' = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Spray a -> Int) -> [Spray a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Spray a -> Int
forall a. Spray a -> Int
numberOfVariables [Spray a]
sprays
    result :: (Bool, Maybe (Spray a))
result
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n'    = (Bool
False, Maybe (Spray a)
forall a. Maybe a
Nothing)
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n'    = String -> (Bool, Maybe (Spray a))
forall a. HasCallStack => String -> a
error String
"isPolynomialOf: not enough variables in the spray." 
      | Bool
otherwise = (Bool
checks, Maybe (Spray a)
poly)
        where
          m :: Int
m            = [Spray a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Spray a]
sprays
          yPolys :: [Spray a]
yPolys       = (Int -> Spray a) -> [Int] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> Spray a
forall a. C a => Int -> Spray a
lone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) :: Spray a) [Int
1 .. Int
m]
          gPolys :: [Spray a]
gPolys       = (Spray a -> Spray a -> Spray a)
-> [Spray a] -> [Spray a] -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^-^) [Spray a]
sprays [Spray a]
yPolys
          gbasis0 :: [Spray a]
gbasis0      = [Spray a] -> [Spray a]
forall a. (Eq a, C a) => [Spray a] -> [Spray a]
groebner0 [Spray a]
gPolys
          constantTerm :: Spray a
constantTerm = a -> Spray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray (Spray a -> a
forall a. C a => Spray a -> a
getConstantTerm Spray a
spray)
          spray' :: Spray a
spray'       = Spray a
spray Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ Spray a
constantTerm
          g :: Spray a
g            = Spray a -> [Spray a] -> Spray a
forall a. (Eq a, C a) => Spray a -> [Spray a] -> Spray a
sprayDivisionRemainder Spray a
spray' [Spray a]
gbasis0
          gpowers :: [Powers]
gpowers      = Spray a -> [Powers]
forall k v. HashMap k v -> [k]
HM.keys Spray a
g
          check1 :: Bool
check1       = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((Powers -> Int) -> [Powers] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Int
nvariables [Powers]
gpowers) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n
          expnts :: [Seq Int]
expnts       = (Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents [Powers]
gpowers
          check2 :: Bool
check2       = (Seq Int -> Bool) -> [Seq Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
DF.all ((Int -> Bool) -> Seq Int -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
DF.all (Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==)) ((Seq Int -> Seq Int) -> [Seq Int] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.take Int
n) [Seq Int]
expnts)
          checks :: Bool
checks       = Bool
check1 Bool -> Bool -> Bool
&& Bool
check2
          poly :: Maybe (Spray a)
poly         = if Bool
checks
            then Spray a -> Maybe (Spray a)
forall a. a -> Maybe a
Just (Spray a -> Maybe (Spray a)) -> Spray a -> Maybe (Spray a)
forall a b. (a -> b) -> a -> b
$ Spray a -> Spray a
forall a. Spray a -> Spray a
dropXis Spray a
g Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^+^ Spray a
constantTerm
            else Maybe (Spray a)
forall a. Maybe a
Nothing
          dropXis :: HashMap Powers v -> HashMap Powers v
dropXis = (Powers -> Powers) -> HashMap Powers v -> HashMap Powers v
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HM.mapKeys Powers -> Powers
f
          f :: Powers -> Powers
f (Powers Seq Int
expnnts Int
_) = Seq Int -> Int -> Powers
Powers (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.drop Int
n Seq Int
expnnts) Int
n


-- resultant ------------------------------------------------------------------


-- | sylvester matrix

sylvesterMatrix :: AlgAdd.C a => [a] -> [a] -> Matrix a
sylvesterMatrix :: forall a. C a => [a] -> [a] -> Matrix a
sylvesterMatrix [a]
x [a]
y = [[a]] -> Matrix a
forall a. [[a]] -> Matrix a
fromLists ([[a]]
xrows [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
yrows) 
  where
    m :: Int
m = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    n :: Int
n = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    xrows :: [[a]]
xrows = [Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
i a
forall a. C a => a
AlgAdd.zero [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
forall a. C a => a
AlgAdd.zero 
             | Int
i <- [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
    yrows :: [[a]]
yrows = [Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
i a
forall a. C a => a
AlgAdd.zero [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
forall a. C a => a
AlgAdd.zero 
             | Int
i <- [Int
0 .. Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]

-- | "truncated" Sylvester matrix

sylvesterMatrix' :: AlgRing.C a => [a] -> [a] -> Int -> Matrix a
sylvesterMatrix' :: forall a. C a => [a] -> [a] -> Int -> Matrix a
sylvesterMatrix' [a]
x [a]
y Int
k = if Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
  then [[a]] -> Matrix a
forall a. [[a]] -> Matrix a
fromLists [[a
forall a. C a => a
AlgRing.one]] -- plays the role of the empty matrix: 

                                 -- the point to get is determinant=1 

                                 -- (because the empty matrix is not allowed

                                 -- in the matrix package)

  else Int -> Int -> Int -> Int -> Matrix a -> Matrix a
forall a. Int -> Int -> Int -> Int -> Matrix a -> Matrix a
submatrix Int
1 Int
s Int
1 Int
s (Matrix a -> Matrix a) -> Matrix a -> Matrix a
forall a b. (a -> b) -> a -> b
$ [[a]] -> Matrix a
forall a. [[a]] -> Matrix a
fromLists ([[a]]
xrows [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
yrows) 
  where
    m :: Int
m = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    n :: Int
n = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    s :: Int
s = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k
    xrows :: [[a]]
xrows = [Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
i a
forall a. C a => a
AlgAdd.zero [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
forall a. C a => a
AlgAdd.zero 
             | Int
i <- [Int
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k]]
    yrows :: [[a]]
yrows = [Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
i a
forall a. C a => a
AlgAdd.zero [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
forall a. C a => a
AlgAdd.zero 
             | Int
i <- [Int
0 .. Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k]]

-- | determinant of a matrix

detLaplace :: forall a. (Eq a, AlgRing.C a) => Matrix a -> a
detLaplace :: forall a. (Eq a, C a) => Matrix a -> a
detLaplace Matrix a
m = if Matrix a -> Int
forall a. Matrix a -> Int
nrows Matrix a
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 
  then 
    Matrix a
m Matrix a -> (Int, Int) -> a
forall a. Matrix a -> (Int, Int) -> a
DM.! (Int
1,Int
1)
  else 
    [a] -> a
suml1 [Int -> a -> a
forall {a} {a}. (Integral a, C a) => a -> a -> a
negateIf Int
i (a -> a -> a
times (Matrix a
m Matrix a -> (Int, Int) -> a
forall a. Matrix a -> (Int, Int) -> a
DM.! (Int
i,Int
1)) (Matrix a -> a
forall a. (Eq a, C a) => Matrix a -> a
detLaplace (Int -> Int -> Matrix a -> Matrix a
forall a. Int -> Int -> Matrix a -> Matrix a
minorMatrix Int
i Int
1 Matrix a
m))) 
           | Int
i <- [Int
1 .. Matrix a -> Int
forall a. Matrix a -> Int
nrows Matrix a
m]]
  where 
    suml1 :: [a] -> a
suml1      = (a -> a -> a) -> [a] -> a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' a -> a -> a
forall a. C a => a -> a -> a
(AlgAdd.+)
    negateIf :: a -> a -> a
negateIf a
i = if a -> Bool
forall a. Integral a => a -> Bool
even a
i then a -> a
forall a. C a => a -> a
AlgAdd.negate else a -> a
forall a. a -> a
id
    times :: a -> a -> a
    times :: a -> a -> a
times a
x a
y = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
AlgAdd.zero then a
forall a. C a => a
AlgAdd.zero else a
x a -> a -> a
forall a. C a => a -> a -> a
AlgRing.* a
y

-- | the coefficients of a spray as a univariate spray in x with 

-- spray coefficients

sprayCoefficients :: (Eq a, AlgRing.C a) => Spray a -> [Spray a]
sprayCoefficients :: forall a. (Eq a, C a) => Spray a -> [Spray a]
sprayCoefficients Spray a
spray = 
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 
    then [Spray a
constantTerm]
    else [Spray a] -> [Spray a]
forall a. [a] -> [a]
reverse [Spray a]
sprays
  where
    n :: Int
n = Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray 
    ([Powers]
powers, [a]
coeffs) = [(Powers, a)] -> ([Powers], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip (Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
spray)
    expnts :: [Seq Int]
expnts           = (Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents [Powers]
powers
    constantTerm :: Spray a
constantTerm = 
      a -> Spray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray (a -> Spray a) -> a -> Spray a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0) Spray a
spray)
    ([Seq Int]
expnts', [a]
coeffs') = 
      [(Seq Int, a)] -> ([Seq Int], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Seq Int, a)] -> ([Seq Int], [a]))
-> [(Seq Int, a)] -> ([Seq Int], [a])
forall a b. (a -> b) -> a -> b
$ ((Seq Int, a) -> Bool) -> [(Seq Int, a)] -> [(Seq Int, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Seq Int
s,a
_) -> Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ([Seq Int] -> [a] -> [(Seq Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Seq Int]
expnts [a]
coeffs)
    xpows :: [Int]
xpows              = (Seq Int -> Int) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
0) [Seq Int]
expnts'
    expnts'' :: [Seq Int]
expnts''           = (Seq Int -> Seq Int) -> [Seq Int] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.deleteAt Int
0) [Seq Int]
expnts'
    powers'' :: [Powers]
powers''           = (Seq Int -> Powers) -> [Seq Int] -> [Powers]
forall a b. (a -> b) -> [a] -> [b]
map (\Seq Int
s -> Seq Int -> Int -> Powers
Powers Seq Int
s (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
s)) [Seq Int]
expnts''
    sprays'' :: [Spray a]
sprays''           = (Powers -> a -> Spray a) -> [Powers] -> [a] -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Powers, a) -> Spray a) -> Powers -> a -> Spray a
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Powers, a) -> Spray a
forall a. Monomial a -> Spray a
fromMonomial) [Powers]
powers'' [a]
coeffs'
    imap :: IntMap (Spray a)
imap               = (Spray a -> Spray a -> Spray a)
-> [(Int, Spray a)] -> IntMap (Spray a)
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^+^) ([Int] -> [Spray a] -> [(Int, Spray a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xpows [Spray a]
sprays'')
    imap' :: IntMap (Spray a)
imap'              = (Spray a -> Spray a -> Spray a)
-> Int -> Spray a -> IntMap (Spray a) -> IntMap (Spray a)
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^+^) Int
0 Spray a
constantTerm IntMap (Spray a)
imap
    permutation :: [Int]
permutation = [Int
2 .. Int
n] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
1]
    sprays :: [Spray a]
sprays = [
        [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation (Spray a -> Maybe (Spray a) -> Spray a
forall a. a -> Maybe a -> a
fromMaybe Spray a
forall a. C a => a
AlgAdd.zero (Int -> IntMap (Spray a) -> Maybe (Spray a)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i IntMap (Spray a)
imap')) 
        | Int
i <- [Int
0 .. [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xpows]
      ]

-- | Resultant of two /univariate/ sprays

resultant1 :: (Eq a, AlgRing.C a) => Spray a -> Spray a -> a
resultant1 :: forall a. (Eq a, C a) => Spray a -> Spray a -> a
resultant1 Spray a
p Spray a
q = 
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 
    then Matrix a -> a
forall a. (Eq a, C a) => Matrix a -> a
detLaplace (Matrix a -> a) -> Matrix a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> Matrix a
forall a. C a => [a] -> [a] -> Matrix a
sylvesterMatrix [a]
pcoeffs [a]
qcoeffs
    else String -> a
forall a. HasCallStack => String -> a
error String
"resultant1: the two sprays must be univariate."
  where
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
p) (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
q)
    pexpnts :: [Int]
pexpnts = 
      (Seq Int -> Int) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
0) ([Seq Int] -> [Int]) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Seq Int -> Bool) -> [Seq Int] -> [Seq Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Seq Int -> Bool) -> Seq Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> Bool
forall a. Seq a -> Bool
S.null) ((Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents (Spray a -> [Powers]
forall k v. HashMap k v -> [k]
HM.keys Spray a
p))
    qexpnts :: [Int]
qexpnts = 
      (Seq Int -> Int) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
0) ([Seq Int] -> [Int]) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Seq Int -> Bool) -> [Seq Int] -> [Seq Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Seq Int -> Bool) -> Seq Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> Bool
forall a. Seq a -> Bool
S.null) ((Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents (Spray a -> [Powers]
forall k v. HashMap k v -> [k]
HM.keys Spray a
q))
    p0 :: a
p0 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0) Spray a
p)
    q0 :: a
q0 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0) Spray a
q)
    pcoeffs :: [a]
pcoeffs = if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
pexpnts 
      then [a
p0]
      else [a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers (Int -> Seq Int
forall a. a -> Seq a
S.singleton Int
i) Int
1) Spray a
p) 
            | Int
i <- [Int
maxp, Int
maxpInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
1]] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
p0]
      where
        maxp :: Int
maxp = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
pexpnts
    qcoeffs :: [a]
qcoeffs = if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
qexpnts 
      then [a
q0]
      else [a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers (Int -> Seq Int
forall a. a -> Seq a
S.singleton Int
i) Int
1) Spray a
q) 
            | Int
i <- [Int
maxq, Int
maxqInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
1]] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
q0]
      where
        maxq :: Int
maxq = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
qexpnts

-- | Subresultants of two /univariate/ sprays

subresultants1 :: (Eq a, AlgRing.C a) => Spray a -> Spray a -> [a]
subresultants1 :: forall a. (Eq a, C a) => Spray a -> Spray a -> [a]
subresultants1 Spray a
p Spray a
q = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 
  then (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Matrix a -> a
forall a. (Eq a, C a) => Matrix a -> a
detLaplace (Matrix a -> a) -> (Int -> Matrix a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> Int -> Matrix a
forall a. C a => [a] -> [a] -> Int -> Matrix a
sylvesterMatrix' [a]
pcoeffs [a]
qcoeffs) [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
d Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  else String -> [a]
forall a. HasCallStack => String -> a
error String
"subresultants1: the two sprays must be univariate."
  where
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
p) (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
q)
    pexpnts :: [Int]
pexpnts = 
      (Seq Int -> Int) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
0) ([Seq Int] -> [Int]) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Seq Int -> Bool) -> [Seq Int] -> [Seq Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Seq Int -> Bool) -> Seq Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> Bool
forall a. Seq a -> Bool
S.null) ((Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents (Spray a -> [Powers]
forall k v. HashMap k v -> [k]
HM.keys Spray a
p))
    qexpnts :: [Int]
qexpnts = 
      (Seq Int -> Int) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
0) ([Seq Int] -> [Int]) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Seq Int -> Bool) -> [Seq Int] -> [Seq Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Seq Int -> Bool) -> Seq Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> Bool
forall a. Seq a -> Bool
S.null) ((Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents (Spray a -> [Powers]
forall k v. HashMap k v -> [k]
HM.keys Spray a
q))
    p0 :: a
p0 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0) Spray a
p)
    q0 :: a
q0 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0) Spray a
q)
    pcoeffs :: [a]
pcoeffs = if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
pexpnts 
      then [a
p0]
      else [a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers (Int -> Seq Int
forall a. a -> Seq a
S.singleton Int
i) Int
1) Spray a
p) 
            | Int
i <- [Int
maxp, Int
maxpInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
1]] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
p0]
      where
        maxp :: Int
maxp = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
pexpnts
    qcoeffs :: [a]
qcoeffs = if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
qexpnts 
      then [a
q0]
      else [a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers (Int -> Seq Int
forall a. a -> Seq a
S.singleton Int
i) Int
1) Spray a
q) 
            | Int
i <- [Int
maxq, Int
maxqInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
1]] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
q0]
      where
        maxq :: Int
maxq = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
qexpnts
    d :: Int
d = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
pcoeffs
    e :: Int
e = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
qcoeffs

-- | Resultant of two sprays

resultant :: (Eq a, AlgRing.C a) 
  => Int     -- ^ indicator of the variable with respect to which the resultant is desired (e.g. 1 for x)

  -> Spray a 
  -> Spray a 
  -> Spray a
resultant :: forall a. (Eq a, C a) => Int -> Spray a -> Spray a -> Spray a
resultant Int
var Spray a
p Spray a
q = 
  if Int
var Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
var Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n 
    then [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation' Spray a
det
    else String -> Spray a
forall a. HasCallStack => String -> a
error String
"resultant: invalid variable index."
  where
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
p) (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
q)
    permutation :: [Int]
permutation  = [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
varInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2 .. Int
n] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
1 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
varInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1]
    permutation' :: [Int]
permutation' = [Int
var .. Int
n] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
1 .. Int
varInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
    p' :: Spray a
p' = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation Spray a
p
    q' :: Spray a
q' = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation Spray a
q
    det :: Spray a
det = Matrix (Spray a) -> Spray a
forall a. (Eq a, C a) => Matrix a -> a
detLaplace (Matrix (Spray a) -> Spray a) -> Matrix (Spray a) -> Spray a
forall a b. (a -> b) -> a -> b
$ 
          [Spray a] -> [Spray a] -> Matrix (Spray a)
forall a. C a => [a] -> [a] -> Matrix a
sylvesterMatrix (Spray a -> [Spray a]
forall a. (Eq a, C a) => Spray a -> [Spray a]
sprayCoefficients Spray a
p') (Spray a -> [Spray a]
forall a. (Eq a, C a) => Spray a -> [Spray a]
sprayCoefficients Spray a
q')

-- | Subresultants of two sprays

subresultants :: (Eq a, AlgRing.C a) 
  => Int     -- ^ indicator of the variable with respect to which the subresultants are desired (e.g. 1 for x)

  -> Spray a 
  -> Spray a 
  -> [Spray a]
subresultants :: forall a. (Eq a, C a) => Int -> Spray a -> Spray a -> [Spray a]
subresultants Int
var Spray a
p Spray a
q 
  | Int
var Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> [Spray a]
forall a. HasCallStack => String -> a
error String
"subresultants: invalid variable index."
  | Int
var Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = String -> [Spray a]
forall a. HasCallStack => String -> a
error String
"subresultants: too large variable index."
  | Bool
otherwise = (Int -> Spray a) -> [Int] -> [Spray a]
forall a b. (a -> b) -> [a] -> [b]
map (Spray a -> Spray a
forall a. Spray a -> Spray a
permute' (Spray a -> Spray a) -> (Int -> Spray a) -> Int -> Spray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix (Spray a) -> Spray a
forall a. (Eq a, C a) => Matrix a -> a
detLaplace (Matrix (Spray a) -> Spray a)
-> (Int -> Matrix (Spray a)) -> Int -> Spray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Spray a] -> [Spray a] -> Int -> Matrix (Spray a)
forall a. C a => [a] -> [a] -> Int -> Matrix a
sylvesterMatrix' [Spray a]
pcoeffs [Spray a]
qcoeffs) 
                    [Int
0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
d Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  where
    pcoeffs :: [Spray a]
pcoeffs = Spray a -> [Spray a]
forall a. (Eq a, C a) => Spray a -> [Spray a]
sprayCoefficients Spray a
p'
    qcoeffs :: [Spray a]
qcoeffs = Spray a -> [Spray a]
forall a. (Eq a, C a) => Spray a -> [Spray a]
sprayCoefficients Spray a
q'
    d :: Int
d = [Spray a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Spray a]
pcoeffs
    e :: Int
e = [Spray a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Spray a]
qcoeffs
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
p) (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
q)
    permutation :: [Int]
permutation = Int
var Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
1 .. Int
varInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
varInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 .. Int
n]
    permute :: Spray a -> Spray a
permute     = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation
    p' :: Spray a
p' = Spray a -> Spray a
forall a. Spray a -> Spray a
permute Spray a
p 
    q' :: Spray a
q' = Spray a -> Spray a
forall a. Spray a -> Spray a
permute Spray a
q 
    permutation' :: [Int]
permutation' = [Int
2 .. Int
var] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
varInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 .. Int
n])
    permute' :: Spray a -> Spray a
permute'     = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation'

-- | Resultant of two sprays with coefficients in a field; this function is more 

-- efficient than the function `resultant`

resultant' :: forall a. (Eq a, AlgField.C a) 
  => Int     -- ^ indicator of the variable with respect to which the resultant is desired (e.g. 1 for x)

  -> Spray a 
  -> Spray a 
  -> Spray a
resultant' :: forall a. (Eq a, C a) => Int -> Spray a -> Spray a -> Spray a
resultant' Int
var Spray a
sprayA Spray a
sprayB 
  | Int
var Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
var Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n                         
    = String -> Spray a
forall a. HasCallStack => String -> a
error String
"resultant': invalid variable index." 
  | Spray a
sprayA Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray Bool -> Bool -> Bool
|| Spray a
sprayB Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray 
    = Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
  | Bool
otherwise 
    = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation' (Spray a -> Spray a) -> Spray a -> Spray a
forall a b. (a -> b) -> a -> b
$ Spray a -> Spray a -> Spray a -> Spray a -> Spray a -> Spray a
go Spray a
forall a. C a => Spray a
unitSpray Spray a
forall a. C a => Spray a
unitSpray Spray a
s0 Spray a
p0 Spray a
q0
  where
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
sprayA) (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
sprayB)
    permutation :: [Int]
permutation  = [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
varInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 .. Int
n] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
1 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
var]
    permutation' :: [Int]
permutation' = [Int
varInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 .. Int
n] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
1 .. Int
var] 
    sprayA' :: Spray a
sprayA' = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation Spray a
sprayA
    sprayB' :: Spray a
sprayB' = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation Spray a
sprayB
    degA :: Int
degA = Int -> Spray a -> Int
forall a. (Eq a, C a) => Int -> Spray a -> Int
degree Int
n Spray a
sprayA'
    degB :: Int
degB = Int -> Spray a -> Int
forall a. (Eq a, C a) => Int -> Spray a -> Int
degree Int
n Spray a
sprayB'
    content :: Spray a -> Spray a
    content :: Spray a -> Spray a
content Spray a
spray = (Spray a -> Spray a -> Spray a) -> [Spray a] -> Spray a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Spray a -> Spray a -> Spray a
forall a. (Eq a, C a) => Spray a -> Spray a -> Spray a
gcdSpray (Int -> Spray a -> [Spray a]
forall a. (Eq a, C a) => Int -> Spray a -> [Spray a]
sprayCoefficients' Int
n Spray a
spray)
    exactDivisionBy :: Spray a -> Spray a -> Spray a
    exactDivisionBy :: Spray a -> Spray a -> Spray a
exactDivisionBy Spray a
b Spray a
a = 
      if (Spray a, Spray a) -> Spray a
forall a b. (a, b) -> b
snd (Spray a, Spray a)
division Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray 
        then (Spray a, Spray a) -> Spray a
forall a b. (a, b) -> a
fst (Spray a, Spray a)
division 
        else String -> Spray a
forall a. HasCallStack => String -> a
error String
"exactDivisionBy: should not happen."
      where
        division :: (Spray a, Spray a)
division = Spray a -> Spray a -> (Spray a, Spray a)
forall a. (Eq a, C a) => Spray a -> Spray a -> (Spray a, Spray a)
sprayDivision Spray a
a Spray a
b
    contA :: Spray a
contA = Spray a -> Spray a
content Spray a
sprayA'
    contB :: Spray a
contB = Spray a -> Spray a
content Spray a
sprayB'
    sprayA'' :: Spray a
sprayA'' = Spray a -> Spray a -> Spray a
exactDivisionBy Spray a
contA Spray a
sprayA'
    sprayB'' :: Spray a
sprayB'' = Spray a -> Spray a -> Spray a
exactDivisionBy Spray a
contB Spray a
sprayB'
    t :: Spray a
t = Spray a
contASpray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
degB Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
contBSpray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
degA
    s0 :: Spray a
s0 = if Int
degA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
degB Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
odd Int
degA Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
odd Int
degB 
      then Spray a -> Spray a
forall a. C a => a -> a
AlgAdd.negate Spray a
forall a. C a => Spray a
unitSpray :: Spray a
      else Spray a
forall a. C a => Spray a
unitSpray
    (Spray a
p0, Spray a
q0) = if Int
degA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
degB
      then (Spray a
sprayA'', Spray a
sprayB'')
      else (Spray a
sprayB'', Spray a
sprayA'')
    go :: Spray a -> Spray a -> Spray a -> Spray a -> Spray a -> Spray a
    go :: Spray a -> Spray a -> Spray a -> Spray a -> Spray a -> Spray a
go Spray a
g Spray a
h Spray a
s Spray a
p Spray a
q = 
      if Int
degq' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Spray a
s' Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
t Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
h''
        else Spray a -> Spray a -> Spray a -> Spray a -> Spray a -> Spray a
go Spray a
g' Spray a
h' Spray a
s' Spray a
p' Spray a
q'
        where
          degp :: Int
degp           = Int -> Spray a -> Int
forall a. (Eq a, C a) => Int -> Spray a -> Int
degree Int
n Spray a
p
          degq :: Int
degq           = Int -> Spray a -> Int
forall a. (Eq a, C a) => Int -> Spray a -> Int
degree Int
n Spray a
q
          delta :: Int
delta          = Int
degp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
degq
          s' :: Spray a
s' = if Int -> Bool
forall a. Integral a => a -> Bool
odd Int
degp Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
odd Int
degq 
            then Spray a -> Spray a
forall a. C a => a -> a
AlgAdd.negate Spray a
s 
            else Spray a
s
          (Spray a
_, (Spray a
_, Spray a
r)) = Int -> Spray a -> Spray a -> (Spray a, (Spray a, Spray a))
forall a.
(Eq a, C a) =>
Int -> Spray a -> Spray a -> (Spray a, (Spray a, Spray a))
pseudoDivision Int
n Spray a
p Spray a
q
          p' :: Spray a
p'             = Spray a
q
          q' :: Spray a
q'             = Spray a -> Spray a -> Spray a
exactDivisionBy (Spray a
g Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
hSpray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
delta) Spray a
r
          (Int
degp', Spray a
ellp') = Int -> Spray a -> (Int, Spray a)
forall a. (Eq a, C a) => Int -> Spray a -> (Int, Spray a)
degreeAndLeadingCoefficient Int
n Spray a
p'
          (Int
degq', Spray a
ellq') = Int -> Spray a -> (Int, Spray a)
forall a. (Eq a, C a) => Int -> Spray a -> (Int, Spray a)
degreeAndLeadingCoefficient Int
n Spray a
q'
          g' :: Spray a
g'  = Spray a
ellp'
          h' :: Spray a
h'  = Spray a -> Spray a -> Spray a
exactDivisionBy (Spray a
hSpray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
delta) (Spray a
h Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
g'Spray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
delta)
          h'' :: Spray a
h'' = Spray a -> Spray a -> Spray a
exactDivisionBy (Spray a
h'Spray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
degp') (Spray a
h' Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
ellq'Spray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
degp')


-- GCD stuff ------------------------------------------------------------------


-- | the coefficients of a spray as a univariate spray in x_n with 

-- spray coefficients

sprayCoefficients' :: (Eq a, AlgRing.C a) => Int -> Spray a -> [Spray a]
sprayCoefficients' :: forall a. (Eq a, C a) => Int -> Spray a -> [Spray a]
sprayCoefficients' Int
n Spray a
spray 
  | Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n = [Spray a
spray]
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0                       = [a -> Spray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray a
constantTerm]
  | Bool
otherwise                    = [Spray a]
sprays 
  where
    permutation :: [Int]
permutation = [Int
2 .. Int
n] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
1]
    spray' :: Spray a
spray'      = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation Spray a
spray
    ([Powers]
powers, [a]
coeffs) = [(Powers, a)] -> ([Powers], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip (Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
spray')
    expnts :: [Seq Int]
expnts           = (Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents [Powers]
powers
    constantTerm :: a
constantTerm = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0) Spray a
spray')
    ([Seq Int]
expnts', [a]
coeffs') = 
      [(Seq Int, a)] -> ([Seq Int], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Seq Int, a)] -> ([Seq Int], [a]))
-> [(Seq Int, a)] -> ([Seq Int], [a])
forall a b. (a -> b) -> a -> b
$ ((Seq Int, a) -> Bool) -> [(Seq Int, a)] -> [(Seq Int, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Seq Int
s,a
_) -> (Bool -> Bool
not (Bool -> Bool) -> (Seq Int -> Bool) -> Seq Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> Bool
forall a. Seq a -> Bool
S.null) Seq Int
s) ([Seq Int] -> [a] -> [(Seq Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Seq Int]
expnts [a]
coeffs)
    xpows :: [Int]
xpows = (Seq Int -> Int) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
0) [Seq Int]
expnts'
    expnts'' :: [Seq Int]
expnts'' = (Seq Int -> Seq Int) -> [Seq Int] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.deleteAt Int
0) [Seq Int]
expnts'
    powers'' :: [Powers]
powers'' = (Seq Int -> Powers) -> [Seq Int] -> [Powers]
forall a b. (a -> b) -> [a] -> [b]
map (\Seq Int
s -> Seq Int -> Int -> Powers
Powers Seq Int
s (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
s)) [Seq Int]
expnts''
    sprays'' :: [Spray a]
sprays'' = (Powers -> a -> Spray a) -> [Powers] -> [a] -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Powers, a) -> Spray a) -> Powers -> a -> Spray a
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Powers, a) -> Spray a
forall a. Monomial a -> Spray a
fromMonomial) [Powers]
powers'' [a]
coeffs'
    imap :: IntMap (Spray a)
imap   = (Spray a -> Spray a -> Spray a)
-> [(Int, Spray a)] -> IntMap (Spray a)
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^+^) ([Int] -> [Spray a] -> [(Int, Spray a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xpows [Spray a]
sprays'')
    imap' :: IntMap (Spray a)
imap'  = (Spray a -> Spray a -> Spray a)
-> Int -> Spray a -> IntMap (Spray a) -> IntMap (Spray a)
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^+^) Int
0 (a -> Spray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray a
constantTerm) IntMap (Spray a)
imap
    deg :: Int
deg    = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xpows
    sprays :: [Spray a]
sprays = [
        Spray a -> Maybe (Spray a) -> Spray a
forall a. a -> Maybe a -> a
fromMaybe Spray a
forall a. C a => a
AlgAdd.zero (Int -> IntMap (Spray a) -> Maybe (Spray a)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i IntMap (Spray a)
imap')
        | Int
i <- [Int
deg, Int
degInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 .. Int
0]
      ]

-- | the degree of a spray as a univariate spray in x_n with spray coefficients

degree :: (Eq a, AlgAdd.C a) => Int -> Spray a -> Int
degree :: forall a. (Eq a, C a) => Int -> Spray a -> Int
degree Int
n Spray a
spray 
  | Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = 
      if Spray a
spray Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray 
        then Int
forall a. Bounded a => a
minBound -- (should not happen)

        else Int
0
  | Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n = Int
0
  | Bool
otherwise                    = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xpows
    where
      permutation :: [Int]
permutation = [Int
2 .. Int
n] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
1]
      spray' :: Spray a
spray'      = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation Spray a
spray
      expnts :: [Seq Int]
expnts      = (Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents ([Powers] -> [Seq Int]) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> a -> b
$ Spray a -> [Powers]
forall k v. HashMap k v -> [k]
HM.keys Spray a
spray'
      expnts' :: [Seq Int]
expnts'     = (Seq Int -> Bool) -> [Seq Int] -> [Seq Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Seq Int -> Bool) -> Seq Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> Bool
forall a. Seq a -> Bool
S.null) [Seq Int]
expnts
      xpows :: [Int]
xpows       = (Seq Int -> Int) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
0) [Seq Int]
expnts'

-- | the degree and the leading coefficient of a spray as a univariate spray 

-- in x_n with spray coefficients

degreeAndLeadingCoefficient :: (Eq a, AlgRing.C a) 
                                => Int -> Spray a -> (Int, Spray a)
degreeAndLeadingCoefficient :: forall a. (Eq a, C a) => Int -> Spray a -> (Int, Spray a)
degreeAndLeadingCoefficient Int
n Spray a
spray 
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0                       = (
                                    if a
constantTerm a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. C a => a
AlgAdd.zero 
                                      then Int
forall a. Bounded a => a
minBound -- (should not happen)

                                      else Int
0, 
                                    a -> Spray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray a
constantTerm
                                   )
  | Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
spray Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n = (Int
0, Spray a
spray)
  | Bool
otherwise                    = (Int
deg, Spray a
leadingCoeff)
  where
    permutation :: [Int]
permutation  = [Int
2 .. Int
n] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
1]
    spray' :: Spray a
spray'       = [Int] -> Spray a -> Spray a
forall a. [Int] -> Spray a -> Spray a
permuteVariables [Int]
permutation Spray a
spray
    ([Powers]
powers, [a]
coeffs) = [(Powers, a)] -> ([Powers], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip (Spray a -> [(Powers, a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Spray a
spray')
    expnts :: [Seq Int]
expnts           = (Powers -> Seq Int) -> [Powers] -> [Seq Int]
forall a b. (a -> b) -> [a] -> [b]
map Powers -> Seq Int
exponents [Powers]
powers
    constantTerm :: a
constantTerm = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. C a => a
AlgAdd.zero (Powers -> Spray a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Seq Int -> Int -> Powers
Powers Seq Int
forall a. Seq a
S.empty Int
0) Spray a
spray')
    ([Seq Int]
expnts', [a]
coeffs') = 
      [(Seq Int, a)] -> ([Seq Int], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Seq Int, a)] -> ([Seq Int], [a]))
-> [(Seq Int, a)] -> ([Seq Int], [a])
forall a b. (a -> b) -> a -> b
$ ((Seq Int, a) -> Bool) -> [(Seq Int, a)] -> [(Seq Int, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Seq Int
s,a
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Seq Int -> Bool
forall a. Seq a -> Bool
S.null Seq Int
s) ([Seq Int] -> [a] -> [(Seq Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Seq Int]
expnts [a]
coeffs)
    xpows :: [Int]
xpows = (Seq Int -> Int) -> [Seq Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
`index` Int
0) [Seq Int]
expnts'
    deg :: Int
deg   = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xpows
    is :: [Int]
is    = Int -> [Int] -> [Int]
forall a. Eq a => a -> [a] -> [Int]
elemIndices Int
deg [Int]
xpows
    expnts'' :: [Seq Int]
expnts'' = [Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
S.deleteAt Int
0 ([Seq Int]
expnts' [Seq Int] -> Int -> Seq Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) | Int
i <- [Int]
is]
    powers'' :: [Powers]
powers'' = (Seq Int -> Powers) -> [Seq Int] -> [Powers]
forall a b. (a -> b) -> [a] -> [b]
map (\Seq Int
s -> Seq Int -> Int -> Powers
Powers Seq Int
s (Seq Int -> Int
forall a. Seq a -> Int
S.length Seq Int
s)) [Seq Int]
expnts''
    coeffs'' :: [a]
coeffs'' = [[a]
coeffs' [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i | Int
i <- [Int]
is]
    leadingCoeff :: Spray a
leadingCoeff = 
      (Spray a -> Spray a -> Spray a) -> [Spray a] -> Spray a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
(^+^) ((Powers -> a -> Spray a) -> [Powers] -> [a] -> [Spray a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Powers, a) -> Spray a) -> Powers -> a -> Spray a
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Powers, a) -> Spray a
forall a. Monomial a -> Spray a
fromMonomial) [Powers]
powers'' [a]
coeffs'')

-- | pseudo-division of two sprays, assuming degA >= degB >= 0

pseudoDivision :: (Eq a, AlgRing.C a)
  => Int                           -- ^ number of variables

  -> Spray a                       -- ^ A

  -> Spray a                       -- ^ B

  -> (Spray a, (Spray a, Spray a)) -- ^ (c, (Q, R)) such that c^*^A = B^*^Q ^+^ R

pseudoDivision :: forall a.
(Eq a, C a) =>
Int -> Spray a -> Spray a -> (Spray a, (Spray a, Spray a))
pseudoDivision Int
n Spray a
sprayA Spray a
sprayB 
  | Int
degB Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
minBound = String -> (Spray a, (Spray a, Spray a))
forall a. HasCallStack => String -> a
error String
"pseudoDivision: pseudo-division by 0."
  | Int
degA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
degB      = String -> (Spray a, (Spray a, Spray a))
forall a. HasCallStack => String -> a
error String
"pseudoDivision: degree(A) < degree(B)."
  | Bool
otherwise        = (Spray a
ellB Spray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^ Int
delta , Spray a -> Spray a -> Int -> (Spray a, Spray a)
go Spray a
sprayA Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray Int
delta)
  where
    degA :: Int
degA         = Int -> Spray a -> Int
forall a. (Eq a, C a) => Int -> Spray a -> Int
degree Int
n Spray a
sprayA
    (Int
degB, Spray a
ellB) = Int -> Spray a -> (Int, Spray a)
forall a. (Eq a, C a) => Int -> Spray a -> (Int, Spray a)
degreeAndLeadingCoefficient Int
n Spray a
sprayB
    delta :: Int
delta        = Int
degA Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
degB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    go :: Spray a -> Spray a -> Int -> (Spray a, Spray a)
go Spray a
sprayR Spray a
sprayQ Int
e = 
      if Int
degR Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
degB Bool -> Bool -> Bool
|| Spray a
sprayR Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray
        then (Spray a
q Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
sprayQ, Spray a
q Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
sprayR)
        else Spray a -> Spray a -> Int -> (Spray a, Spray a)
go (Spray a
ellB Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
sprayR Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^-^ Spray a
sprayS Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
sprayB) 
                (Spray a
ellB Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
sprayQ Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^+^ Spray a
sprayS) 
                (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      where
        (Int
degR, Spray a
ellR) = Int -> Spray a -> (Int, Spray a)
forall a. (Eq a, C a) => Int -> Spray a -> (Int, Spray a)
degreeAndLeadingCoefficient Int
n Spray a
sprayR
        q :: Spray a
q            = Spray a
ellB Spray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^ Int
e
        sprayXn :: Spray a
sprayXn      = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
n 
        sprayS :: Spray a
sprayS       = Spray a
ellR Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
sprayXn Spray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^ (Int
degR Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
degB)

-- | recursive GCD function

gcdKX1dotsXn :: forall a. (Eq a, AlgField.C a) 
                => Int -> Spray a -> Spray a -> Spray a
gcdKX1dotsXn :: forall a. (Eq a, C a) => Int -> Spray a -> Spray a -> Spray a
gcdKX1dotsXn Int
n Spray a
sprayA Spray a
sprayB
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0              = a -> Spray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray (a -> Spray a) -> a -> Spray a
forall a b. (a -> b) -> a -> b
$ Spray a -> Spray a -> a
gcdKX0 Spray a
sprayA Spray a
sprayB
  | Int
degB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
degA         = Int -> Spray a -> Spray a -> Spray a
forall a. (Eq a, C a) => Int -> Spray a -> Spray a -> Spray a
gcdKX1dotsXn Int
n Spray a
sprayB Spray a
sprayA 
  | Spray a
sprayB Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray = Spray a
sprayA
  | Bool
otherwise           = Spray a -> Spray a -> Spray a -> Spray a -> Spray a
go Spray a
sprayA' Spray a
sprayB' Spray a
forall a. C a => Spray a
unitSpray Spray a
forall a. C a => Spray a
unitSpray
  where
    gcdKX0 :: Spray a -> Spray a -> a
    gcdKX0 :: Spray a -> Spray a -> a
gcdKX0 = (Spray a -> a) -> Spray a -> Spray a -> a
forall a b. a -> b -> a
const ((Spray a -> a) -> Spray a -> Spray a -> a)
-> (Spray a -> a) -> Spray a -> Spray a -> a
forall a b. (a -> b) -> a -> b
$ a -> Spray a -> a
forall a b. a -> b -> a
const a
forall a. C a => a
AlgRing.one 
    n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
sprayA) (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
sprayB)
    degA :: Int
degA = Int -> Spray a -> Int
forall a. (Eq a, C a) => Int -> Spray a -> Int
degree Int
n' Spray a
sprayA
    degB :: Int
degB = Int -> Spray a -> Int
forall a. (Eq a, C a) => Int -> Spray a -> Int
degree Int
n' Spray a
sprayB
    gcdKX1dotsXm :: Spray a -> Spray a -> Spray a
gcdKX1dotsXm = Int -> Spray a -> Spray a -> Spray a
forall a. (Eq a, C a) => Int -> Spray a -> Spray a -> Spray a
gcdKX1dotsXn (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    content :: Spray a -> Spray a
    content :: Spray a -> Spray a
content Spray a
spray = (Spray a -> Spray a -> Spray a) -> [Spray a] -> Spray a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Spray a -> Spray a -> Spray a
gcdKX1dotsXm (Int -> Spray a -> [Spray a]
forall a. (Eq a, C a) => Int -> Spray a -> [Spray a]
sprayCoefficients' Int
n' Spray a
spray)
    exactDivisionBy :: Spray a -> Spray a -> Spray a
    exactDivisionBy :: Spray a -> Spray a -> Spray a
exactDivisionBy Spray a
b Spray a
a = 
      if (Spray a, Spray a) -> Spray a
forall a b. (a, b) -> b
snd (Spray a, Spray a)
division Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray 
        then (Spray a, Spray a) -> Spray a
forall a b. (a, b) -> a
fst (Spray a, Spray a)
division 
        else String -> Spray a
forall a. HasCallStack => String -> a
error String
"exactDivisionBy: should not happen."
      where
        division :: (Spray a, Spray a)
division = Spray a -> Spray a -> (Spray a, Spray a)
forall a. (Eq a, C a) => Spray a -> Spray a -> (Spray a, Spray a)
sprayDivision Spray a
a Spray a
b
    reduceSpray :: Spray a -> Spray a
    reduceSpray :: Spray a -> Spray a
reduceSpray Spray a
spray = Spray a -> Spray a -> Spray a
exactDivisionBy Spray a
cntnt Spray a
spray 
      where
        coeffs :: [Spray a]
coeffs = Int -> Spray a -> [Spray a]
forall a. (Eq a, C a) => Int -> Spray a -> [Spray a]
sprayCoefficients' Int
n' Spray a
spray
        cntnt :: Spray a
cntnt  = (Spray a -> Spray a -> Spray a) -> [Spray a] -> Spray a
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Spray a -> Spray a -> Spray a
gcdKX1dotsXm [Spray a]
coeffs
    contA :: Spray a
contA   = Spray a -> Spray a
content Spray a
sprayA
    contB :: Spray a
contB   = Spray a -> Spray a
content Spray a
sprayB
    d :: Spray a
d       = Spray a -> Spray a -> Spray a
gcdKX1dotsXm Spray a
contA Spray a
contB 
    sprayA' :: Spray a
sprayA' = Spray a -> Spray a -> Spray a
exactDivisionBy Spray a
contA Spray a
sprayA 
    sprayB' :: Spray a
sprayB' = Spray a -> Spray a -> Spray a
exactDivisionBy Spray a
contB Spray a
sprayB 
    go :: Spray a -> Spray a -> Spray a -> Spray a -> Spray a
    go :: Spray a -> Spray a -> Spray a -> Spray a -> Spray a
go Spray a
sprayA'' Spray a
sprayB'' Spray a
g Spray a
h 
      | Spray a
sprayR Spray a -> Spray a -> Bool
forall a. Eq a => a -> a -> Bool
== Spray a
forall a. (Eq a, C a) => Spray a
zeroSpray           = Spray a
d Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a -> Spray a
reduceSpray Spray a
sprayB''
      | Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
sprayR Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Spray a
d
      | Bool
otherwise = Spray a -> Spray a -> Spray a -> Spray a -> Spray a
go Spray a
sprayB'' 
                       (Spray a -> Spray a -> Spray a
exactDivisionBy (Spray a
g Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
hSpray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
delta) Spray a
sprayR)
                       Spray a
ellA''
                       (Spray a -> Spray a -> Spray a
exactDivisionBy (Spray a
hSpray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
delta) (Spray a
h Spray a -> Spray a -> Spray a
forall a. (C a, Eq a) => Spray a -> Spray a -> Spray a
^*^ Spray a
gSpray a -> Int -> Spray a
forall a. (C a, Eq a) => Spray a -> Int -> Spray a
^**^Int
delta))
        where
          (Spray a
_, (Spray a
_, Spray a
sprayR)) = Int -> Spray a -> Spray a -> (Spray a, (Spray a, Spray a))
forall a.
(Eq a, C a) =>
Int -> Spray a -> Spray a -> (Spray a, (Spray a, Spray a))
pseudoDivision Int
n' Spray a
sprayA'' Spray a
sprayB''
          (Int
degA'', Spray a
ellA'') = Int -> Spray a -> (Int, Spray a)
forall a. (Eq a, C a) => Int -> Spray a -> (Int, Spray a)
degreeAndLeadingCoefficient Int
n' Spray a
sprayA''
          degB'' :: Int
degB''           = Int -> Spray a -> Int
forall a. (Eq a, C a) => Int -> Spray a -> Int
degree Int
n' Spray a
sprayB'' 
          delta :: Int
delta            = Int
degA'' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
degB''

-- | Greatest common divisor of two sprays with coefficients in a field

gcdSpray :: forall a. (Eq a, AlgField.C a) => Spray a -> Spray a -> Spray a
gcdSpray :: forall a. (Eq a, C a) => Spray a -> Spray a -> Spray a
gcdSpray Spray a
sprayA Spray a
sprayB = Int -> Spray a -> Spray a -> Spray a
forall a. (Eq a, C a) => Int -> Spray a -> Spray a -> Spray a
gcdKX1dotsXn Int
n Spray a
sprayA Spray a
sprayB 
  where
    n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
sprayA) (Spray a -> Int
forall a. Spray a -> Int
numberOfVariables Spray a
sprayB)