{-# 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
countCoarsenings :: Partition -> Map Partition Integer
countCoarsenings :: Partition -> Map Partition Integer
countCoarsenings = Partition -> Map Partition Integer
countCoarseningsNaive
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
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 ]
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
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)
countFullPreimage :: Partition -> Integer
countFullPreimage :: Partition -> Integer
countFullPreimage part :: Partition
part@(Partition [Int]
ps) = [Int] -> Integer
forall a. Integral a => [a] -> Integer
multinomial [Int]
ps