-- | The umbral formula for the open CSM classes.
--
-- The formula is the following:
--
-- > A(mu)    = 1 / aut(mu) * prod_i Theta(mu_i)
-- > Theta(p) = ( (1 + beta*s) (alpha+t)^p - (1 + alpha*s) (beta+t)^p ) / ( alpha - beta )
--
-- and the umbral subtitution resulting in the CSM class (at least for @length(mu)>=3@) is:
--
-- > t^j  ->  P_j(m)
-- > s^k  ->  (n-3)(n-3-1)(...n-3-k+1) * Q(n-3-k)
--
-- Note that Theta(p) is actually a (symmetric) polynomial in @alpha@ and @beta@; furthermore
-- it's linear in s and degree p in t. 

{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-}
module Math.RootLoci.CSM.Equivariant.Umbral where

--------------------------------------------------------------------------------

-- Semigroup became a superclass of Monoid
#if MIN_VERSION_base(4,11,0)     
import Data.Foldable
import Data.Semigroup
#endif

import Math.Combinat.Classes
import Math.Combinat.Numbers
import Math.Combinat.Partitions.Integer

import Data.Array.IArray

import qualified Data.Set as Set

import Math.RootLoci.Algebra
import Math.RootLoci.Geometry
import Math.RootLoci.Misc

import Math.Algebra.Polynomial.Misc ( IsSigned(..) ) 
import Math.Algebra.Polynomial.Pretty

import qualified Math.Algebra.Polynomial.FreeModule as ZMod

import Math.RootLoci.CSM.Equivariant.PushForward ( tau , piStarTableAff , piStarTableProj )
import Math.RootLoci.CSM.Equivariant.Ordered     ( formulaQPoly )

import qualified Math.RootLoci.CSM.Equivariant.Direct as Direct

--------------------------------------------------------------------------------
-- * The umbral variables

-- | A monomial @s^k * t^j@
data ST 
  = ST !Int !Int
  deriving (ST -> ST -> Bool
(ST -> ST -> Bool) -> (ST -> ST -> Bool) -> Eq ST
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ST -> ST -> Bool
$c/= :: ST -> ST -> Bool
== :: ST -> ST -> Bool
$c== :: ST -> ST -> Bool
Eq,Eq ST
Eq ST
-> (ST -> ST -> Ordering)
-> (ST -> ST -> Bool)
-> (ST -> ST -> Bool)
-> (ST -> ST -> Bool)
-> (ST -> ST -> Bool)
-> (ST -> ST -> ST)
-> (ST -> ST -> ST)
-> Ord ST
ST -> ST -> Bool
ST -> ST -> Ordering
ST -> ST -> ST
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ST -> ST -> ST
$cmin :: ST -> ST -> ST
max :: ST -> ST -> ST
$cmax :: ST -> ST -> ST
>= :: ST -> ST -> Bool
$c>= :: ST -> ST -> Bool
> :: ST -> ST -> Bool
$c> :: ST -> ST -> Bool
<= :: ST -> ST -> Bool
$c<= :: ST -> ST -> Bool
< :: ST -> ST -> Bool
$c< :: ST -> ST -> Bool
compare :: ST -> ST -> Ordering
$ccompare :: ST -> ST -> Ordering
$cp1Ord :: Eq ST
Ord,Int -> ST -> ShowS
[ST] -> ShowS
ST -> String
(Int -> ST -> ShowS)
-> (ST -> String) -> ([ST] -> ShowS) -> Show ST
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ST] -> ShowS
$cshowList :: [ST] -> ShowS
show :: ST -> String
$cshow :: ST -> String
showsPrec :: Int -> ST -> ShowS
$cshowsPrec :: Int -> ST -> ShowS
Show)

-- Semigroup became a superclass of Monoid
#if MIN_VERSION_base(4,11,0)     

instance Semigroup ST where
  (ST Int
s1 Int
t1) <> :: ST -> ST -> ST
<> (ST Int
s2 Int
t2) = Int -> Int -> ST
ST (Int
s1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s2) (Int
t1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
t2)

