-- | Compute the pushforward maps @pi_*@ and @delta_*@ between the
-- @GL2@-equivariant cohomology rings
--
-- Recall that:
--
-- * @Delta_nu : Q^d -> Q^n@
--
-- * @pi : Q^n -> P^n@
--
-- and @Q^n = P^1 x P^1 x ... x P^1@.
--  

{-# LANGUAGE 
      BangPatterns, TypeSynonymInstances, FlexibleInstances, FlexibleContexts,
      ScopedTypeVariables, TypeFamilies 
  #-}

module Math.RootLoci.CSM.Equivariant.PushForward 
  ( -- * The function tau
    tau , tauEta
    -- * pushforward along the diagonal map @Delta_{nu} : Q^d -> Q^n@
  , delta_star_ , delta_star , delta_star' 
    -- * pushforward along the order-forgetting map @pi : Q^n -> P^n@
  , pi_star_table
  , compute_pi_star
  , pi_star
    -- * Fibonacci-type recursion formula for @pi_*@
  , piStarTableAff 
  , piStarTableProj
  )
  where

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

import Math.Combinat.Numbers
import Math.Combinat.Sign
import Math.Combinat.Partitions.Integer
import Math.Combinat.Partitions.Set
import Math.Combinat.Sets
import Math.Combinat.Tuples

import Data.Array (Array)
import Data.Array.IArray

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

import qualified Math.Algebra.Polynomial.FreeModule as ZMod

--------------------------------------------------------------------------------
-- * The function tau

-- | @tau_k := ( a^(k+1) - b^(k+1) ) / ( a - b )@
tau :: ChernBase base => Int -> ZMod base
tau :: Int -> ZMod base
tau Int
k = (FreeMod Integer AB, FreeMod Integer Chern)
-> ChernBase base => ZMod base
forall (f :: * -> *) base.
(f AB, f Chern) -> ChernBase base => f base
select1 ( Int -> FreeMod Integer AB
tauAB Int
k , Int -> FreeMod Integer Chern
tauChern Int
k ) 

-- | In chern classes, the coefficients of tau are (signed) binomial coefficients; cf. A011973
tauChern :: Int -> ZMod Chern
tauChern :: Int -> FreeMod Integer Chern
tauChern Int
k 
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  -Int
1    = [Char] -> FreeMod Integer Chern
forall a. HasCallStack => [Char] -> a
error [Char]
"tau: negative index is not implemented"
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1    = FreeMod Integer Chern
forall c b. FreeMod c b
ZMod.zero 
  | Bool
otherwise  = [(Chern, Integer)] -> FreeMod Integer Chern
forall c b. (Eq c, Num c, Ord b) => [(b, c)] -> FreeMod c b
ZMod.fromList [ ( Int -> Int -> Chern
Chern (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
j) Int
j , Int -> Integer -> Integer
forall a b. (Integral a, Num b) => a -> b -> b
negateIfOdd Int
j (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Integer
forall a. Integral a => a -> a -> Integer
binomial (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j) Int
j )  | Int
j<-[Int
0..Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
k Int
2] ]

tauChernUnsafe :: Int -> ZMod Chern
tauChernUnsafe :: Int -> FreeMod Integer Chern
tauChernUnsafe = (Int -> FreeMod Integer Chern) -> Int -> FreeMod Integer Chern
forall a. (Int -> a) -> Int -> a
icache ((Int -> FreeMod Integer Chern) -> Int -> FreeMod Integer Chern)
-> (Int -> FreeMod Integer Chern) -> Int -> FreeMod Integer Chern
forall a b. (a -> b) -> a -> b
$ \Int
k -> FreeMod Integer AB -> FreeMod Integer Chern
abToChern (Int -> FreeMod Integer AB
tauAB Int
k)

tauAB :: Int -> ZMod AB
tauAB :: Int -> FreeMod Integer AB
tauAB Int
k 
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  -Int
1   = [Char] -> FreeMod Integer AB
forall a. HasCallStack => [Char] -> a
error [Char]
"tau: negative index is not implemented"
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1   = FreeMod Integer AB
forall c b. FreeMod c b
ZMod.zero
  | Bool
otherwise = [(AB, Integer)] -> FreeMod Integer AB
forall c b. (Eq c, Num c, Ord b) => [(b, c)] -> FreeMod c b
ZMod.fromList [ (Int -> Int -> AB
AB Int
j (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j) , Integer
1) | Int
j <- [Int
0..Int
k] ]

tauEta :: ChernBase base => Int -> ZMod (Eta base)
tauEta :: Int -> ZMod (Eta base)
tauEta Int
k = ZMod base -> ZMod (Eta 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
tau Int
k)

--------------------------------------------------------------------------------
-- * @Delta_{\nu} : Q^d -> Q^n@

-- | Input: diagonal eta indices, and whether we are pushing forward 1 or the generator u/xi
delta_star_single :: ChernBase base => [Int] -> Bool -> ZMod (Eta base)
delta_star_single :: [Int] -> Bool -> ZMod (Eta base)
delta_star_single [Int]
ks Bool
xi = 
  if Bool
xi
    then ZMod (Eta base)
bbb 
    else ZMod (Eta base)
aaa 
  where
    n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ks

    aaa :: ZMod (Eta base)
aaa = [ZMod (Eta base)] -> ZMod (Eta base)
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ Int -> ZMod (Eta base)
sigma (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) ZMod (Eta base) -> ZMod (Eta base) -> ZMod (Eta base)
forall a. Num a => a -> a -> a
* (Int -> ZMod (Eta base)
forall base. ChernBase base => Int -> ZMod (Eta base)
tauEta Int
i) | Int
i<-[Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
    bbb :: ZMod (Eta base)
bbb = ZMod (Eta base)
full ZMod (Eta base) -> ZMod (Eta base) -> ZMod (Eta base)
forall a. Num a => a -> a -> a
- ZMod (Eta base)
rest

    ab :: ZMod (Eta base)
ab   = Eta base -> ZMod (Eta base)
forall c b. Num c => b -> FreeMod c b
ZMod.generator (Eta base -> ZMod (Eta base)) -> Eta base -> ZMod (Eta base)
forall a b. (a -> b) -> a -> b
$ [Int] -> base -> Eta base
forall ab. [Int] -> ab -> Eta ab
Eta [] (base -> Eta base) -> base -> Eta base
forall a b. (a -> b) -> a -> b
$ (AB, Chern) -> ChernBase base => base
forall base. (AB, Chern) -> ChernBase base => base
select0 (AB
alphaBeta, Chern
c2)
    full :: ZMod (Eta base)
full = Eta base -> ZMod (Eta base)
forall c b. Num c => b -> FreeMod c b
ZMod.generator ([Int] -> base -> Eta base
forall ab. [Int] -> ab -> Eta ab
Eta [Int]
ks base
forall a. Monoid a => a
mempty)      -- == sigma_n(eta)
    rest :: ZMod (Eta base)
rest = [ZMod (Eta base)] -> ZMod (Eta base)
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ Int -> ZMod (Eta base)
sigma (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) ZMod (Eta base) -> ZMod (Eta base) -> ZMod (Eta base)
forall a. Num a => a -> a -> a
* Int -> ZMod (Eta base)
forall base. ChernBase base => Int -> ZMod (Eta base)
tauEta (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) ZMod (Eta base) -> ZMod (Eta base) -> ZMod (Eta base)
forall a. Num a => a -> a -> a
* ZMod (Eta base)
ab | Int
i<-[Int
2..Int
n] ]

    sigma :: Int -> ZMod (Eta base)
sigma Int
k = Int -> [Eta base] -> ZMod (Eta base)
forall a. (Ord a, Monoid a) => Int -> [a] -> ZMod a
symPoly Int
k [ [Int] -> base -> Eta base
forall ab. [Int] -> ab -> Eta ab
Eta [Int
k] base
forall a. Monoid a => a
mempty | Int
k<-[Int]
ks ]
  
-- | a group generator on the left is a subset (=product) of U-s, which
-- we map to a linear combinaton of H-s
delta_star_1 :: ChernBase base => Partition -> Omega base -> ZMod (Eta base)
delta_star_1 :: Partition -> Omega base -> ZMod (Eta base)
delta_star_1 Partition
part = [[Int]] -> Omega base -> ZMod (Eta base)
forall base.
ChernBase base =>
[[Int]] -> Omega base -> ZMod (Eta base)
delta_star_1' (Partition -> [[Int]]
linearIndices Partition
part)

-- | a group generator on the left is a subset (=product) of U-s, which
-- we map to a linear combinaton of H-s
delta_star_1' :: forall base. ChernBase base => [[Int]] -> Omega base -> ZMod (Eta base)
delta_star_1' :: [[Int]] -> Omega base -> ZMod (Eta base)
delta_star_1' [[Int]]
idxtable (Omega [Int]
us base
ab) = ZMod (Eta base)
final where
  
  final :: ZMod (Eta base)
final = base -> ZMod (Eta base) -> ZMod (Eta base)
forall (f :: * -> *) ab.
(Functor f, Monoid ab, Ord (f ab)) =>
ab -> ZMod (f ab) -> ZMod (f ab)
mulInjMonom base
ab (ZMod (Eta base) -> ZMod (Eta base))
-> ZMod (Eta base) -> ZMod (Eta base)
forall a b. (a -> b) -> a -> b
$ [ZMod (Eta base)] -> ZMod (Eta base)
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
[FreeMod c b] -> FreeMod c b
ZMod.product ([ZMod (Eta base)] -> ZMod (Eta base))
-> [ZMod (Eta base)] -> ZMod (Eta base)
forall a b. (a -> b) -> a -> b
$ Int -> [[Int]] -> [ZMod (Eta base)]
go Int
1 [[Int]]
idxtable
          
  go :: Int -> [[Int]] -> [ZMod (Eta base)]
  go :: Int -> [[Int]] -> [ZMod (Eta base)]
go Int
_ []       = []
  go Int
k ([Int]
is:[[Int]]
iss) = ZMod (Eta base)
this ZMod (Eta base) -> [ZMod (Eta base)] -> [ZMod (Eta base)]
forall a. a -> [a] -> [a]
: Int -> [[Int]] -> [ZMod (Eta base)]
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [[Int]]
iss where
    this :: ZMod (Eta base)
this = [Int] -> Bool -> ZMod (Eta base)
forall base. ChernBase base => [Int] -> Bool -> ZMod (Eta base)
delta_star_single [Int]
is (Int
k Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
us)

delta_star_ :: ChernBase base => Partition -> ZMod (Omega base) -> ZMod (Eta base)
delta_star_ :: Partition -> ZMod (Omega base) -> ZMod (Eta base)
delta_star_ Partition
part = (Omega base -> ZMod (Eta base))
-> ZMod (Omega base) -> ZMod (Eta base)
forall b1 b2 c.
(Ord b1, Ord b2, Eq c, Num c) =>
(b1 -> FreeMod c b2) -> FreeMod c b1 -> FreeMod c b2
ZMod.flatMap (Partition -> Omega base -> ZMod (Eta base)
forall base.
ChernBase base =>
Partition -> Omega base -> ZMod (Eta base)
delta_star_1 Partition
part)

delta_star :: ChernBase base => SetPartition -> ZMod (Omega base) -> ZMod (Eta base)
delta_star :: SetPartition -> ZMod (Omega base) -> ZMod (Eta base)
delta_star SetPartition
setp = (Omega base -> ZMod (Eta base))
-> ZMod (Omega base) -> ZMod (Eta base)
forall b1 b2 c.
(Ord b1, Ord b2, Eq c, Num c) =>
(b1 -> FreeMod c b2) -> FreeMod c b1 -> FreeMod c b2
ZMod.flatMap ([[Int]] -> Omega base -> ZMod (Eta base)
forall base.
ChernBase base =>
[[Int]] -> Omega base -> ZMod (Eta base)
delta_star_1' (SetPartition -> [[Int]]
fromSetPartition SetPartition
setp))

