-- | Compute the non-equivariant CSM in @P^n@ recursively

{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}
module Math.RootLoci.CSM.Projective 
  ( -- * Pushforwards
    delta_star
  , pi_star
    -- * Easy things
  , tangentChernClass
  , smallestOrbitCSM
    -- * CSM calculation
  , upperCSM , lowerCSM
  , openCSM  , closedCSM
    -- * extracting coefficients
  , highestCoeff_ , lowestCoeff_
  , highestCoeff  , lowestCoeff 
  ) 
  where

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

import Data.List
import Data.Maybe

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

import qualified Data.Map as Map ; import Data.Map (Map)
import qualified Data.Set as Set ; import Data.Set (Set)

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

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

import qualified Math.Algebra.Polynomial.FreeModule as ZMod
 
--------------------------------------------------------------------------------

{-
  
we have maps
* Delta_nu : Q^d -> Q^n
* pi : Q^n -> P^n
  
-}

--------------------------------------------------------------------------------
-- * The order-forgetting map @pi : Q^n -> P^n@

pi_star_1 :: Int -> HS -> (G,Integer)
pi_star_1 :: Int -> HS -> (G, Integer)
pi_star_1 Int
n (HS [H]
hs) = (G
gk,Integer
c) where
  c :: Integer
c  = Int -> Integer
forall a. Integral a => a -> Integer
factorial (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [H] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [H]
hs) 
  gk :: G
gk = Int -> G
G ([H] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [H]
hs)

-- | The pushforward map @pi_*@ along @pi@.
--
-- A (cohomology) group generator above is a subset (=product) of H-s, which we map to
-- a group generator below. This defines the map on the cohomology ring by additive extension.
--
pi_star 
  :: Int           -- ^ the number of points @m@ (with multiplicity)
  -> ZMod HS       -- ^ the cohomoly class \"up\"
  -> ZMod G
pi_star :: Int -> ZMod HS -> ZMod G
pi_star Int
n = (HS -> ZMod G) -> ZMod HS -> ZMod G
forall b1 b2 c.
(Ord b1, Ord b2, Eq c, Num c) =>
(b1 -> FreeMod c b2) -> FreeMod c b1 -> FreeMod c b2
ZMod.flatMap ((G, Integer) -> ZMod G
forall b c. (Ord b, Num c, Eq c) => (b, c) -> FreeMod c b
sing ((G, Integer) -> ZMod G) -> (HS -> (G, Integer)) -> HS -> ZMod G
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> HS -> (G, Integer)
pi_star_1 Int
n) where 
  sing :: (b, c) -> FreeMod c b
sing (b
b,c
c) = b -> c -> FreeMod c b
forall b c. (Ord b, Num c, Eq c) => b -> c -> FreeMod c b
ZMod.singleton b
b c
c

--------------------------------------------------------------------------------
-- * The diagonal maps @Delta_{\nu} : Q^d -> Q^n@
  
delta_star_1 :: Partition -> US -> ZMod HS
delta_star_1 :: Partition -> US -> ZMod HS
delta_star_1 part :: Partition
part@(Partition [Int]
ps) (US [U]
us) = [HS] -> ZMod HS
forall b c. (Ord b, Num c) => [b] -> FreeMod c b
ZMod.histogram [HS]
almost where

  n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum    [Int]
ps
  d :: Int
d = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ps
  
  idxtable :: [[Int]]
idxtable = Partition -> [[Int]]
linearIndices Partition
part
      
  -- inner lists = monoms
  -- outer lists = linear combination of monoms
  -- now we want to multiply those together
  stuff :: [[[H]]]
  stuff :: [[[H]]]