instance Monoid ST where
  mempty :: ST
mempty = Int -> Int -> ST
ST Int
0 Int
0 

#else

instance Monoid ST where
  mempty = ST 0 0 
  (ST s1 t1) `mappend` (ST s2 t2) = ST (s1+s2) (t1+t2)

#endif

instance Pretty ST where
  pretty :: ST -> String
pretty ST
st = case ST
st of
    ST Int
0 Int
0 -> String
"" 
    ST Int
e Int
0 -> String -> Int -> String
showVarPower String
"s" Int
e
    ST Int
0 Int
f -> String -> Int -> String
showVarPower String
"t" Int
f
    ST Int
e Int
f -> String -> Int -> String
showVarPower String
"s" Int
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Int -> String
showVarPower String
"t" Int
f

prettyMixedST :: forall b c. (Pretty b, Num c, Eq c, IsSigned c, Pretty c) => FreeMod (FreeMod c b) ST -> String
prettyMixedST :: FreeMod (FreeMod c b) ST -> String
prettyMixedST = (FreeMod c b -> String)
-> (ST -> String) -> FreeMod (FreeMod c b) ST -> String
forall c b. (c -> String) -> (b -> String) -> FreeMod c b -> String
prettyFreeMod'' FreeMod c b -> String
prettyInner ST -> String
forall a. Pretty a => a -> String
pretty where

  prettyInner :: FreeMod c b -> String
  prettyInner :: FreeMod c b -> String
prettyInner = ShowS
paren ShowS -> (FreeMod c b -> String) -> FreeMod c b -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeMod c b -> String
forall a. Pretty a => a -> String
pretty

--------------------------------------------------------------------------------
-- * The umbral formula

-- | @Theta(p)@ is defined by the formula
--
-- > Theta(p) = ( (1 + beta*s) (alpha+t)^p - (1 + alpha*s) (beta+t)^p ) / ( alpha - beta )
--
-- This is actually a polynomial in @alpha@,@beta@,@s@,@t@, also symmetric in @alpha@ and @beta@
--
theta :: ChernBase base => Int -> FreeMod (ZMod base) ST
theta :: Int -> FreeMod (ZMod base) ST
theta Int
p 
  | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1    = [(ST, ZMod base)] -> FreeMod (ZMod base) ST
forall c b. (Eq c, Num c, Ord b) => [(b, c)] -> FreeMod c b
ZMod.fromList ([(ST, ZMod base)]
term0 [(ST, ZMod base)] -> [(ST, ZMod base)] -> [(ST, ZMod base)]
forall a. [a] -> [a] -> [a]
++ [(ST, ZMod base)]
term1) 
  | Bool
otherwise = String -> FreeMod (ZMod base) ST
forall a. HasCallStack => String -> a
error String
"theta: non-positive input"
  where
 
    term0 :: [(ST, ZMod base)]