-- | We can give an explicit indexing scheme (set partition), instead of the linear indexing
-- used above. This will be useful when computing the \"open\" part
delta_star' :: ChernBase base => [[Int]] -> ZMod (Omega base) -> ZMod (Eta base)
delta_star' :: [[Int]] -> ZMod (Omega base) -> ZMod (Eta base)
delta_star' [[Int]]
indices = (Omega base -> ZMod (Eta base))
-> ZMod (Omega base) -> ZMod (Eta base)
forall b1 b2 c.
(Ord b1, Ord b2, Eq c, Num c) =>
(b1 -> FreeMod c b2) -> FreeMod c b1 -> FreeMod c b2
ZMod.flatMap ([[Int]] -> Omega base -> ZMod (Eta base)
forall base.
ChernBase base =>
[[Int]] -> Omega base -> ZMod (Eta base)
delta_star_1' [[Int]]
indices)

--------------------------------------------------------------------------------
-- * @pi : Q^n -> P^n@

-- | This is upside the class where @[0:1]@ is a root with multiplicity @k@ and @[1:0]@ is a root with multiplicity l
up_root_xy :: Int -> (Int,Int) -> ZMod (Eta AB)
up_root_xy :: Int -> (Int, Int) -> ZMod (Eta AB)
up_root_xy Int
n (Int
k,Int
l) = ZMod (Eta AB)
as ZMod (Eta AB) -> ZMod (Eta AB) -> ZMod (Eta AB)
forall a. Num a => a -> a -> a
* ZMod (Eta AB)
bs where

  as :: ZMod (Eta AB)
