{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Math.Algebra.Hspray
(
Powers (..)
, Spray
, Monomial
, lone
, unitSpray
, zeroSpray
, constantSpray
, (*^)
, (.^)
, (^+^)
, (^-^)
, (^*^)
, (^**^)
, prettySpray
, prettySpray'
, prettySprayXYZ
, getCoefficient
, sprayTerms
, evalSpray
, substituteSpray
, composeSpray
, derivSpray
, permuteVariables
, swapVariables
, sprayDivision
, groebner
, reduceGroebnerBasis
, esPolynomial
, isSymmetricSpray
, resultant
, resultant1
, subresultants
, subresultants1
, 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 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
, 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 (Empty, (:<|))
, dropWhileR
, (|>)
, (<|)
, index
, adjust
)
import Data.Text ( Text
, append
, cons
, intercalate
, pack
, snoc
, unpack
)
infixr 7 *^, .^
infixl 6 ^+^, ^-^
infixl 7 ^*^
infixr 8 ^**^
data Powers = Powers
{ Powers -> Seq Int
exponents :: Seq Int
, Powers -> Int
nvariables :: Int
}
deriving Int -> Powers -> ShowS
[Powers] -> ShowS
Powers -> String
(Int -> Powers -> ShowS)
-> (Powers -> String) -> ([Powers] -> ShowS) -> Show Powers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Powers -> ShowS
showsPrec :: Int -> Powers -> ShowS
$cshow :: Powers -> String
show :: Powers -> String
$cshowList :: [Powers] -> ShowS
showList :: [Powers] -> ShowS
Show
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
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)
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)
type Spray a = HashMap Powers a
type Monomial a = (Powers, a)
instance (AlgAdd.C a, Eq a) => AlgAdd.C (Spray a) where
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
forall k v. HashMap k v
HM.empty
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
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
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 = Int -> Spray a
forall a. C a => Int -> Spray a
lone Int
0
(^+^) :: (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
(^-^) :: (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
(^*^) :: (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
(^**^) :: (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 = [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)
(*^) :: (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
(.^) :: (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)
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)
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
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)
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
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
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
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)
derivSpray
:: (AlgRing.C a, Eq a)
=> Int
-> Spray a
-> Spray a
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' ]
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')
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' ]
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
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
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
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
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')
numberOfVariables :: Spray a -> Int
numberOfVariables :: forall a. Spray a -> Int
numberOfVariables Spray a
spray = [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
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)
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."
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
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
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. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t 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)
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
composeSpray :: (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)
forall {k}. HashMap k a -> HashMap k (Spray a)
identify Spray a
p)
where
identify :: HashMap k a -> HashMap k (Spray a)
identify = (a -> Spray a) -> HashMap k a -> HashMap k (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
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
permuteVariables :: Spray a -> [Int] -> Spray a
permuteVariables :: forall a. Spray a -> [Int] -> Spray a
permuteVariables Spray a
spray [Int]
permutation =
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)
swapVariables :: Spray a -> (Int, Int) -> Spray a
swapVariables :: forall a. Spray a -> (Int, Int) -> Spray a
swapVariables Spray a
spray (Int
i, Int
j) =
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)
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
var String -> ShowS
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)
prettySpray
:: (a -> String)
-> String
-> Spray a
-> 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' :: 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
| Bool
otherwise = String
"x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"^" String -> ShowS
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]
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
' '
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
"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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"^" String -> ShowS
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
z
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 -> 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
' '
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
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
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)
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..]
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
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
x, Int
y) -> Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y) (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 :: 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
sprayDivision :: forall a. (Eq a, AlgField.C a) => Spray a -> [Spray a] -> Spray a
sprayDivision :: forall a. (Eq a, C a) => Spray a -> [Spray a] -> Spray a
sprayDivision 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
"sprayDivision: 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
sprayDivision' :: forall a. (Eq a, AlgField.C a) => Spray a -> HashMap Int (Spray a, Monomial a) -> Spray a
sprayDivision' :: forall a.
(Eq a, C a) =>
Spray a -> HashMap Int (Spray a, Monomial a) -> Spray a
sprayDivision' 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
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
0 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2] ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
row1 [Int]
row2))
where
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
1 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
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
1 .. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
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)
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
sprayDivision' 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)
)
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 []
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
sprayDivision ([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
:: forall a. (Eq a, AlgField.C a)
=> [Spray a]
-> Bool
-> [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
permutationsBinarySequence :: Int -> Int -> [Seq Int]
permutationsBinarySequence :: Int -> Int -> [Seq Int]
permutationsBinarySequence Int
nzeros Int
nones = (Seq Bool -> Maybe (Seq Bool)) -> Seq Bool -> [Seq Int]
unfold1 Seq Bool -> Maybe (Seq Bool)
next Seq Bool
z
where
z :: Seq Bool
z = Seq Bool -> Seq Bool -> Seq Bool
forall a. Seq a -> Seq a -> Seq a
(><) (Int -> Bool -> Seq Bool
forall a. Int -> a -> Seq a
S.replicate Int
nzeros Bool
False) (Int -> Bool -> Seq Bool
forall a. Int -> a -> Seq a
S.replicate Int
nones Bool
True)
unfold1 :: (Seq Bool -> Maybe (Seq Bool)) -> Seq Bool -> [Seq Int]
unfold1 :: (Seq Bool -> Maybe (Seq Bool)) -> Seq Bool -> [Seq Int]
unfold1 Seq Bool -> Maybe (Seq Bool)
f Seq Bool
x = case Seq Bool -> Maybe (Seq Bool)
f Seq Bool
x of
Maybe (Seq Bool)
Nothing -> [Seq Int
x']
Just Seq Bool
y -> Seq Int
x' Seq Int -> [Seq Int] -> [Seq Int]
forall a. a -> [a] -> [a]
: (Seq Bool -> Maybe (Seq Bool)) -> Seq Bool -> [Seq Int]
unfold1 Seq Bool -> Maybe (Seq Bool)
f Seq Bool
y
where
x' :: Seq Int
x' = (Bool -> Int) -> Seq Bool -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Int
forall a. Enum a => a -> Int
fromEnum Seq Bool
x
next :: Seq Bool -> Maybe (Seq Bool)
next :: Seq Bool -> Maybe (Seq Bool)
next Seq Bool
xs = case (Seq Bool, Seq Bool) -> Maybe (Seq Bool, Seq Bool)
findj (Seq Bool -> Seq Bool
forall {a}. Seq a -> Seq a
S.reverse Seq Bool
xs, Seq Bool
forall a. Seq a
S.empty) of
Maybe (Seq Bool, Seq Bool)
Nothing -> Maybe (Seq Bool)
forall a. Maybe a
Nothing
Just ( Bool
l:<|Seq Bool
ls , Seq Bool
rs ) -> Seq Bool -> Maybe (Seq Bool)
forall a. a -> Maybe a
Just (Seq Bool -> Maybe (Seq Bool)) -> Seq Bool -> Maybe (Seq Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Seq Bool -> (Seq Bool, Seq Bool) -> Seq Bool
inc Bool
l Seq Bool
ls (Seq Bool -> Seq Bool
forall {a}. Seq a -> Seq a
S.reverse Seq Bool
rs, Seq Bool
forall a. Seq a
S.empty)
Just ( Seq Bool
Empty , Seq Bool
_ ) -> String -> Maybe (Seq Bool)
forall a. HasCallStack => String -> a
error String
"permutationsBinarySequence: should not happen"
findj :: (Seq Bool, Seq Bool) -> Maybe (Seq Bool, Seq Bool)
findj :: (Seq Bool, Seq Bool) -> Maybe (Seq Bool, Seq Bool)
findj ( xxs :: Seq Bool
xxs@(Bool
x:<|Seq Bool
xs), yys :: Seq Bool
yys@(Bool
_:<|Seq Bool
_) ) = if Bool
x
then (Seq Bool, Seq Bool) -> Maybe (Seq Bool, Seq Bool)
findj ( Seq Bool
xs, Bool
True Bool -> Seq Bool -> Seq Bool
forall a. a -> Seq a -> Seq a
<| Seq Bool
yys )
else (Seq Bool, Seq Bool) -> Maybe (Seq Bool, Seq Bool)
forall a. a -> Maybe a
Just ( Seq Bool
xxs, Seq Bool
yys )
findj ( Bool
x:<|Seq Bool
xs, Seq Bool
Empty ) = (Seq Bool, Seq Bool) -> Maybe (Seq Bool, Seq Bool)
findj ( Seq Bool
xs, Bool -> Seq Bool
forall a. a -> Seq a
S.singleton Bool
x )
findj ( Seq Bool
Empty , Seq Bool
_ ) = Maybe (Seq Bool, Seq Bool)
forall a. Maybe a
Nothing
inc :: Bool -> Seq Bool -> (Seq Bool, Seq Bool) -> Seq Bool
inc :: Bool -> Seq Bool -> (Seq Bool, Seq Bool) -> Seq Bool
inc !Bool
u Seq Bool
us ( Bool
x:<|Seq Bool
xs , Seq Bool
yys ) = if Bool
u
then Bool -> Seq Bool -> (Seq Bool, Seq Bool) -> Seq Bool
inc Bool
True Seq Bool
us ( Seq Bool
xs , Bool
x Bool -> Seq Bool -> Seq Bool
forall a. a -> Seq a -> Seq a
<| Seq Bool
yys )
else Seq Bool -> Seq Bool -> Seq Bool
forall a. Seq a -> Seq a -> Seq a
(><) (Seq Bool -> Seq Bool
forall {a}. Seq a -> Seq a
S.reverse (Bool
True Bool -> Seq Bool -> Seq Bool
forall a. a -> Seq a -> Seq a
<| Seq Bool
us)) (Seq Bool -> Seq Bool -> Seq Bool
forall a. Seq a -> Seq a -> Seq a
(><) (Seq Bool -> Seq Bool
forall {a}. Seq a -> Seq a
S.reverse (Bool
u Bool -> Seq Bool -> Seq Bool
forall a. a -> Seq a -> Seq a
<| Seq Bool
yys)) Seq Bool
xs)
inc Bool
_ Seq Bool
_ ( Seq Bool
Empty , Seq Bool
_ ) = String -> Seq Bool
forall a. HasCallStack => String -> a
error String
"permutationsBinarySequence: should not happen"
esPolynomial
:: (AlgRing.C a, Eq a)
=> Int
-> Int
-> 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
| 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
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]
esPolys :: [Spray a]
esPolys = (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) [Int]
indices
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]
indices
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]
esPolys [Spray a]
yPolys
gbasis :: [Spray a]
gbasis = [Spray a] -> [Spray a]
forall a. (Eq a, C a) => [Spray a] -> [Spray a]
groebner0 [Spray a]
gPolys
g :: Spray a
g = Spray a -> [Spray a] -> Spray a
forall a. (Eq a, C a) => Spray a -> [Spray a] -> Spray a
sprayDivision 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)
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
"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
g :: Spray a
g = Spray a -> [Spray a] -> Spray a
forall a. (Eq a, C a) => Spray a -> [Spray a] -> Spray a
sprayDivision 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
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
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]]
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]]
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]]
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
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 = [Spray a] -> [Spray a]
forall a. [a] -> [a]
reverse [Spray a]
sprays
where
([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
_) -> 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 (a -> Spray a
forall a. (C a, Eq a) => a -> Spray a
constantSpray a
constantTerm) IntMap (Spray a)
imap
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
0 .. [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xpows]]
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 = 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
where
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 = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
pexpnts
then [a
p0]
else a
p0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [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
1 .. [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
pexpnts]]
qcoeffs :: [a]
qcoeffs = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
qexpnts
then [a
q0]
else a
q0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [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
1 .. [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
qexpnts]]
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 = (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]
where
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 = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
pexpnts
then [a
p0]
else a
p0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [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
1 .. [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
pexpnts]]
qcoeffs :: [a]
qcoeffs = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ if [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
qexpnts
then [a
q0]
else a
q0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [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
1 .. [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 :: (Eq a, AlgRing.C a)
=> Int
-> 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 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')
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
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]
p' :: Spray a
p' = Spray a -> [Int] -> Spray a
forall a. Spray a -> [Int] -> Spray a
permuteVariables Spray a
p [Int]
permutation
q' :: Spray a
q' = Spray a -> [Int] -> Spray a
forall a. Spray a -> [Int] -> Spray a
permuteVariables Spray a
q [Int]
permutation
subresultants :: (Eq a, AlgRing.C a)
=> Int
-> 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 (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]
p' :: Spray a
p' = Spray a -> [Int] -> Spray a
forall a. Spray a -> [Int] -> Spray a
permuteVariables Spray a
p [Int]
permutation
q' :: Spray a
q' = Spray a -> [Int] -> Spray a
forall a. Spray a -> [Int] -> Spray a
permuteVariables Spray a
q [Int]
permutation