term0 =  [ (Int -> Int -> ST
ST Int
0 Int
i , Integer -> ZMod base -> ZMod base
forall b c. (Ord b, Eq c, Num c) => c -> FreeMod c b -> FreeMod c b
ZMod.scale (Int -> Int -> Integer
forall a. Integral a => a -> a -> Integer
binomial Int
p Int
i) (                           Int -> ZMod base
forall base. ChernBase base => Int -> ZMod base
tau (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) ) | Int
i<-[Int
0..Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
    term1 :: [(ST, ZMod base)]
term1 =  [ (Int -> Int -> ST
ST Int
1 Int
i , Integer -> ZMod base -> ZMod base
forall b c. (Ord b, Eq c, Num c) => c -> FreeMod c b -> FreeMod c b
ZMod.scale (Int -> Int -> Integer
forall a. Integral a => a -> a -> Integer
binomial Int
p Int
i) (base -> ZMod base -> ZMod base
forall c b.
(Eq c, Num c, Ord b, Monoid b) =>
b -> FreeMod c b -> FreeMod c b
ZMod.mulByMonom base
c2_monom (ZMod base -> ZMod base) -> ZMod base -> ZMod base
forall a b. (a -> b) -> a -> b
$ Int -> ZMod base
forall base. ChernBase base => Int -> ZMod base
tau (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)) ) | Int
i<-[Int
0..Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2] ] 
          [(ST, ZMod base)] -> [(ST, ZMod base)] -> [(ST, ZMod base)]
forall a. [a] -> [a] -> [a]
++ [ (Int -> Int -> ST
ST Int
1 Int
p , Integer -> ZMod base
forall b c. (Monoid b, Eq c, Num c) => c -> FreeMod c b
ZMod.konst (-Integer
1) ) ]

    c2_monom :: base
c2_monom = (AB, Chern) -> ChernBase base => base
forall base. (AB, Chern) -> ChernBase base => base
select0 (AB
alphaBeta,Chern
c2)

-- | Same as 'theta' but with rational coefficients
thetaQ :: ChernBase b => Int -> FreeMod (QMod b) ST
thetaQ :: Int -> FreeMod (QMod b) ST
thetaQ Int
p = (FreeMod Integer b -> QMod b)
-> FreeMod (FreeMod Integer b) ST -> FreeMod (QMod b) ST
forall b c2 c1.
(Ord b, Eq c2, Num c2) =>
(c1 -> c2) -> FreeMod c1 b -> FreeMod c2 b
ZMod.mapCoeff ((Integer -> Rational) -> FreeMod Integer b -> QMod b
forall b c2 c1.
(Ord b, Eq c2, Num c2) =>
(c1 -> c2) -> FreeMod c1 b -> FreeMod c2 b
ZMod.mapCoeff Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Int -> FreeMod (FreeMod Integer b) ST
forall base. ChernBase base => Int -> FreeMod (ZMod base) ST
theta Int
p)

-------------------------------------------------------------------------------- 

-- | This is just @prod_i Theta_{mu_i}@
integralUmbralFormula :: ChernBase base => Partition -> FreeMod (ZMod base) ST 
integralUmbralFormula :: Partition -> FreeMod (ZMod base) ST
integralUmbralFormula (Partition [Int]
ps) = [FreeMod (ZMod base) ST] -> FreeMod (ZMod base) ST
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
[FreeMod c b] -> FreeMod c b
ZMod.product [ Int -> FreeMod (ZMod base) ST
forall base. ChernBase base => Int -> FreeMod (ZMod base) ST
theta Int
p | Int
p <- [Int]
ps ]

-- | This is @1/aut(mu) * prod_i Theta_{mu_i}@
umbralFormula :: ChernBase base => Partition -> FreeMod (QMod base) ST 
umbralFormula :: Partition -> FreeMod (QMod base) ST
umbralFormula mu :: Partition
mu@(Partition [Int]
ps) = FreeMod (QMod base) ST
result where
 
  result :: FreeMod (QMod base) ST
result = (QMod base -> QMod base)
-> FreeMod (QMod base) ST -> FreeMod (QMod base) ST
forall b c2 c1.
(Ord b, Eq c2, Num c2) =>
(c1 -> c2) -> FreeMod c1 b -> FreeMod c2 b
ZMod.mapCoeff (Rational -> QMod base -> QMod base
forall b c. (Ord b, Eq c, Num c) => c -> FreeMod c b -> FreeMod c b
ZMod.scale (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
autmu))
         (FreeMod (QMod base) ST -> FreeMod (QMod base) ST)
-> FreeMod (QMod base) ST -> FreeMod (QMod base) ST
forall a b. (a -> b) -> a -> b
$ [FreeMod (QMod base) ST] -> FreeMod (QMod base) ST
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
[FreeMod c b] -> FreeMod c b
ZMod.product [ Int -> FreeMod (QMod base) ST
forall b. ChernBase b => Int -> FreeMod (QMod b) ST
thetaQ Int
p | Int
p <- [Int]
ps ]

  autmu :: Rational
  autmu :: Rational
autmu = Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Partition -> Integer
aut Partition
mu)

--------------------------------------------------------------------------------
-- * The affine CSM

-- | Weights of the representation @Sym^m C^2@
affineWeights :: Int -> [ZMod AB]
affineWeights :: Int -> [ZMod AB]
affineWeights Int
m = 
  [ [(AB, Integer)] -> ZMod AB
forall c b. (Eq c, Num c, Ord b) => [(b, c)] -> FreeMod c b
ZMod.fromList [ ( Int -> Int -> AB
AB Int
1 Int
0 , Int -> Integer
fi (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j) ) , ( Int -> Int -> AB
AB Int
0 Int
1 , Int -> Integer
fi Int
j ) ]
  | Int
j <- [Int
0..Int
m]
  ]
  where
    fi :: Int -> Integer
    fi :: Int -> Integer
fi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | The top Chern class of the representation is just the product of weights.
-- This represents the zero orbit, and we need to add this to the closure in the
-- affine case!
topChernClass :: ChernBase base => Int -> ZMod base
topChernClass :: Int -> ZMod base
topChernClass Int
m = (ZMod AB, FreeMod Integer Chern) -> ChernBase base => ZMod base
forall (f :: * -> *) base.
(f AB, f Chern) -> ChernBase base => f base
select1 (ZMod AB
total , ZMod AB -> FreeMod Integer Chern
abToChern ZMod AB
total) where
  total :: ZMod AB
total = [ZMod AB] -> ZMod AB
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [ ZMod AB
w | ZMod AB
w <- Int -> [ZMod AB]
affineWeights Int
m ]

--------------------------------------------------------------------------------

-- | The polynomial to be substituted in the place of @s^k*t^j@:
--
-- > s^k*t^j  ->  P_j(m) * Q_k(n-3-k) * (n-3)_k
--
-- where @n = length(mu)@ and @m = weight(mu)@.
--
umbralSubstPolyAff :: ChernBase base => Partition -> ST -> ZMod base
umbralSubstPolyAff :: Partition -> ST -> ZMod base
umbralSubstPolyAff Partition
part = ST -> ZMod base
fun where

  n :: Int
n = Partition -> Int
forall a. HasNumberOfParts a => a -> Int
numberOfParts Partition
part
  m :: Int
m = Partition -> Int
forall a. HasWeight a => a -> Int
weight Partition
part
  tablePPoly :: Array Int (ZMod base)
tablePPoly = Int -> Array Int (ZMod base)
forall base. ChernBase base => Int -> Array Int (ZMod base)
piStarTableAff Int
m

  fun :: ST -> ZMod base
fun (ST Int
k Int
j) 
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int
3 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m  = Integer -> ZMod base -> ZMod base
forall b c. (Ord b, Eq c, Num c) => c -> FreeMod c b -> FreeMod c b
ZMod.scale Integer
falling (ZMod base
qpoly ZMod base -> ZMod base -> ZMod base
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
FreeMod c b -> FreeMod c b -> FreeMod c b
`ZMod.mul` ZMod base
ppoly)
    | Bool
otherwise                                = ZMod base
forall c b. FreeMod c b
ZMod.zero
    where
      falling :: Integer
      falling :: Integer
falling = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) | Int
i<-[Int
0..Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]

      qpoly :: ZMod base
qpoly   = Int -> ZMod base
forall base. ChernBase base => Int -> ZMod base
formulaQPoly (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k)
      ppoly :: ZMod base
ppoly   = Array Int (ZMod base)
tablePPoly Array Int (ZMod base) -> Int -> ZMod base
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
j

-- | The (affine) umbral substitution
umbralSubstitutionAff :: (ChernBase base) => Partition -> FreeMod (ZMod base) ST -> ZMod base
umbralSubstitutionAff :: Partition -> FreeMod (ZMod base) ST -> ZMod base
umbralSubstitutionAff Partition
part FreeMod (ZMod base) ST
input = ZMod base
output where

  output :: ZMod base
output   = [ZMod base] -> ZMod base
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ ZMod base
ab ZMod base -> ZMod base -> ZMod base
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
FreeMod c b -> FreeMod c b -> FreeMod c b
`ZMod.mul` (ST -> ZMod base
substfun ST
st) | (ST
st,ZMod base
ab) <- FreeMod (ZMod base) ST -> [(ST, ZMod base)]
forall c b. FreeMod c b -> [(b, c)]
ZMod.toList FreeMod (ZMod base) ST
input ]
  substfun :: ST -> ZMod base
