module Math.RootLoci.Dual.Restriction where
import Data.List
import Data.Ratio
import Control.Monad
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 qualified Data.Set as Set ; import Data.Set (Set)
import qualified Math.RootLoci.Algebra.FreeMod as ZMod
import Math.RootLoci.Algebra
import Math.RootLoci.Classic
import Math.RootLoci.Geometry
import Math.RootLoci.Misc
affineDualMSc :: Partition -> ZMod Chern
affineDualMSc part@(Partition ps) =
case ps of
[] -> error "affine_tp_msc: empty partition"
[n] -> ZMod.fromList [ ( Chern (nd2*j) j , rat2int $ single j ) | j<-[ 0 .. div (nd) 2] ]
[a,b] | a==b -> ZMod.fromList [ ( Chern (nd2*j) j , rat2int $ double j ) | j<-[ 0 .. div (nd) 2] ]
otherwise -> ZMod.fromList [ ( Chern (nd2*j) j , rat2int $ lambda j ) | j<-[ 0 .. div (nd) 2] ]
where
n = sum ps
d = length ps
p = div n 2
q = div (n1) 2
rat2int r = case denominator r of
1 -> numerator r
_ -> error "lambda_j: not integer"
lambda j = (fi n / 2)^(n2*q) * fi (doubleFactorial (n2))^2 * s where
s = sum
[ negateIfOdd (n + p + j + lpsi) $ bigTheta j nphi * (fi (2*nphin) / fi n)^(d2) / (fi $ aut phi * aut psi)
| (phi,psi) <- Set.toList (divideIntoTwoNonEmpty part)
, let nphi = sum $ fromPartition phi
, let npsi = sum $ fromPartition psi
, let lphi = length $ fromPartition phi
, let lpsi = length $ fromPartition psi
]
gamma :: Int -> Rational
gamma k
| 2*k == n = 0
| otherwise = fi (k*(kn)) / fi ((2*kn)*(2*kn))
bigTheta :: Int -> Int -> Rational
bigTheta j k
| 2*k == n = 0
| otherwise = gamma k * smallTheta j k
smallTheta :: Int -> Int -> Rational
smallTheta j k = sympoly (q1j) [ gamma i | i<-[1..q] , i/=k, i/=nk ]
fi :: Integral a => a -> Rational
fi = fromIntegral
sqj :: Int -> Rational
sqj j = sympoly (qj) [ gamma i | i<-[1..q] ]
sympoly :: Int -> [Rational] -> Rational
sympoly k xs = sum [ product ys | ys <- choose k xs ]
single j = fi (factorial n) / (product [ gamma i | i<-[1..q] ])
* negateIfOdd j (sqj j)
double j = fi (doubleFactorial n)^2 / 4
* negateIfOdd (q+j) (sqj j)
projDegreeFromDual
:: Int
-> ZMod Chern
-> Integer
projDegreeFromDual n zm = fromRat s where
s :: Rational
s = sum [ fromIntegral c * c1^e * c2^f | (Chern e f, c) <- ZMod.toList zm ]
c1 = 2 / fromIntegral n :: Rational
c2 = 1 / fromIntegral (n*n) :: Rational
degreeMSc :: Partition -> Integer
degreeMSc part = projDegreeFromDual (partitionWeight part) (affineDualMSc part)
dualClassFromProjCSM :: forall base. ChernBase base => ZMod (Gam base) -> ZMod base
dualClassFromProjCSM csm = dualClassFromAffCSM (ZMod.filterBase nogamma csm) where
nogamma :: Gam base -> Maybe base
nogamma (Gam k ab) = if k==0 then Just ab else Nothing
dualClassFromAffCSM :: ChernBase base => ZMod base -> ZMod base
dualClassFromAffCSM csm = filterGrade min_degree csm where
min_degree = minimum $ map grade $ map fst $ ZMod.toList csm
lemma913 :: Partition -> Int -> Bool
lemma913 part h = (a==b) where
(a,b) = lemma913' part h
lemma913' :: Partition -> Int -> (Rational, Rational)
lemma913' part@(Partition ps) h = ( lhs , rhs ) where
n = sum ps
d = length ps
rhs | h == d = tr (factorial d) * product (map fi ps)
| h < d = 0
| h > d = 666
lhs = sum
[ negateIfOdd (length rs) $ (fi (2 * sum qs n) / 2)^h * (tr $ aut part) / (tr $ aut phi * aut psi)
| ( phi@(Partition qs) , psi@(Partition rs) ) <- Set.toList (divideIntoTwo part)
]
fi :: Int -> Rational
fi = fromIntegral
tr :: Integer -> Rational
tr = fromIntegral
divideIntoTwo :: Partition -> Set (Partition,Partition)
divideIntoTwo (Partition ps) = Set.fromList $ map f (binaryTuples d) where
d = length ps
f ts = ( g ts , g (map not ts) )
g ts = Partition [ k | (b,k) <- zip ts ps , b ]
divideIntoTwoNonEmpty :: Partition -> Set (Partition,Partition)
divideIntoTwoNonEmpty p = Set.delete x $ Set.delete y $ divideIntoTwo p where
x = (emptyPartition,p)
y = (p,emptyPartition)