-- | Classical results: 
--
-- * Hilbert's degree formula
--
-- * some enumarative geometry computations by Schubert
--

{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}

module Math.RootLoci.Classic where

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

import Data.List

import Control.Monad

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

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

-- | Codimension of a strata. This is simply @(sum mu_i) - length(mu)@.
codim :: Partition -> Int
codim :: Partition -> Int
codim (Partition [Int]
ps) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ps

-- | Dimension of the strata. @dim = length(mu)@.
dimension :: Partition -> Int
dimension :: Partition -> Int
dimension (Partition [Int]
ps) = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ps

--------------------------------------------------------------------------------
-- * Hilbert formula

-- | Hilbert's formula for the degree of a stratum
hilbert :: Partition -> Integer
hilbert :: Partition -> Integer
hilbert part :: Partition
part@(Partition [Int]
ps) = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
numer Integer
denom 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

  numer :: Integer
numer = Int -> Integer
forall a. Integral a => a -> Integer
factorial Int
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ((Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
fi [Int]
ps)          -- d! * prod (nu_i)
  denom :: Integer
denom = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (((Int, Int) -> Integer) -> [(Int, Int)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Integer
forall a. Integral a => a -> Integer
factorial (Int -> Integer) -> ((Int, Int) -> Int) -> (Int, Int) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd) [(Int, Int)]
ies)        -- prod (e_r!)
 
  ies :: [(Int, Int)]
ies = Partition -> [(Int, Int)]
toExponentialForm Partition
part      -- (r,e_r) pairs
   
  fi :: Int -> Integer
  fi :: Int -> Integer
fi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Hilbert's degree formula, another version (as a sanity test).
hilbert2 :: Partition -> Integer
hilbert2 :: Partition -> Integer
hilbert2 part :: Partition
part@(Partition [Int]
ps) = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
numer Integer
denom where

  -- this is from FNR, opposite notation (d and n are swapped!)
  -- just to be really sure about the formula :)

  n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
es
  d :: Int
d = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ei | (Int
i,Int
ei) <- Partition -> [(Int, Int)]
toExponentialForm Partition
part ]
  es :: [Int]
es =    [ Int
ei   | (Int
i,Int
ei) <- Partition -> [(Int, Int)]
toExponentialForm Partition
part ]

  numer :: Integer
numer = Int -> Integer
forall a. Integral a => a -> Integer
factorial Int
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [ (Int -> Integer
fi Int
i)Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
ei | (Int
i,Int
ei) <- Partition -> [(Int, Int)]
toExponentialForm Partition
part ]
  denom :: Integer
denom = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [ Int -> Integer
forall a. Integral a => a -> Integer
factorial Int
ei | (Int
i,Int
ei) <- Partition -> [(Int, Int)]
toExponentialForm Partition
part ]

  fi :: Int -> Integer
  fi :: Int -> Integer
fi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
   
-- check_hilbert2 :: Bool   
-- check_hilbert2 = and [ hilbert p == hilbert2 p | n<-[0..20] , p<-partitions n ]

--------------------------------------------------------------------------------
-- * Enumerative geometry

-- | The degree of the dual curve is @d(d-1)@
degreeOfDualCurve :: Int -> Integer
degreeOfDualCurve :: Int -> Integer
degreeOfDualCurve Int
d0 
  | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2     = Integer
0
  | Bool
otherwise = Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) 
  where
    d :: Integer
d = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d0 :: Integer

-- | Number of flex lines to a generic degree @d@ plane curve
numberOfCurveFlexes :: Int -> Integer
numberOfCurveFlexes :: Int -> Integer
numberOfCurveFlexes Int
d0
  | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
3     = Integer
0
  | Bool
otherwise = Integer
3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
2)
  where
    d :: Integer
d = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d0 :: Integer

-- | Number of bitangent lines to a generic degree @d@ plane curve
numberOfCurveBiTangents :: Int -> Integer
numberOfCurveBiTangents :: Int -> Integer
numberOfCurveBiTangents Int
d0
  | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
3     = Integer
0
  | Bool
otherwise = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div ((-Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (-Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d)) Integer
2 
  where
    d :: Integer
d = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d0 :: Integer

-- | Number of 4-tangent lines to a generic degree @d@ surface (Schubert)
numberOfSurface4xTangents :: Int -> Integer
numberOfSurface4xTangents :: Int -> Integer
numberOfSurface4xTangents Int
d0
  | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
8     = Integer
0
  | Bool
otherwise = Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
4) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
5) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
6) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
7) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
dInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
6Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
dInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
7Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
30)
  where
    d :: Integer
d = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d0 :: Integer

-- | Number of lines meeting a generic degree @d@ surface at point with 5x multiplicity
numberOfSurface5xHyperflexes :: Int -> Integer
numberOfSurface5xHyperflexes :: Int -> Integer
numberOfSurface5xHyperflexes Int
d0
  | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
5     = Integer
0
  | Bool
otherwise = (Integer
35Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
dInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
200Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
dInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
240Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
d)
  where
    d :: Integer
d = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d0 :: Integer

-- | Bidegree of bitangent locus of a generic hypersurface
-- 
-- (See: Kathlen Kohn, Bernt Ivar Utstol Nodland, Paolo Tripoli: Secants, bitangents, and their congruences)
--
bidegreeOfSurfaceBiTangents :: Int -> (Integer,Integer)
bidegreeOfSurfaceBiTangents :: Int -> (Integer, Integer)
bidegreeOfSurfaceBiTangents Int
d0 
  | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
4     = ( Integer
0 , Integer
0 )
  | Bool
otherwise = ( Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
2)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
3)) Integer
2 , Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
2)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
3)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
3)) Integer
2 )
  where
    d :: Integer
d = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d0 :: Integer

-- | Bidegree of the flex locus of a generic hypersurface
--
-- (See: Kathlen Kohn, Bernt Ivar Utstol Nodland, Paolo Tripoli: Secants, bitangents, and their congruences)
--
bidegreeOfSurfaceFlexes :: Int -> (Integer,Integer)
bidegreeOfSurfaceFlexes :: Int -> (Integer, Integer)
bidegreeOfSurfaceFlexes Int
d0
  | Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
4     = ( Integer
0 , Integer
0 ) 
  | Bool
otherwise = ( Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
3) , Integer
3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*(Integer
dInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
2) )
  where
    d :: Integer
d = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d0 :: Integer

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