as = [ZMod (Eta AB)] -> ZMod (Eta AB)
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
[FreeMod c b] -> FreeMod c b
ZMod.product [ Int -> Integer -> Integer -> ZMod (Eta AB)
forall c. (Eq c, Num c) => Int -> c -> c -> FreeMod c (Eta AB)
abh      Int
i  Integer
1 Integer
0 | Int
i<-[Int
1..Int
k] ]
  bs :: ZMod (Eta AB)
bs = [ZMod (Eta AB)] -> ZMod (Eta AB)
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
[FreeMod c b] -> FreeMod c b
ZMod.product [ Int -> Integer -> Integer -> ZMod (Eta AB)
forall c. (Eq c, Num c) => Int -> c -> c -> FreeMod c (Eta AB)
abh (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j) Integer
0 Integer
1 | Int
j<-[Int
1..Int
l] ]

  -- (eta_i + na*alpha + nb*beta)
  abh :: Int -> c -> c -> FreeMod c (Eta AB)
abh Int
i c
na c
nb = [(Eta AB, c)] -> FreeMod c (Eta AB)
forall c b. (Eq c, Num c, Ord b) => [(b, c)] -> FreeMod c b
ZMod.fromList 
    [ ([Int] -> AB -> Eta AB
forall ab. [Int] -> ab -> Eta ab
Eta [Int
i] (Int -> Int -> AB
AB Int
0 Int
0) , c
1 )  
    , ([Int] -> AB -> Eta AB
forall ab. [Int] -> ab -> Eta ab
Eta []  (Int -> Int -> AB
AB Int
1 Int
0) , c
na)  
    , ([Int] -> AB -> Eta AB
forall ab. [Int] -> ab -> Eta ab
Eta []  (Int -> Int -> AB
AB Int
0 Int
1) , c
nb) 
    ]