substfun = Partition -> ST -> ZMod base
forall base. ChernBase base => Partition -> ST -> ZMod base
umbralSubstPolyAff Partition
part

-- | CSM of the open stratums from the umbral the formula
umbralAffOpenCSM :: ChernBase base => Partition -> ZMod base   
umbralAffOpenCSM :: Partition -> ZMod base
umbralAffOpenCSM = (forall base. ChernBase base => Partition -> FreeMod Integer base)
-> forall base. ChernBase base => Partition -> FreeMod Integer base
forall key (f :: * -> *).
CacheKey key =>
(forall base. ChernBase base => key -> f base)
-> forall base. ChernBase base => key -> f base
polyCache1 forall base. ChernBase base => Partition -> FreeMod Integer base
calc where

  -- the current umbral formula only works for @n >= 3@ ??
  calc :: Partition -> ZMod base
calc Partition
mu 
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3     = ZMod (Gam base) -> ZMod base
forall base. Ord base => ZMod (Gam base) -> ZMod base
forgetGamma (Partition -> ZMod (Gam base)
forall base. ChernBase base => Partition -> ZMod (Gam base)
Direct.directOpenCSM Partition
mu)
    | Bool
otherwise = Integer -> ZMod base -> ZMod base
forall b c.
(Ord b, Eq c, Integral c, Show c) =>
c -> FreeMod c b -> FreeMod c b
ZMod.divideByConst (Partition -> Integer
aut Partition
mu)
                (ZMod base -> ZMod base) -> ZMod base -> ZMod base