stuff = (([[Int]] -> [[H]]) -> [[[Int]]] -> [[[H]]]
forall a b. (a -> b) -> [a] -> [b]
map (([[Int]] -> [[H]]) -> [[[Int]]] -> [[[H]]])
-> ((Int -> H) -> [[Int]] -> [[H]])
-> (Int -> H)
-> [[[Int]]]
-> [[[H]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> [H]) -> [[Int]] -> [[H]]
forall a b. (a -> b) -> [a] -> [b]
map (([Int] -> [H]) -> [[Int]] -> [[H]])
-> ((Int -> H) -> [Int] -> [H]) -> (Int -> H) -> [[Int]] -> [[H]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> H) -> [Int] -> [H]
forall a b. (a -> b) -> [a] -> [b]
map) Int -> H
H (Int -> [[Int]] -> [[[Int]]]
go Int
1 [[Int]]
idxtable)
  
  almost :: [HS]
  almost :: [HS]
almost = ([[H]] -> HS) -> [[[H]]] -> [HS]
forall a b. (a -> b) -> [a] -> [b]
map ([H] -> HS
HS ([H] -> HS) -> ([[H]] -> [H]) -> [[H]] -> HS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[H]] -> [H]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[[H]]] -> [HS]) -> [[[H]]] -> [HS]
forall a b. (a -> b) -> a -> b
$ [[[H]]] -> [[[H]]]
forall a. [[a]] -> [[a]]
listTensor [[[H]]]
stuff     -- this does the multiplication of terms
  
  uis :: [Int]
uis = [ Int
i | U Int
i <- [U]
us ]
    
  go :: Int -> [[Int]] -> [[[Int]]]
  go :: Int -> [[Int]] -> [[[Int]]]
go Int
_ []       = []
  go Int
k ([Int]
is:[[Int]]
iss) = [[Int]]
this [[Int]] -> [[[Int]]] -> [[[Int]]]
forall a. a -> [a] -> [a]
: Int -> [[Int]] -> [[[Int]]]
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [[Int]]
iss where
    this :: [[Int]]
this = if Int
k Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
uis
      then [[Int]
is]                     -- "sigma_k"
      else [Int] -> [[Int]]
forall a. [a] -> [[a]]
chooseN1 [Int]
is              -- "sigma_(k-1)"
  
-- | A group generator on the left is a subset (=product) of U-s, which
-- we map to a linear combinaton of H-s. This is then extended additively
-- to the cohomology ring.
--
delta_star :: Partition -> ZMod US -> ZMod HS
delta_star :: Partition -> ZMod US -> ZMod HS
delta_star Partition
part = (US -> ZMod HS) -> ZMod US -> ZMod HS
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 -> US -> ZMod HS
delta_star_1 Partition
part)

--------------------------------------------------------------------------------
-- * Easy things