-- | This is downside the class where @[0:1]@ is a root with multiplicity @k@ and @[1:0]@ is a root with multiplicity l.
-- It should be true that @pi_* up_root_xy = down_root_xy@
down_root_xy :: Int -> (Int,Int) -> ZMod (Gam AB)
down_root_xy :: Int -> (Int, Int) -> ZMod (Gam AB)
down_root_xy Int
n (Int
k,Int
l) = ZMod (Gam AB)
as ZMod (Gam AB) -> ZMod (Gam AB) -> ZMod (Gam AB)
forall a. Num a => a -> a -> a
* ZMod (Gam AB)
bs where

  as :: ZMod (Gam AB)
as = [ZMod (Gam AB)] -> ZMod (Gam AB)
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
[FreeMod c b] -> FreeMod c b
ZMod.product [ Int -> Int -> ZMod (Gam AB)
forall a a c.
(Integral a, Integral a, Num c, Eq c) =>
a -> a -> FreeMod c (Gam AB)
abg (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) (Int
i) | Int
i<-[Int
0..Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
  bs :: ZMod (Gam AB)
bs = [ZMod (Gam AB)] -> ZMod (Gam AB)
forall b c.
(Ord b, Monoid b, Eq c, Num c) =>
[FreeMod c b] -> FreeMod c b
ZMod.product [ Int -> Int -> ZMod (Gam AB)
forall a a c.
(Integral a, Integral a, Num c, Eq c) =>
a -> a -> FreeMod c (Gam AB)
abg (Int
j) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j) | Int
j<-[Int
0..Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]

  -- (na*alpha + nb*beta + gamma)
  abg :: a -> a -> FreeMod c (Gam AB)
abg a
na a
nb = [(Gam AB, c)] -> FreeMod c (Gam AB)
forall c b. (Eq c, Num c, Ord b) => [(b, c)] -> FreeMod c b
ZMod.fromList 
    [ (Int -> AB -> Gam AB
forall ab. Int -> ab -> Gam ab
Gam Int
1 (Int -> Int -> AB
AB Int
0 Int
0) , c
1 ) 
    , (Int -> AB -> Gam AB
forall ab. Int -> ab -> Gam ab
Gam Int
0 (Int -> Int -> AB
AB Int
1 Int
0) , a -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
na) 
    , (Int -> AB -> Gam AB
forall ab. Int -> ab -> Gam ab
Gam Int
0 (Int -> Int -> AB
AB Int
0 Int
1) , a -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nb) 
    ]

pi_star_0 :: Int -> Int -> ZMod (Gam AB)
pi_star_0 :: Int -> Int -> ZMod (Gam AB)
pi_star_0 Int
n Int
k = [ZMod (Gam AB)] -> ZMod (Gam AB)
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum
  [ Integer -> ZMod (Gam AB) -> ZMod (Gam AB)
forall b c. (Ord b, Eq c, Num c) => c -> FreeMod c b -> FreeMod c b
ZMod.scale 
      (Int -> Integer -> Integer
forall a b. (Integral a, Num b) => a -> b -> b
negateIfOdd Int
i (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Integer
forall a. Integral a => a -> a -> Integer
binomial Int
k Int
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
factorial (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)) 
      (AB -> ZMod (Gam AB) -> ZMod (Gam AB)
forall (f :: * -> *).
(Functor f, Ord (f AB)) =>
AB -> ZMod (f AB) -> ZMod (f AB)
mulAB (Int -> Int -> AB
AB Int
i Int
0) (ZMod (Gam AB) -> ZMod (Gam AB)) -> ZMod (Gam AB) -> ZMod (Gam AB)
forall a b. (a -> b) -> a -> b
$ Int -> (Int, Int) -> ZMod (Gam AB)
down_root_xy Int
n (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i,Int
0)) 
  | Int
i<-[Int
0..Int
k] ]

-- | Table of @pi_*( eta_1*eta_2*...*eta_k )@, computed by breaking the symmetry.
pi_star_table :: Int -> Array Int (ZMod (Gam AB))
pi_star_table :: Int -> Array Int (ZMod (Gam AB))
pi_star_table = (Int -> Array Int (ZMod (Gam AB)))
-> Int -> Array Int (ZMod (Gam AB))
forall key a. CacheKey key => (key -> a) -> key -> a
monoCache Int -> Array Int (ZMod (Gam AB))
forall (a :: * -> * -> *).
IArray a (ZMod (Gam AB)) =>
Int -> a Int (ZMod (Gam AB))
calc where
  calc :: Int -> a Int (ZMod (Gam AB))
calc Int
n = (Int, Int) -> [ZMod (Gam AB)] -> a Int (ZMod (Gam AB))
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
n) [ Int -> Int -> ZMod (Gam AB)
pi_star_0 Int
n Int
k | Int
k<-[Int
0..Int
n] ]

-- | Slow implementation of @pi_star@, using @pi_star_table@
compute_pi_star 
  :: Int               -- ^ the number of points @m@ (recall the pi : @Q^m -> P^m@)
  -> ZMod (Eta AB) 
  -> ZMod (Gam AB)
compute_pi_star :: Int -> ZMod (Eta AB) -> ZMod (Gam AB)
compute_pi_star Int
m = (Eta AB -> ZMod (Gam AB)) -> ZMod (Eta AB) -> ZMod (Gam AB)
forall b1 b2 c.
(Ord b1, Ord b2, Eq c, Num c) =>
(b1 -> FreeMod c b2) -> FreeMod c b1 -> FreeMod c b2
ZMod.flatMap Eta AB -> ZMod (Gam AB)
f where 
  table :: Array Int (ZMod (Gam AB))
table = Int -> Array Int (ZMod (Gam AB))
pi_star_table Int
m
  f :: Eta AB -> ZMod (Gam AB)
f (Eta [Int]
hs AB
ab) = AB -> ZMod (Gam AB) -> ZMod (Gam AB)
forall (f :: * -> *).
(Functor f, Ord (f AB)) =>
AB -> ZMod (f AB) -> ZMod (f AB)
mulAB AB
ab (Array Int (ZMod (Gam AB))
table Array Int (ZMod (Gam AB)) -> Int -> ZMod (Gam AB)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
hs)

--------------------------------------------------------------------------------
-- * Fibonacci-type recursion formula for @pi_*@

-- | However it should faster to just use the recursion for the @P_j(m)@ polynomials,
-- which this function does.
pi_star 
  :: forall base. (ChernBase base) 
  => Int                      -- ^ the number of points @m@ (recall the pi : @Q^m -> P^m@)
  -> ZMod (Eta base) 
  -> ZMod (Gam base)
pi_star :: Int -> ZMod (Eta base) -> ZMod (Gam base)
pi_star Int
m = (Eta base -> ZMod (Gam base)) -> ZMod (Eta base) -> ZMod (Gam base)
forall b1 b2 c.
(Ord b1, Ord b2, Eq c, Num c) =>
(b1 -> FreeMod c b2) -> FreeMod c b1 -> FreeMod c b2
ZMod.flatMap Eta base -> ZMod (Gam base)
f where 
  table :: Array Int (ZMod (Gam base))
table = Int -> Array Int (ZMod (Gam base))
forall base. ChernBase base => Int -> Array Int (ZMod (Gam base))
piStarTableProj Int
m :: Array Int (ZMod (Gam base))
  f :: Eta base -> ZMod (Gam base)
f (Eta [Int]
hs base
ab) = base -> ZMod (Gam base) -> ZMod (Gam base)
forall (f :: * -> *) ab.
(Functor f, Monoid ab, Ord (f ab)) =>
ab -> ZMod (f ab) -> ZMod (f ab)
mulInjMonom base
ab (Array Int (ZMod (Gam base))
table Array Int (ZMod (Gam base)) -> Int -> ZMod (Gam base)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
hs)

piStarTableAff :: ChernBase base => Int -> Array Int (ZMod base)
piStarTableAff :: Int -> Array Int (ZMod base)
piStarTableAff = (forall base.
 ChernBase base =>
 Int -> Array Int (FreeMod Integer base))
-> forall base.
   ChernBase base =>
   Int -> Array Int (FreeMod Integer 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 =>
Int -> Array Int (FreeMod Integer base)
calc where
  calc :: Int -> Array Int (FreeMod Integer base)
calc Int
n = (Array Int (FreeMod Integer AB), Array Int (FreeMod Integer Chern))
-> ChernBase base => Array Int (FreeMod Integer base)
forall (f :: * -> *) (g :: * -> *) base.
(f (g AB), f (g Chern)) -> ChernBase base => f (g base)
select2 ( Int -> Array Int (FreeMod Integer AB)
aff_fibPiStar_AB Int
n , Int -> Array Int (FreeMod Integer Chern)
aff_fibPiStar_Chern Int
n )

piStarTableProj :: ChernBase base => Int -> Array Int (ZMod (Gam base))
piStarTableProj :: Int -> Array Int (ZMod (Gam base))
piStarTableProj = (forall base. ChernBase base => Int -> Array Int (ZMod (Gam base)))
-> forall base.
   ChernBase base =>
   Int -> Array Int (ZMod (Gam base))
forall key (f :: * -> *) (g :: * -> *) (h :: * -> *).
CacheKey key =>
(forall base. ChernBase base => key -> f (g (h base)))
-> forall base. ChernBase base => key -> f (g (h base))
polyCache3 forall base. ChernBase base => Int -> Array Int (ZMod (Gam base))
calc where
  calc :: Int -> Array Int (FreeMod Integer (Gam base))
calc Int
n = (Array Int (ZMod (Gam AB)),
 Array Int (FreeMod Integer (Gam Chern)))
-> ChernBase base => Array Int (FreeMod Integer (Gam base))
forall (f :: * -> *) (g :: * -> *) (h :: * -> *) base.
(f (g (h AB)), f (g (h Chern))) -> ChernBase base => f (g (h base))
select3 ( Int -> Array Int (ZMod (Gam AB))
proj_fibPiStar_AB Int
n , Int -> Array Int (FreeMod Integer (Gam Chern))
proj_fibPiStar_Chern Int
n )

{-

class ChernBase (PiStarBase tgtmonom) => PiStar tgtmonom where
  type PiStarBase tgtmonom :: *
  piStarTable :: Int -> Array Int (ZMod tgtmonom)

instance PiStar (Gam Chern) where { piStarTable = proj_fibPiStar_Chern ; type PiStarBase (Gam Chern) = Chern }
instance PiStar (Gam AB   ) where { piStarTable = proj_fibPiStar_AB    ; type PiStarBase (Gam AB   ) = AB    }
instance PiStar      Chern  where { piStarTable = aff_fibPiStar_Chern  ; type PiStarBase (Chern    ) = Chern }
instance PiStar      AB     where { piStarTable = aff_fibPiStar_AB     ; type PiStarBase (AB       ) = AB    }

-- instance PiStar (Gam Schur) where { piStarTable = proj_fibPiStar_Schur ; type PiStarBase = Gam Schur }
-- instance PiStar      Schur  where { piStarTable = aff_fibPiStar_Schur  ; type PiStarBase = Schur     }
-}

proj_fibPiStar_Chern :: Int -> Array Int (ZMod (Gam Chern))
proj_fibPiStar_Chern :: Int -> Array Int (FreeMod Integer (Gam Chern))
proj_fibPiStar_Chern Int
m = (Int, Int)
-> [FreeMod Integer (Gam Chern)]
-> Array Int (FreeMod Integer (Gam Chern))
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
m) ([FreeMod Integer (Gam Chern)]
 -> Array Int (FreeMod Integer (Gam Chern)))
-> [FreeMod Integer (Gam Chern)]
-> Array Int (FreeMod Integer (Gam Chern))
forall a b. (a -> b) -> a -> b
$ Int
-> [FreeMod Integer (Gam Chern)] -> [FreeMod Integer (Gam Chern)]
forall a. Int -> [a] -> [a]
take (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [FreeMod Integer (Gam Chern)]
fib where

  fib :: [ZMod (Gam Chern)]
  fib :: [FreeMod Integer (Gam Chern)]
fib = Integer -> FreeMod Integer (Gam Chern)
forall b c. (Monoid b, Eq c, Num c) => c -> FreeMod c b
ZMod.konst                    (Int -> Integer
forall a. Integral a => a -> Integer
factorial  Int
m   )
      FreeMod Integer (Gam Chern)
-> [FreeMod Integer (Gam Chern)] -> [FreeMod Integer (Gam Chern)]
forall a. a -> [a] -> [a]
: Gam Chern -> Integer -> FreeMod Integer (Gam Chern)
forall b c. (Ord b, Num c, Eq c) => b -> c -> FreeMod c b
ZMod.singleton (Int -> Chern -> Gam Chern
forall ab. Int -> ab -> Gam ab
Gam Int
1 Chern
forall a. Monoid a => a
mempty) (Int -> Integer
forall a. Integral a => a -> Integer
factorial (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
      FreeMod Integer (Gam Chern)
-> [FreeMod Integer (Gam Chern)] -> [FreeMod Integer (Gam Chern)]
forall a. a -> [a] -> [a]
: (Integer
 -> FreeMod Integer (Gam Chern)
 -> FreeMod Integer (Gam Chern)
 -> FreeMod Integer (Gam Chern))
-> [Integer]
-> [FreeMod Integer (Gam Chern)]
-> [FreeMod Integer (Gam Chern)]
-> [FreeMod Integer (Gam Chern)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Integer
-> FreeMod Integer (Gam Chern)
-> FreeMod Integer (Gam Chern)
-> FreeMod Integer (Gam Chern)
g [Integer
1..] ([FreeMod Integer (Gam Chern)] -> [FreeMod Integer (Gam Chern)]
forall a. [a] -> [a]
tail [FreeMod Integer (Gam Chern)]
fib) [FreeMod Integer (Gam Chern)]
fib 

  g :: Integer -> ZMod (Gam Chern) -> ZMod (Gam Chern) -> ZMod (Gam Chern)
  g :: Integer
-> FreeMod Integer (Gam Chern)
-> FreeMod Integer (Gam Chern)
-> FreeMod Integer (Gam Chern)
g Integer
k FreeMod Integer (Gam Chern)
prev1 FreeMod Integer (Gam Chern)
prev2 
    = Integer
-> FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern)
forall b c.
(Ord b, Eq c, Integral c, Show c) =>
c -> FreeMod c b -> FreeMod c b
ZMod.divideByConst (Integer
mmInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
k)
    (FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern))
-> FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern)
forall a b. (a -> b) -> a -> b
$ FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern)
forall ab. Ord ab => ZMod (Gam ab) -> ZMod (Gam ab)
mulGam FreeMod Integer (Gam Chern)
prev1 FreeMod Integer (Gam Chern)
-> FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern)
forall a. Num a => a -> a -> a
+ Integer
-> FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern)
forall b c. (Ord b, Eq c, Num c) => c -> FreeMod c b -> FreeMod c b
ZMod.scale Integer
k (Chern -> FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern)
forall (f :: * -> *) ab.
(Functor f, Monoid ab, Ord (f ab)) =>
ab -> ZMod (f ab) -> ZMod (f ab)
mulInjMonom Chern
c1 FreeMod Integer (Gam Chern)
prev1) 
                   FreeMod Integer (Gam Chern)
-> FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern)
forall a. Num a => a -> a -> a
+ Integer
-> FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern)
forall b c. (Ord b, Eq c, Num c) => c -> FreeMod c b -> FreeMod c b
ZMod.scale Integer
k (Chern -> FreeMod Integer (Gam Chern) -> FreeMod Integer (Gam Chern)
forall (f :: * -> *) ab.
(Functor f, Monoid ab, Ord (f ab)) =>
ab -> ZMod (f ab) -> ZMod (f ab)
mulInjMonom Chern
c2 FreeMod Integer (Gam Chern)
prev2) 

  mm :: Integer
mm = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m :: Integer

--  c1 = Chern 1 0
--  c2 = Chern 0 1

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

aff_fibPiStar_Chern :: Int -> Array Int (ZMod Chern)
aff_fibPiStar_Chern :: Int -> Array Int (FreeMod Integer Chern)
aff_fibPiStar_Chern Int
m = (Int, Int)
-> [FreeMod Integer Chern] -> Array Int (FreeMod Integer Chern)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
m) ([FreeMod Integer Chern] -> Array Int (FreeMod Integer Chern))
-> [FreeMod Integer Chern] -> Array Int (FreeMod Integer Chern)
forall a b. (a -> b) -> a -> b
$ Int -> [FreeMod Integer Chern] -> [FreeMod Integer Chern]
forall a. Int -> [a] -> [a]
take (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [FreeMod Integer Chern]
fib where

  fib :: [ZMod Chern]
  fib :: [FreeMod Integer Chern]
fib = Integer -> FreeMod Integer Chern
forall b c. (Monoid b, Eq c, Num c) => c -> FreeMod c b
ZMod.konst (Int -> Integer
forall a. Integral a => a -> Integer
factorial Int
m)
      FreeMod Integer Chern
-> [FreeMod Integer Chern] -> [FreeMod Integer Chern]
forall a. a -> [a] -> [a]
: FreeMod Integer Chern
forall c b. FreeMod c b
ZMod.zero
      FreeMod Integer Chern
-> [FreeMod Integer Chern] -> [FreeMod Integer Chern]
forall a. a -> [a] -> [a]
: (Integer
 -> FreeMod Integer Chern
 -> FreeMod Integer Chern
 -> FreeMod Integer Chern)
-> [Integer]
-> [FreeMod Integer Chern]
-> [FreeMod Integer Chern]
-> [FreeMod Integer Chern]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Integer
-> FreeMod Integer Chern
-> FreeMod Integer Chern
-> FreeMod Integer Chern
g [Integer
1..] ([FreeMod Integer Chern] -> [FreeMod Integer Chern]
forall a. [a] -> [a]
tail [FreeMod Integer Chern]
fib) [FreeMod Integer Chern]
fib 

  g :: Integer -> ZMod Chern -> ZMod Chern -> ZMod Chern
  g :: Integer
-> FreeMod Integer Chern
-> FreeMod Integer Chern
-> FreeMod Integer Chern
g Integer
k FreeMod Integer Chern
prev1 FreeMod Integer Chern
prev2 
    = Integer -> FreeMod Integer Chern -> FreeMod Integer Chern
forall b c.
(Ord b, Eq c, Integral c, Show c) =>
c -> FreeMod c b -> FreeMod c b
ZMod.divideByConst (Integer
mmInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
k)
    (FreeMod Integer Chern -> FreeMod Integer Chern)
-> FreeMod Integer Chern -> FreeMod Integer Chern
forall a b. (a -> b) -> a -> b
$ Integer -> FreeMod Integer Chern -> FreeMod Integer Chern
forall b c. (Ord b, Eq c, Num c) => c -> FreeMod c b -> FreeMod c b
ZMod.scale         (   Integer
k)
    (FreeMod Integer Chern -> FreeMod Integer Chern)
-> FreeMod Integer Chern -> FreeMod Integer Chern
forall a b. (a -> b) -> a -> b
$ (Chern -> FreeMod Integer Chern -> FreeMod Integer Chern
forall c b.
(Eq c, Num c, Ord b, Monoid b) =>
b -> FreeMod c b -> FreeMod c b
ZMod.mulByMonom Chern
c1 FreeMod Integer Chern
prev1 FreeMod Integer Chern
-> FreeMod Integer Chern -> FreeMod Integer Chern
forall a. Num a => a -> a -> a
+ Chern -> FreeMod Integer Chern -> FreeMod Integer Chern
forall c b.
(Eq c, Num c, Ord b, Monoid b) =>
b -> FreeMod c b -> FreeMod c b
ZMod.mulByMonom Chern
c2 FreeMod Integer Chern
prev2) 

  mm :: Integer
mm = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m :: Integer

--  c1 = Chern 1 0
--  c2 = Chern 0 1

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

proj_fibPiStar_AB :: Int -> Array Int (ZMod (Gam AB))
proj_fibPiStar_AB :: Int -> Array Int (ZMod (Gam AB))
proj_fibPiStar_AB Int
m = (FreeMod Integer (Gam Chern) -> ZMod (Gam AB))
-> Array Int (FreeMod Integer (Gam Chern))
-> Array Int (ZMod (Gam AB))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FreeMod Integer Chern -> FreeMod Integer AB)
-> FreeMod Integer (Gam Chern) -> ZMod (Gam AB)
forall ab cd.
(Ord ab, Ord cd) =>
(ZMod ab -> ZMod cd) -> ZMod (Gam ab) -> ZMod (Gam cd)
convertGam FreeMod Integer Chern -> FreeMod Integer AB
chernToAB) (Int -> Array Int (FreeMod Integer (Gam Chern))
proj_fibPiStar_Chern Int
m)