forall a b. (a -> b) -> a -> b
$ Partition -> FreeMod (ZMod base) ST -> ZMod base
forall base.
ChernBase base =>
Partition -> FreeMod (ZMod base) ST -> ZMod base
umbralSubstitutionAff Partition
mu
                (FreeMod (ZMod base) ST -> ZMod base)
-> FreeMod (ZMod base) ST -> ZMod base
forall a b. (a -> b) -> a -> b
$ Partition -> FreeMod (ZMod base) ST
forall base. ChernBase base => Partition -> FreeMod (ZMod base) ST
integralUmbralFormula Partition
mu
    where
      n :: Int
n = Partition -> Int
forall a. HasNumberOfParts a => a -> Int
numberOfParts Partition
mu

--------------------------------------------------------------------------------

-- | CSM class of the zero orbit (which is just the top Chern class)
affineZeroCSM :: ChernBase base => Int -> ZMod base
affineZeroCSM :: Int -> ZMod base
affineZeroCSM Int
m = Int -> ZMod base
forall base. ChernBase base => Int -> ZMod base
topChernClass Int
m

-- | Sum over the strata in the closure (including the zero orbit!)
umbralAffClosedCSM :: ChernBase base => Partition -> ZMod base   
umbralAffClosedCSM :: Partition -> ZMod base
umbralAffClosedCSM = (forall base. ChernBase base => Partition -> FreeMod Integer base)
-> forall base. ChernBase base => Partition -> FreeMod Integer base
forall key (f :: * -> *).
CacheKey key =>
(forall base. ChernBase base => key -> f base)
-> forall base. ChernBase base => key -> f base
polyCache1 forall base. ChernBase base => Partition -> FreeMod Integer base
calc where
  
  calc :: ChernBase base => Partition -> ZMod base
  calc :: Partition -> ZMod base