-- | The total Chern class of the tangent bundle of @Q^d = P^1 x P^1 x ... x P^1@
--
-- This is just the product of @(1+2u_i)@-s for @i=[1..d]@
--
tangentChernClass :: Int -> ZMod US
tangentChernClass :: Int -> ZMod US
tangentChernClass Int
d = [(US, Integer)] -> ZMod US
forall c b. (Eq c, Num c, Ord b) => [(b, c)] -> FreeMod c b
ZMod.fromList ([(US, Integer)] -> ZMod US) -> [(US, Integer)] -> ZMod US
forall a b. (a -> b) -> a -> b
$ (Int -> [(US, Integer)]) -> [Int] -> [(US, Integer)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [(US, Integer)]
forall b. Num b => Int -> [(US, b)]
worker [Int
0..Int
d] where
  worker :: Int -> [(US, b)]
worker Int
k = ([Int] -> (US, b)) -> [[Int]] -> [(US, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Int]
xs -> ([U] -> US
US ((Int -> U) -> [Int] -> [U]
forall a b. (a -> b) -> [a] -> [b]
map Int -> U
U [Int]
xs) , b
2b -> Int -> b
forall a b. (Num a, Integral b) => a -> b -> a
^Int
k)) (Int -> Int -> [[Int]]
choose_ Int
k Int
d)

-- | The CSM of the smallest orbit: 1 point with multiplicity @n@,
-- which is just the rational normal curve in @P^n@.
--
smallestOrbitCSM :: Int -> ZMod G
smallestOrbitCSM :: Int -> ZMod G
smallestOrbitCSM Int
n = [(G, Integer)] -> ZMod G
forall c b. (Eq c, Num c, Ord b) => [(b, c)] -> FreeMod c b
ZMod.fromList 
  [ (Int -> G
G (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ,     Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) 
  , (Int -> G
G  Int
n    , Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) 
  ] 

--------------------------------------------------------------------------------
-- * CSM calculation

-- | We know that:
-- 
-- > csm(im(Delta) = Delta_* c(TQ^d)
-- > c(TQ^d) = (1+2*u1) (1+2*u2) ... (1+2*ud)
--
-- From these, we can compute @csm(im(Delta_nu))@ recursively
--
upperCSM :: Partition -> ZMod HS
upperCSM :: Partition -> ZMod HS
upperCSM = (Partition -> ZMod HS) -> Partition -> ZMod HS
forall a. (Partition -> a) -> Partition -> a
pcache Partition -> ZMod HS
calc where

  calc :: Partition -> ZMod HS
calc part :: Partition
part@(Partition [Int]
ps) = (Partition -> ZMod US -> ZMod HS
delta_star Partition
part) (Int -> ZMod US
tangentChernClass Int
d) where
    d :: Int
d = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ps

-- | A formula for @pi_*(csm(im(delta)))@. This should satisfy
--
-- > lowerCSM part = pi_star n (upperCSM part)
--
lowerCSM :: Partition -> ZMod G
lowerCSM :: Partition -> ZMod G
lowerCSM = (Partition -> ZMod G) -> Partition -> ZMod G
forall a. (Partition -> a) -> Partition -> a
pcache Partition -> ZMod G
calc where

  calc :: Partition -> ZMod G
calc part :: Partition
part@(Partition [Int]
ps) = ZMod G
zmod where
    d :: Int
d = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ps
    n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ps
    zmod :: ZMod G
zmod = [(G, Integer)] -> ZMod G
forall c b. (Eq c, Num c, Ord b) => [(b, c)] -> FreeMod c b
ZMod.fromList
      [ ( Int -> G
G (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
r) , Integer
coeff )
      | Int
r<-[Int
0..Int
d]
      , let coeff :: Integer
coeff = Int -> Integer
forall a. Integral a => a -> Integer
factorial (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> [Integer] -> Integer
forall a. Num a => Int -> [a] -> a
symPolyNum (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r) ((Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
fi [Int]
ps)
      ]
  
    fi :: Int -> Integer
    fi :: Int -> Integer
fi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

check_lower_upper :: Int -> Bool
check_lower_upper :: Int -> Bool
check_lower_upper Int
n = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Int -> ZMod HS -> ZMod G
pi_star Int
n (Partition -> ZMod HS
upperCSM Partition
p) ZMod G -> ZMod G -> Bool
forall a. Eq a => a -> a -> Bool
== Partition -> ZMod G
lowerCSM Partition
p | Partition
p <- Int -> [Partition]
partitions Int
n ]

-- | Cached CSM computation of the open strata
openCSM :: Partition -> ZMod G
openCSM :: Partition -> ZMod G
openCSM = (Partition -> ZMod G) -> Partition -> ZMod G
forall a. (Partition -> a) -> Partition -> a
pcache Partition -> ZMod G
calcOpenCSM where

  -- | we know that (pi_* upperCSM) = sum (chi * openCSM)
  calcOpenCSM :: Partition -> ZMod G
  calcOpenCSM :: Partition -> ZMod G
calcOpenCSM Partition
part = Integer -> ZMod G -> ZMod G
forall b c.
(Ord b, Eq c, Integral c, Show c) =>
c -> FreeMod c b -> FreeMod c b
ZMod.divideByConst Integer
thisCoeff (ZMod G
pushdown ZMod G -> ZMod G -> ZMod G
forall a. Num a => a -> a -> a
- ZMod G
smaller) where
    n :: Int
n = Partition -> Int
partitionWeight Partition
part
    pushdown :: ZMod G
pushdown  = Partition -> ZMod G
lowerCSM Partition
part -- pi_star n (upperCSM part) 
    smaller :: ZMod G
smaller   = [(Integer, ZMod G)] -> ZMod G
forall b c.
(Ord b, Eq c, Num c) =>
[(c, FreeMod c b)] -> FreeMod c b
ZMod.linComb [ (Integer
c , Partition -> ZMod G
openCSM Partition
q) | (Partition
q,Integer
c) <- Map Partition Integer -> [(Partition, Integer)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map Partition Integer
theClosure ]
    (Integer
thisCoeff,Map Partition Integer
theClosure) = Partition -> (Integer, Map Partition Integer)
preimageView Partition
part

-- | To get the CSM of the closed strata, we just sum over the open strata contained
-- in the closure.

closedCSM :: Partition -> ZMod G 
closedCSM :: Partition -> ZMod G
closedCSM = (Partition -> ZMod G) -> Partition -> ZMod G
forall a. (Partition -> a) -> Partition -> a
pcache Partition -> ZMod G
calcClosedCSM where  

  calcClosedCSM :: Partition -> ZMod G
  calcClosedCSM :: Partition -> ZMod G
calcClosedCSM Partition
part = [ZMod G] -> ZMod G
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ Partition -> ZMod G
openCSM Partition
q | Partition
q <- Set Partition -> [Partition]
forall a. Set a -> [a]
Set.toList (Partition -> Set Partition
closureSet Partition
part) ]

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

lowestCoeff_ :: ZMod G -> Integer
lowestCoeff_ :: ZMod G -> Integer
lowestCoeff_ = (G, Integer) -> Integer
forall a b. (a, b) -> b
snd ((G, Integer) -> Integer)
-> (ZMod G -> (G, Integer)) -> ZMod G -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMod G -> (G, Integer)
lowestCoeff

highestCoeff_ :: ZMod G -> Integer
highestCoeff_ :: ZMod G -> Integer
highestCoeff_ = (G, Integer) -> Integer
forall a b. (a, b) -> b
snd ((G, Integer) -> Integer)
-> (ZMod G -> (G, Integer)) -> ZMod G -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMod G -> (G, Integer)
highestCoeff

lowestCoeff :: ZMod G -> (G,Integer)
lowestCoeff :: ZMod G -> (G, Integer)
lowestCoeff = Maybe (G, Integer) -> (G, Integer)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (G, Integer) -> (G, Integer))
-> (ZMod G -> Maybe (G, Integer)) -> ZMod G -> (G, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMod G -> Maybe (G, Integer)
forall b c. Ord b => FreeMod c b -> Maybe (b, c)
ZMod.findMinTerm 
-- lowestCoeff = head . ZMod.toList 

highestCoeff :: ZMod G -> (G,Integer)
highestCoeff :: ZMod G -> (G, Integer)
highestCoeff = Maybe (G, Integer) -> (G, Integer)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (G, Integer) -> (G, Integer))
-> (ZMod G -> Maybe (G, Integer)) -> ZMod G -> (G, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMod G -> Maybe (G, Integer)
forall b c. Ord b => FreeMod c b -> Maybe (b, c)
ZMod.findMaxTerm
-- highestCoeff = last . ZMod.toList 

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

{-
check_degree :: Partition -> Bool
check_degree p = hilbert p == lowestCoeff_ (closedCSM p)

check_euler_degree :: Partition -> Bool
check_euler_degree p@(Partition ps) = hilbert p == ((csmToEuler n $ closedCSM p) !! d) where
  d = length ps
  n = sum ps
-}

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