-- | Aluffi's computation of the non-equivariant CSM in @P^n@
--
-- See: Paolo Aluffi: Characteristic classes of discriminants and enumerative geometry, Comm. in Algebra 26(10), 3165-3193 (1998).
--
{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}

module Math.RootLoci.CSM.Aluffi where

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

import Data.List

import Control.Monad

import Math.Combinat.Classes
import Math.Combinat.Numbers
import Math.Combinat.Sign
import Math.Combinat.Partitions.Integer
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 (Array)
import Data.Array.IArray

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

import qualified Math.Algebra.Polynomial.FreeModule as ZMod

--------------------------------------------------------------------------------
-- * CSM computation

-- | Paolo Aluffi's explicit formula for the (non-equivariant) CSM of open coincident root loci
aluffiOpenCSM :: Partition -> ZMod G
aluffiOpenCSM :: Partition -> ZMod G
aluffiOpenCSM part :: Partition
part@(Partition [Int]
ps) = 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 (Partition -> Integer
aut Partition
part) ZMod G
xsum 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
  xsum :: ZMod G
xsum = [(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
k) , Int -> Integer
coeff Int
k ) | Int
k<-[Int
0..Int
d] ] 
  coeff :: Int -> Integer
coeff Int
k = Int -> Integer -> Integer
forall a b. (Integral a, Num b) => a -> b -> b
negateIfOdd Int
k 
          (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Integer
signedBinomial (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3) Int
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
factorial Int
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
factorial (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) 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
k) ((Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
ps)

-- | Summing together the open loci CSMs, we got the CSMs of the closures of the strata
aluffiClosedCSM :: Partition -> ZMod G
aluffiClosedCSM :: Partition -> ZMod G
aluffiClosedCSM part :: Partition
part@(Partition [Int]
ps) = [ZMod G] -> ZMod G
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ZMod G]
opens where
  opens :: [ZMod G]
opens = [ Partition -> ZMod G
aluffiOpenCSM Partition
q | Partition
q <- Set Partition -> [Partition]
forall a. Set a -> [a]
Set.toList (Partition -> Set Partition
closureSet Partition
part) ]

--------------------------------------------------------------------------------
-- * Euler characteristics

-- | Euler characteristic, computed form 'aluffiOpenCSM'
aluffiOpenEuler :: Partition -> Integer
aluffiOpenEuler :: Partition -> Integer
aluffiOpenEuler Partition
p = G -> ZMod G -> Integer
forall b c. (Ord b, Num c) => b -> FreeMod c b -> c
ZMod.coeffOf (Int -> G
G Int
n) (Partition -> ZMod G
aluffiOpenCSM Partition
p) where
  n :: Int
n = Partition -> Int
partitionWeight Partition
p

-- | Euler characteristic, computed form 'aluffiClosedCSM'
aluffiClosedEuler :: Partition -> Integer
aluffiClosedEuler :: Partition -> Integer
aluffiClosedEuler Partition
p = G -> ZMod G -> Integer
forall b c. (Ord b, Num c) => b -> FreeMod c b -> c
ZMod.coeffOf (Int -> G
G Int
n) (Partition -> ZMod G
aluffiClosedCSM Partition
p) where
  n :: Int
n = Partition -> Int
partitionWeight Partition
p

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

-- | It is easy to see from Aluffi\'s formula that only dimensions 1 and 2 has nonzero Euler characteristic.
-- This function implements the resulting rather trivial formula:
--
-- > chi( X_{n}   ) = 2
-- > chi( X_{p,q} ) = if p==q then 1 else 2
-- > chi( X_{...} ) = 0
--
openEulerChar :: Partition -> Integer
openEulerChar :: Partition -> Integer
openEulerChar (Partition [Int]
ps) = case [Int]
ps of
  [Int
n]   -> Integer
2
  [Int
a,Int
b] -> if Int
aInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
b then Integer
1 else Integer
2
  [Int]
_     -> Integer
0

--------------------------------------------------------------------------------
-- * General linear sections

-- | Converts the CSM class of a (locally closed?) projective variety Z to the Euler characteristics
-- of general linear sections of Z (so the first number will be @chi(Z)@, the second will be
-- @chi(Z cap H1)@, the third @chi(Z cap H1 cap H2)@ with @H1@, @H2@... being generic hyperplanes.
-- Finally the codim-th number will be the degree.
--
-- See: Paolo Aluffi: EULER CHARACTERISTICS OF GENERAL LINEAR SECTIONS AND POLYNOMIAL CHERN CLASSES,
-- Proposition 2.6
-- 
csmToEulerOfLinearSections 
  :: Int             -- ^ the dimension of the ambient projective space @P^n@
  -> ZMod G          -- ^ the CSM class
  -> [Integer]       -- ^ the resulting sequence of Euler characteristics
csmToEulerOfLinearSections :: Int -> ZMod G -> [Integer]
csmToEulerOfLinearSections Int
n ZMod G
csm = [ Int -> Integer
euler Int
i | Int
i<-[Int
0..Int
n] ] where
  csmArr :: Array Int Integer
csmArr  = (Integer -> Integer -> Integer)
-> Integer -> (Int, Int) -> [(Int, Integer)] -> Array Int Integer
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
accumArray ((Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
forall a b. a -> b -> a
const) Integer
0 (Int
0,Int
n) [ (Int
i,Integer
c) | (G Int
i, Integer
c) <- ZMod G -> [(G, Integer)]
forall c b. FreeMod c b -> [(b, c)]
ZMod.toList ZMod G
csm ] :: Array Int Integer
  euler :: Int -> Integer
euler Int
k = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) Integer
0 [ Int -> Int -> Integer
signedBinomial (-Int
k) Int
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Array Int Integer
csmArr Array Int Integer -> Int -> Integer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) | Int
i<-[Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k] ]

-- | We can compute the degree of the closures of the strata by intersection them
-- with @dim(X)@ generic hiperplanes.
aluffiDegree :: Partition -> Integer
aluffiDegree :: Partition -> Integer
aluffiDegree Partition
part = [Integer]
list [Integer] -> Int -> Integer
forall a. [a] -> Int -> a
!! Partition -> Int
dimension Partition
part where
  list :: [Integer]
list = Int -> ZMod G -> [Integer]
csmToEulerOfLinearSections (Partition -> Int
forall a. HasWeight a => a -> Int
weight Partition
part) (Partition -> ZMod G
aluffiClosedCSM Partition
part)

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