calc Partition
part = Int -> ZMod base
forall base. ChernBase base => Int -> ZMod base
affineZeroCSM (Partition -> Int
forall a. HasWeight a => a -> Int
weight Partition
part)
            ZMod base -> ZMod base -> ZMod base
forall a. Num a => a -> a -> a
+ [ZMod base] -> ZMod base
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ Partition -> ZMod base
forall base. ChernBase base => Partition -> FreeMod Integer base
umbralAffOpenCSM Partition
q | Partition
q <- Set Partition -> [Partition]
forall a. Set a -> [a]
Set.toList (Partition -> Set Partition
closureSet Partition
part) ] 

--------------------------------------------------------------------------------
-- * The projective CSM

-- | The polynomial to be substituted in the place of @s^k*t^j@:
--
-- > s^k*t^j  ->  P_j(m) * Q_k(n-3-k) * (n-3)_k
--
-- where @n = length(mu)@ and @m = weight(mu)@.
--
umbralSubstPolyProj :: forall base. ChernBase base => Partition -> ST -> ZMod (Gam base)
umbralSubstPolyProj :: Partition -> ST -> ZMod (Gam base)
umbralSubstPolyProj Partition
part = ST -> ZMod (Gam base)
fun where

  n :: Int
n = Partition -> Int
forall a. HasNumberOfParts a => a -> Int
numberOfParts Partition
part
  m :: Int
m = Partition -> Int
forall a. HasWeight a => a -> Int
weight Partition
part
  tablePPoly :: Array Int (ZMod (Gam base))
tablePPoly = Int -> Array Int (ZMod (Gam base))
forall base. ChernBase base => Int -> Array Int (ZMod (Gam base))
piStarTableProj Int
m

  fun :: ST -> ZMod (Gam base)
fun (ST Int
k Int
j) 
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int
3 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m  = Integer -> ZMod (Gam base) -> ZMod (Gam base)
forall b c. (Ord b, Eq c, Num c) => c -> FreeMod c b -> FreeMod c b
ZMod.scale Integer
falling (ZMod (Gam base)
qpoly ZMod (Gam base) -> ZMod (Gam base) -> ZMod (Gam base)
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
FreeMod c b -> FreeMod c b -> FreeMod c b
`ZMod.mul` ZMod (Gam base)
ppoly)
    | Bool
otherwise                                = ZMod (Gam base)
forall c b. FreeMod c b
ZMod.zero
    where
      falling :: Integer
      falling :: Integer
falling = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) | Int
i<-[Int
0..Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]

      qpoly :: ZMod (Gam base)
qpoly   = ZMod base -> ZMod (Gam base)
forall (f :: * -> *) base.
(Equivariant f, ChernBase base, Ord (f base)) =>
ZMod base -> ZMod (f base)
injectZMod (Int -> ZMod base
forall base. ChernBase base => Int -> ZMod base
formulaQPoly (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k)) :: ZMod (Gam base)
      ppoly :: ZMod (Gam base)
ppoly   = Array Int (ZMod (Gam base))
tablePPoly Array Int (ZMod (Gam base)) -> Int -> ZMod (Gam base)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
j                    :: ZMod (Gam base)


-- | The (projective) umbral substitution
umbralSubstitutionProj :: (ChernBase base) => Partition -> FreeMod (ZMod base) ST -> ZMod (Gam base)
umbralSubstitutionProj :: Partition -> FreeMod (ZMod base) ST -> ZMod (Gam base)
umbralSubstitutionProj Partition
part FreeMod (ZMod base) ST
input = ZMod (Gam base)
output where

  output :: ZMod (Gam base)
output   = [ZMod (Gam base)] -> ZMod (Gam base)
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ ZMod base -> ZMod (Gam base)
forall (f :: * -> *) base.
(Equivariant f, ChernBase base, Ord (f base)) =>
ZMod base -> ZMod (f base)
injectZMod ZMod base
ab ZMod (Gam base) -> ZMod (Gam base) -> ZMod (Gam base)
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
FreeMod c b -> FreeMod c b -> FreeMod c b
`ZMod.mul` (ST -> ZMod (Gam base)
substfun ST
st) | (ST
st,ZMod base
ab) <- FreeMod (ZMod base) ST -> [(ST, ZMod base)]
forall c b. FreeMod c b -> [(b, c)]
ZMod.toList FreeMod (ZMod base) ST
input ]
  substfun :: ST -> ZMod (Gam base)