proj_fibPiStar_Schur :: Int -> Array Int (ZMod (Gam Schur))
proj_fibPiStar_Schur :: Int -> Array Int (ZMod (Gam Schur))
proj_fibPiStar_Schur Int
m = (FreeMod Integer (Gam Chern) -> ZMod (Gam Schur))
-> Array Int (FreeMod Integer (Gam Chern))
-> Array Int (ZMod (Gam Schur))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FreeMod Integer Chern -> ZMod Schur)
-> FreeMod Integer (Gam Chern) -> ZMod (Gam Schur)
forall ab cd.
(Ord ab, Ord cd) =>
(ZMod ab -> ZMod cd) -> ZMod (Gam ab) -> ZMod (Gam cd)
convertGam FreeMod Integer Chern -> ZMod Schur
chernToSchur) (Int -> Array Int (FreeMod Integer (Gam Chern))
proj_fibPiStar_Chern Int
m)

aff_fibPiStar_AB :: Int -> Array Int (ZMod AB)
aff_fibPiStar_AB :: Int -> Array Int (FreeMod Integer AB)
aff_fibPiStar_AB Int
m =  (FreeMod Integer Chern -> FreeMod Integer AB)
-> Array Int (FreeMod Integer Chern)
-> Array Int (FreeMod Integer AB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FreeMod Integer Chern -> FreeMod Integer AB
chernToAB (Int -> Array Int (FreeMod Integer Chern)
aff_fibPiStar_Chern Int
m)

aff_fibPiStar_Schur :: Int -> Array Int (ZMod Schur)
aff_fibPiStar_Schur :: Int -> Array Int (ZMod Schur)
aff_fibPiStar_Schur Int
m =  (FreeMod Integer Chern -> ZMod Schur)
-> Array Int (FreeMod Integer Chern) -> Array Int (ZMod Schur)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FreeMod Integer Chern -> ZMod Schur
chernToSchur (Int -> Array Int (FreeMod Integer Chern)
aff_fibPiStar_Chern Int
m)

--------------------------------------------------------------------------------
-- * helpers

-- | Multiplies by an injected monomial 
mulInjMonom :: (Functor f, Monoid ab, Ord (f ab)) => ab -> ZMod (f ab) -> ZMod (f ab)
mulInjMonom :: ab -> ZMod (f ab) -> ZMod (f ab)
mulInjMonom ab
monom = (f ab -> f ab) -> ZMod (f ab) -> ZMod (f ab)
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase f ab -> f ab
f where
  f :: f ab -> f ab
f = (ab -> ab) -> f ab -> f ab
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ab -> ab -> ab
forall a. Monoid a => a -> a -> a
mappend ab
monom)

