-- | Geometry of the degree @n!@ finite map @pi@, which just forgets the order points:
--
-- > pi : Q^n = P^1 x P^1 x ... x P^1  ->  P^n = P(Sym^n C^2)
--
-- It's clear that the degree of @pi@ restricted to an open stratum corresponding to
-- a partition @mu@ is the multinomial coefficient corresponding to @n `choose` mu@.
--
-- It is also not hard to see that the degree of @pi@ restricted to the intersection
-- of the open stratum corresponding to @mu@ with the image of the diagonal map 
-- corresponding to @nu@ equals the number of \"automorphisms\" @aut(mu) = prod (e_i!)@
-- where @mu = (1^e1 2^e2 ... k^ek)@ and the number of ways @nu@ is refinement of @mu@.
--
-- Note that for @nu=(1,1...1)@ the multinomial agrees with the number of refinements.
--
-- This module contains functions to compute these numbers.
--

{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}
module Math.RootLoci.Geometry.Forget where

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

import Data.List

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 qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)

import qualified Data.Map.Lazy as LMap

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

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

import Math.RootLoci.Misc.Common
import Math.RootLoci.Misc.PTable
-- import Math.RootLoci.Geometry.Mobius

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

-- | Given a partition, we list all coarser partitions together
-- with the number of ways the input is a refinement of the
-- coarser partition.
--
-- TODO: at the moment this is just a synonym for 'countCoarseningsNaive' ...
--
countCoarsenings :: Partition -> Map Partition Integer
countCoarsenings :: Partition -> Map Partition Integer
countCoarsenings = Partition -> Map Partition Integer
countCoarseningsNaive

-- | Count coarsenings (with multiplicities) which are shorter by just 1.
countDirectCoarsenings :: Partition -> Map Partition Integer
countDirectCoarsenings :: Partition -> Map Partition Integer
countDirectCoarsenings Partition
part = (Integer -> Integer -> Integer)
-> [(Partition, Integer)] -> Map Partition Integer
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) [(Partition, Integer)]
list where
  list :: [(Partition, Integer)]
list =  
    [ ( [(Int, Int)] -> Partition
fromExponentialForm ((Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i2,Int
1)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:(Int
i1,Int
e1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:(Int
i2,Int
e2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[(Int, Int)]
rest) , Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
e1Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
e2) )
    | ( (Int
i1,Int
e1):(Int
i2,Int
e2):[] , [(Int, Int)]
rest ) <- Int -> [(Int, Int)] -> [([(Int, Int)], [(Int, Int)])]
forall a. Int -> [a] -> [([a], [a])]
choose' Int
2 [(Int, Int)]
ies
    ] [(Partition, Integer)]
-> [(Partition, Integer)] -> [(Partition, Integer)]
forall a. [a] -> [a] -> [a]
++
    [ ( [(Int, Int)] -> Partition
fromExponentialForm ((Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i,Int
1)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:(Int
i,Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:[(Int, Int)]
rest) , Int -> Int -> Integer
forall a. Integral a => a -> a -> Integer
binomial Int
e Int
2 )
    | ( (Int
i,Int
e):[] , [(Int, Int)]
rest ) <- Int -> [(Int, Int)] -> [([(Int, Int)], [(Int, Int)])]
forall a. Int -> [a] -> [([a], [a])]
choose' Int
1 [(Int, Int)]
ies
    , Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
    ]
  ies :: [(Int, Int)]
ies = Partition -> [(Int, Int)]
toExponentialForm Partition
part 
  
--------------------------------------------------------------------------------

-- | Naive (very slow) implementation of 'countCoarsenings'.
countCoarseningsNaive :: Partition -> Map Partition Integer
countCoarseningsNaive :: Partition -> Map Partition Integer
countCoarseningsNaive = (Partition -> Map Partition Integer)
-> Partition -> Map Partition Integer
forall a. (Partition -> a) -> Partition -> a
pcache Partition -> Map Partition Integer
count where

  count :: Partition -> Map Partition Integer
count (Partition [Int]
ps) = [Partition] -> Map Partition Integer
forall b. Ord b => [b] -> Map b Integer
histogram (([[Int]] -> Partition) -> [[[Int]]] -> [Partition]
forall a b. (a -> b) -> [a] -> [b]
map [[Int]] -> Partition
f [[[Int]]]
setps) where
    d :: Int
d     = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ps
    setps :: [[[Int]]]
setps = (SetPartition -> [[Int]]) -> [SetPartition] -> [[[Int]]]
forall a b. (a -> b) -> [a] -> [b]
map SetPartition -> [[Int]]
fromSetPartition ([SetPartition] -> [[[Int]]]) -> [SetPartition] -> [[[Int]]]
forall a b. (a -> b) -> a -> b
$ Int -> [SetPartition]
setPartitions Int
d :: [[[Int]]]
    arr :: UArray Int Int
arr   = (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
1,Int
d) [Int]
ps :: UArray Int Int
    f :: [[Int]] -> Partition
f [[Int]]
iss = [Int] -> Partition
mkPartition [ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ UArray Int Int
arr UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
k | Int
k <- [Int]
is ] | [Int]
is <- [[Int]]
iss ]

-- | Given a partition @nu@, we stratify the image of the 
-- corresponding diagonal @Delta_nu@ as usual, and list
-- the degree of @pi@ restricted to these strata
--
-- This is just counting the coarsenings, multiplied by
-- the number of \"automorphisms\" of the partition.
--
countPreimage :: Partition -> Map Partition Integer
countPreimage :: Partition -> Map Partition Integer
countPreimage = (Partition -> Map Partition Integer)
-> Partition -> Map Partition Integer
forall a. (Partition -> a) -> Partition -> a
pcache Partition -> Map Partition Integer
compute where
  compute :: Partition -> Map Partition Integer
compute Partition
part = (Partition -> Integer -> Integer)
-> Map Partition Integer -> Map Partition Integer
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Partition -> Integer -> Integer
f (Partition -> Map Partition Integer
countCoarsenings Partition
part) 
  f :: Partition -> Integer -> Integer
f Partition
q Integer
c = Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Partition -> Integer
aut Partition
q

-- | The preimage counts, but the partition itself is separated out.
preimageView :: Partition -> (Integer, Map Partition Integer)
preimageView :: Partition -> (Integer, Map Partition Integer)
preimageView Partition
part = Partition
-> Map Partition Integer -> (Integer, Map Partition Integer)
forall a b. Ord a => a -> Map a b -> (b, Map a b)
unsafeDeleteLookup Partition
part (Partition -> Map Partition Integer
countPreimage Partition
part) 

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

-- | The preimage @pi^-1(x)@ of a point under the map 
-- @pi : Q^n -> P^n@ is just a multinomial coefficient
countFullPreimage :: Partition -> Integer
countFullPreimage :: Partition -> Integer
countFullPreimage part :: Partition
part@(Partition [Int]
ps) = [Int] -> Integer
forall a. Integral a => [a] -> Integer
multinomial [Int]
ps 
  
--------------------------------------------------------------------------------