substfun = Partition -> ST -> ZMod (Gam base)
forall base. ChernBase base => Partition -> ST -> ZMod (Gam base)
umbralSubstPolyProj Partition
part

-- | CSM of the open stratums from the umbral the formula (for @length(mu) >= 3@)
umbralOpenCSM :: ChernBase base => Partition -> ZMod (Gam base)
umbralOpenCSM :: Partition -> ZMod (Gam base)
umbralOpenCSM = (forall base. ChernBase base => Partition -> ZMod (Gam base))
-> forall base. ChernBase base => Partition -> ZMod (Gam base)
forall key (f :: * -> *) (g :: * -> *).
CacheKey key =>
(forall base. ChernBase base => key -> f (g base))
-> forall base. ChernBase base => key -> f (g base)
polyCache2 forall base. ChernBase base => Partition -> ZMod (Gam base)
calc where

  -- the current umbral formula only works for @n >= 3@ ??
  calc :: Partition -> ZMod (Gam base)
calc Partition
mu 
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3     = Partition -> ZMod (Gam base)
forall base. ChernBase base => Partition -> ZMod (Gam base)
Direct.directOpenCSM Partition
mu     
    | Bool
otherwise = Integer -> ZMod (Gam base) -> ZMod (Gam base)
forall b c.
(Ord b, Eq c, Integral c, Show c) =>
c -> FreeMod c b -> FreeMod c b
ZMod.divideByConst (Partition -> Integer
aut Partition
mu)
                (ZMod (Gam base) -> ZMod (Gam base))
-> ZMod (Gam base) -> ZMod (Gam base)
forall a b. (a -> b) -> a -> b
$ Partition -> FreeMod (ZMod base) ST -> ZMod (Gam base)
forall base.
ChernBase base =>
Partition -> FreeMod (ZMod base) ST -> ZMod (Gam base)
umbralSubstitutionProj Partition
mu
                (FreeMod (ZMod base) ST -> ZMod (Gam base))
-> FreeMod (ZMod base) ST -> ZMod (Gam base)
forall a b. (a -> b) -> a -> b
$ Partition -> FreeMod (ZMod base) ST
forall base. ChernBase base => Partition -> FreeMod (ZMod base) ST
integralUmbralFormula Partition
mu
    where
      n :: Int
n = Partition -> Int
forall a. HasNumberOfParts a => a -> Int
numberOfParts Partition
mu

-- | Sum over the strata in the closure
umbralClosedCSM :: ChernBase base => Partition -> ZMod (Gam base)
umbralClosedCSM :: Partition -> ZMod (Gam base)
umbralClosedCSM = (forall base. ChernBase base => Partition -> ZMod (Gam base))
-> forall base. ChernBase base => Partition -> ZMod (Gam base)
forall key (f :: * -> *) (g :: * -> *).
CacheKey key =>
(forall base. ChernBase base => key -> f (g base))
-> forall base. ChernBase base => key -> f (g base)
polyCache2 forall base. ChernBase base => Partition -> ZMod (Gam base)
calc where
  
  calc :: ChernBase base => Partition -> ZMod (Gam base)
  calc :: Partition -> ZMod (Gam base)
calc Partition
part = [ZMod (Gam base)] -> ZMod (Gam base)
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ Partition -> ZMod (Gam base)
forall base. ChernBase base => Partition -> ZMod (Gam base)
umbralOpenCSM Partition
q | Partition
q <- Set Partition -> [Partition]
forall a. Set a -> [a]
Set.toList (Partition -> Set Partition
closureSet Partition
part) ] 

--------------------------------------------------------------------------------