-- | Multiplies by @(alpha^i * beta^j)@
mulAB :: (Functor f, Ord (f AB)) => AB -> ZMod (f AB) -> ZMod (f AB)
mulAB :: AB -> ZMod (f AB) -> ZMod (f AB)
mulAB = AB -> ZMod (f AB) -> ZMod (f AB)
forall (f :: * -> *) ab.
(Functor f, Monoid ab, Ord (f ab)) =>
ab -> ZMod (f ab) -> ZMod (f ab)
mulInjMonom

-- | Multiplies with @gamma@
mulGam :: Ord ab => ZMod (Gam ab) -> ZMod (Gam ab)
mulGam :: ZMod (Gam ab) -> ZMod (Gam ab)
mulGam = (Gam ab -> Gam ab) -> ZMod (Gam ab) -> ZMod (Gam ab)
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase Gam ab -> Gam ab
forall ab. Gam ab -> Gam ab
f where 
  f :: Gam ab -> Gam ab
f (Gam Int
k ab
x) = Int -> ab -> Gam ab
forall ab. Int -> ab -> Gam ab
Gam (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ab
x

{-
-- | Multiplies by alpha^i beta^j
omegaMulAB :: AB -> ZMod (Omega AB) -> ZMod (Omega AB)
omegaMulAB (AB i j) = Map.mapKeys f where
  f (Omega us (AB a b)) = Omega us (AB (a+i) (b+j))

-- | Multiplies by alpha^i beta^j
etaMulAB :: AB -> ZMod (Eta AB)-> ZMod (Eta AB)
etaMulAB (AB i j) = Map.mapKeys f where
  f (Eta hs (AB a b)) = Eta hs (AB (a+i) (b+j))

-- | Multiplies by alpha^i beta^j
gamMulAB :: AB -> ZMod (Gam AB) -> ZMod (Gam AB)
gamMulAB (AB i j) = Map.mapKeys f where
  f (Gam g (AB a b)) = Gam g (AB (a+i) (b+j))
-}

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