{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, NoMonomorphismRestriction, ScopedTypeVariables, DeriveFunctor #-}
module Math.Combinatorics.CombinatorialHopfAlgebra where
import Prelude hiding ( (*>) )
import Data.List as L
import Data.Maybe (fromJust)
import qualified Data.Set as S
import Math.Core.Field
import Math.Core.Utils
import Math.Algebras.VectorSpace hiding (E)
import Math.Algebras.TensorProduct
import Math.Algebras.Structures
import Math.Combinatorics.Poset
import Math.CommutativeAlgebra.Polynomial
class Graded b where
grade :: b -> Int
instance Graded b => Graded (Dual b) where grade :: Dual b -> Int
grade (Dual b :: b
b) = b -> Int
forall b. Graded b => b -> Int
grade b
b
class (Eq k, Num k, Ord b, Graded b, HopfAlgebra k b) => CombinatorialHopfAlgebra k b where
zeta :: Vect k b -> Vect k ()
gradedConnectedAntipode
:: (Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode :: Vect k b -> Vect k b
gradedConnectedAntipode = (b -> Vect k b) -> Vect k b -> Vect k b
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear b -> Vect k b
forall b k.
(Graded b, Num k, Ord b, Bialgebra k b, Eq k) =>
b -> Vect k b
antipode' where
antipode' :: b -> Vect k b
antipode' b :: b
b = if b -> Int
forall b. Graded b => b -> Int
grade b
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then b -> Vect k b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
else (Vect k b -> Vect k b
forall k b. (Eq k, Num k) => Vect k b -> Vect k b
negatev (Vect k b -> Vect k b) -> (b -> Vect k b) -> b -> Vect k b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect k (Tensor b b) -> Vect k b
forall k b. Algebra k b => Vect k (Tensor b b) -> Vect k b
mult (Vect k (Tensor b b) -> Vect k b)
-> (b -> Vect k (Tensor b b)) -> b -> Vect k b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vect k b -> Vect k b
forall a. a -> a
id (Vect k b -> Vect k b)
-> (Vect k b -> Vect k b)
-> Vect k (Tensor b b)
-> Vect k (Tensor b b)
forall k a' b' a b.
(Eq k, Num k, Ord a', Ord b') =>
(Vect k a -> Vect k a')
-> (Vect k b -> Vect k b')
-> Vect k (Tensor a b)
-> Vect k (Tensor a' b')
`tf` Vect k b -> Vect k b
forall k b.
(Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode) (Vect k (Tensor b b) -> Vect k (Tensor b b))
-> (b -> Vect k (Tensor b b)) -> b -> Vect k (Tensor b b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect k (Tensor b b) -> Vect k (Tensor b b)
forall b k b. Graded b => Vect k (b, b) -> Vect k (b, b)
removeLeftGradeZero (Vect k (Tensor b b) -> Vect k (Tensor b b))
-> (b -> Vect k (Tensor b b)) -> b -> Vect k (Tensor b b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect k b -> Vect k (Tensor b b)
forall k b. Coalgebra k b => Vect k b -> Vect k (Tensor b b)
comult (Vect k b -> Vect k (Tensor b b))
-> (b -> Vect k b) -> b -> Vect k (Tensor b b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Vect k b
forall (m :: * -> *) a. Monad m => a -> m a
return) b
b
removeLeftGradeZero :: Vect k (b, b) -> Vect k (b, b)
removeLeftGradeZero (V ts :: [((b, b), k)]
ts) = [((b, b), k)] -> Vect k (b, b)
forall k b. [(b, k)] -> Vect k b
V ([((b, b), k)] -> Vect k (b, b)) -> [((b, b), k)] -> Vect k (b, b)
forall a b. (a -> b) -> a -> b
$ (((b, b), k) -> Bool) -> [((b, b), k)] -> [((b, b), k)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\((l :: b
l,r :: b
r),_) -> b -> Int
forall b. Graded b => b -> Int
grade b
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) [((b, b), k)]
ts
newtype Shuffle a = Sh [a] deriving (Shuffle a -> Shuffle a -> Bool
(Shuffle a -> Shuffle a -> Bool)
-> (Shuffle a -> Shuffle a -> Bool) -> Eq (Shuffle a)
forall a. Eq a => Shuffle a -> Shuffle a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shuffle a -> Shuffle a -> Bool
$c/= :: forall a. Eq a => Shuffle a -> Shuffle a -> Bool
== :: Shuffle a -> Shuffle a -> Bool
$c== :: forall a. Eq a => Shuffle a -> Shuffle a -> Bool
Eq,Eq (Shuffle a)
Eq (Shuffle a) =>
(Shuffle a -> Shuffle a -> Ordering)
-> (Shuffle a -> Shuffle a -> Bool)
-> (Shuffle a -> Shuffle a -> Bool)
-> (Shuffle a -> Shuffle a -> Bool)
-> (Shuffle a -> Shuffle a -> Bool)
-> (Shuffle a -> Shuffle a -> Shuffle a)
-> (Shuffle a -> Shuffle a -> Shuffle a)
-> Ord (Shuffle a)
Shuffle a -> Shuffle a -> Bool
Shuffle a -> Shuffle a -> Ordering
Shuffle a -> Shuffle a -> Shuffle a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Shuffle a)
forall a. Ord a => Shuffle a -> Shuffle a -> Bool
forall a. Ord a => Shuffle a -> Shuffle a -> Ordering
forall a. Ord a => Shuffle a -> Shuffle a -> Shuffle a
min :: Shuffle a -> Shuffle a -> Shuffle a
$cmin :: forall a. Ord a => Shuffle a -> Shuffle a -> Shuffle a
max :: Shuffle a -> Shuffle a -> Shuffle a
$cmax :: forall a. Ord a => Shuffle a -> Shuffle a -> Shuffle a
>= :: Shuffle a -> Shuffle a -> Bool
$c>= :: forall a. Ord a => Shuffle a -> Shuffle a -> Bool
> :: Shuffle a -> Shuffle a -> Bool
$c> :: forall a. Ord a => Shuffle a -> Shuffle a -> Bool
<= :: Shuffle a -> Shuffle a -> Bool
$c<= :: forall a. Ord a => Shuffle a -> Shuffle a -> Bool
< :: Shuffle a -> Shuffle a -> Bool
$c< :: forall a. Ord a => Shuffle a -> Shuffle a -> Bool
compare :: Shuffle a -> Shuffle a -> Ordering
$ccompare :: forall a. Ord a => Shuffle a -> Shuffle a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Shuffle a)
Ord,Int -> Shuffle a -> ShowS
[Shuffle a] -> ShowS
Shuffle a -> String
(Int -> Shuffle a -> ShowS)
-> (Shuffle a -> String)
-> ([Shuffle a] -> ShowS)
-> Show (Shuffle a)
forall a. Show a => Int -> Shuffle a -> ShowS
forall a. Show a => [Shuffle a] -> ShowS
forall a. Show a => Shuffle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shuffle a] -> ShowS
$cshowList :: forall a. Show a => [Shuffle a] -> ShowS
show :: Shuffle a -> String
$cshow :: forall a. Show a => Shuffle a -> String
showsPrec :: Int -> Shuffle a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Shuffle a -> ShowS
Show)
instance Graded (Shuffle a) where grade :: Shuffle a -> Int
grade (Sh xs :: [a]
xs) = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
sh :: [a] -> Vect Q (Shuffle a)
sh :: [a] -> Vect Q (Shuffle a)
sh = Shuffle a -> Vect Q (Shuffle a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Shuffle a -> Vect Q (Shuffle a))
-> ([a] -> Shuffle a) -> [a] -> Vect Q (Shuffle a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Shuffle a
forall a. [a] -> Shuffle a
Sh
shuffles :: [a] -> [a] -> [[a]]
shuffles (x :: a
x:xs :: [a]
xs) (y :: a
y:ys :: [a]
ys) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a] -> [[a]]
shuffles [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)) [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a] -> [[a]]
shuffles (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys)
shuffles xs :: [a]
xs [] = [[a]
xs]
shuffles [] ys :: [a]
ys = [[a]
ys]
instance (Eq k, Num k, Ord a) => Algebra k (Shuffle a) where
unit :: k -> Vect k (Shuffle a)
unit x :: k
x = k
x k -> Vect k (Shuffle a) -> Vect k (Shuffle a)
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Shuffle a -> Vect k (Shuffle a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Shuffle a
forall a. [a] -> Shuffle a
Sh [])
mult :: Vect k (Tensor (Shuffle a) (Shuffle a)) -> Vect k (Shuffle a)
mult = (Tensor (Shuffle a) (Shuffle a) -> Vect k (Shuffle a))
-> Vect k (Tensor (Shuffle a) (Shuffle a)) -> Vect k (Shuffle a)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor (Shuffle a) (Shuffle a) -> Vect k (Shuffle a)
forall k a.
(Num k, Ord a, Eq k) =>
(Shuffle a, Shuffle a) -> Vect k (Shuffle a)
mult' where
mult' :: (Shuffle a, Shuffle a) -> Vect k (Shuffle a)
mult' (Sh xs :: [a]
xs, Sh ys :: [a]
ys) = [Vect k (Shuffle a)] -> Vect k (Shuffle a)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Shuffle a -> Vect k (Shuffle a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Shuffle a
forall a. [a] -> Shuffle a
Sh [a]
zs) | [a]
zs <- [a] -> [a] -> [[a]]
forall a. [a] -> [a] -> [[a]]
shuffles [a]
xs [a]
ys]
deconcatenations :: [a] -> [([a], [a])]
deconcatenations xs :: [a]
xs = [[a]] -> [[a]] -> [([a], [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [[a]]
forall a. [a] -> [[a]]
inits [a]
xs) ([a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
xs)
instance (Eq k, Num k, Ord a) => Coalgebra k (Shuffle a) where
counit :: Vect k (Shuffle a) -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k)
-> (Vect k (Shuffle a) -> Vect k ()) -> Vect k (Shuffle a) -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Shuffle a -> Vect k ()) -> Vect k (Shuffle a) -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Shuffle a -> Vect k ()
forall p a. Num p => Shuffle a -> p
counit' where counit' :: Shuffle a -> p
counit' (Sh xs :: [a]
xs) = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs then 1 else 0
comult :: Vect k (Shuffle a) -> Vect k (Tensor (Shuffle a) (Shuffle a))
comult = (Shuffle a -> Vect k (Tensor (Shuffle a) (Shuffle a)))
-> Vect k (Shuffle a) -> Vect k (Tensor (Shuffle a) (Shuffle a))
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Shuffle a -> Vect k (Tensor (Shuffle a) (Shuffle a))
forall k a.
(Num k, Ord a, Eq k) =>
Shuffle a -> Vect k (Shuffle a, Shuffle a)
comult' where
comult' :: Shuffle a -> Vect k (Shuffle a, Shuffle a)
comult' (Sh xs :: [a]
xs) = [Vect k (Shuffle a, Shuffle a)] -> Vect k (Shuffle a, Shuffle a)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [(Shuffle a, Shuffle a) -> Vect k (Shuffle a, Shuffle a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Shuffle a
forall a. [a] -> Shuffle a
Sh [a]
us, [a] -> Shuffle a
forall a. [a] -> Shuffle a
Sh [a]
vs) | (us :: [a]
us, vs :: [a]
vs) <- [a] -> [([a], [a])]
forall a. [a] -> [([a], [a])]
deconcatenations [a]
xs]
instance (Eq k, Num k, Ord a) => Bialgebra k (Shuffle a) where {}
instance (Eq k, Num k, Ord a) => HopfAlgebra k (Shuffle a) where
antipode :: Vect k (Shuffle a) -> Vect k (Shuffle a)
antipode = (Shuffle a -> Vect k (Shuffle a))
-> Vect k (Shuffle a) -> Vect k (Shuffle a)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear (\(Sh xs :: [a]
xs) -> (-1)k -> Int -> k
forall a b. (Num a, Integral b) => a -> b -> a
^[a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs k -> Vect k (Shuffle a) -> Vect k (Shuffle a)
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Shuffle a -> Vect k (Shuffle a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Shuffle a
forall a. [a] -> Shuffle a
Sh ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs)))
newtype SSymF = SSymF [Int] deriving (SSymF -> SSymF -> Bool
(SSymF -> SSymF -> Bool) -> (SSymF -> SSymF -> Bool) -> Eq SSymF
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SSymF -> SSymF -> Bool
$c/= :: SSymF -> SSymF -> Bool
== :: SSymF -> SSymF -> Bool
$c== :: SSymF -> SSymF -> Bool
Eq)
instance Ord SSymF where
compare :: SSymF -> SSymF -> Ordering
compare (SSymF xs :: [Int]
xs) (SSymF ys :: [Int]
ys) = (Int, [Int]) -> (Int, [Int]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs, [Int]
xs) ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ys, [Int]
ys)
instance Show SSymF where
show :: SSymF -> String
show (SSymF xs :: [Int]
xs) = "F " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
xs
instance Graded SSymF where grade :: SSymF -> Int
grade (SSymF xs :: [Int]
xs) = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs
ssymF :: [Int] -> Vect Q SSymF
ssymF :: [Int] -> Vect Q SSymF
ssymF xs :: [Int]
xs | [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort [Int]
xs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [1..Int
n] = SSymF -> Vect Q SSymF
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymF
SSymF [Int]
xs)
| Bool
otherwise = String -> Vect Q SSymF
forall a. HasCallStack => String -> a
error "Not a permutation of [1..n]"
where n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs
shiftedConcat :: SSymF -> SSymF -> SSymF
shiftedConcat (SSymF xs :: [Int]
xs) (SSymF ys :: [Int]
ys) = let k :: Int
k = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs in [Int] -> SSymF
SSymF ([Int]
xs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) [Int]
ys)
prop_Associative :: (a -> a -> a) -> (a, a, a) -> Bool
prop_Associative f :: a -> a -> a
f (x :: a
x,y :: a
y,z :: a
z) = a -> a -> a
f a
x (a -> a -> a
f a
y a
z) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a -> a
f (a -> a -> a
f a
x a
y) a
z
instance (Eq k, Num k) => Algebra k SSymF where
unit :: k -> Vect k SSymF
unit x :: k
x = k
x k -> Vect k SSymF -> Vect k SSymF
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> SSymF -> Vect k SSymF
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymF
SSymF [])
mult :: Vect k (Tensor SSymF SSymF) -> Vect k SSymF
mult = (Tensor SSymF SSymF -> Vect k SSymF)
-> Vect k (Tensor SSymF SSymF) -> Vect k SSymF
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor SSymF SSymF -> Vect k SSymF
forall k. (Eq k, Num k) => Tensor SSymF SSymF -> Vect k SSymF
mult' where
mult' :: Tensor SSymF SSymF -> Vect k SSymF
mult' (SSymF xs :: [Int]
xs, SSymF ys :: [Int]
ys) =
let k :: Int
k = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs
in [Vect k SSymF] -> Vect k SSymF
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [SSymF -> Vect k SSymF
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymF
SSymF [Int]
zs) | [Int]
zs <- [Int] -> [Int] -> [[Int]]
forall a. [a] -> [a] -> [[a]]
shuffles [Int]
xs ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k) [Int]
ys)]
flatten :: [a] -> [a]
flatten xs :: [a]
xs = let mapping :: [(a, b)]
mapping = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a]
xs) [1..]
in [a
forall a. (Num a, Enum a) => a
y | a
x <- [a]
xs, let Just y :: a
y = a -> [(a, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x [(a, a)]
forall b. (Num b, Enum b) => [(a, b)]
mapping]
instance (Eq k, Num k) => Coalgebra k SSymF where
counit :: Vect k SSymF -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k)
-> (Vect k SSymF -> Vect k ()) -> Vect k SSymF -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SSymF -> Vect k ()) -> Vect k SSymF -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SSymF -> Vect k ()
forall p. Num p => SSymF -> p
counit' where counit' :: SSymF -> p
counit' (SSymF xs :: [Int]
xs) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs then 1 else 0
comult :: Vect k SSymF -> Vect k (Tensor SSymF SSymF)
comult = (SSymF -> Vect k (Tensor SSymF SSymF))
-> Vect k SSymF -> Vect k (Tensor SSymF SSymF)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SSymF -> Vect k (Tensor SSymF SSymF)
forall k. (Eq k, Num k) => SSymF -> Vect k (Tensor SSymF SSymF)
comult'
where comult' :: SSymF -> Vect k (Tensor SSymF SSymF)
comult' (SSymF xs :: [Int]
xs) = [Vect k (Tensor SSymF SSymF)] -> Vect k (Tensor SSymF SSymF)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Tensor SSymF SSymF -> Vect k (Tensor SSymF SSymF)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymF
SSymF ([Int] -> [Int]
forall a a. (Num a, Enum a, Ord a) => [a] -> [a]
st [Int]
us), [Int] -> SSymF
SSymF ([Int] -> [Int]
forall a a. (Num a, Enum a, Ord a) => [a] -> [a]
st [Int]
vs)) | (us :: [Int]
us, vs :: [Int]
vs) <- [Int] -> [([Int], [Int])]
forall a. [a] -> [([a], [a])]
deconcatenations [Int]
xs]
st :: [a] -> [a]
st = [a] -> [a]
forall a a. (Num a, Enum a, Ord a) => [a] -> [a]
flatten
instance (Eq k, Num k) => Bialgebra k SSymF where {}
instance (Eq k, Num k) => HopfAlgebra k SSymF where
antipode :: Vect k SSymF -> Vect k SSymF
antipode = Vect k SSymF -> Vect k SSymF
forall k b.
(Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode
instance HasInverses SSymF where
inverse :: SSymF -> SSymF
inverse (SSymF xs :: [Int]
xs) = [Int] -> SSymF
SSymF ([Int] -> SSymF) -> [Int] -> SSymF
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> [(Int, Int)]
forall a. Ord a => [a] -> [a]
L.sort ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(s :: Int
s,t :: Int
t)->(Int
t,Int
s)) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [Int]
xs
instance (Eq k, Num k) => HasPairing k SSymF SSymF where
pairing :: Vect k (Tensor SSymF SSymF) -> Vect k ()
pairing = (Tensor SSymF SSymF -> Vect k ())
-> Vect k (Tensor SSymF SSymF) -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor SSymF SSymF -> Vect k ()
forall a p. (Eq a, Num p, HasInverses a) => (a, a) -> p
pairing' where
pairing' :: (a, a) -> p
pairing' (x :: a
x,y :: a
y) = a -> a -> p
forall a p. (Eq a, Num p) => a -> a -> p
delta a
x (a -> a
forall a. HasInverses a => a -> a
inverse a
y)
newtype SSymM = SSymM [Int] deriving (SSymM -> SSymM -> Bool
(SSymM -> SSymM -> Bool) -> (SSymM -> SSymM -> Bool) -> Eq SSymM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SSymM -> SSymM -> Bool
$c/= :: SSymM -> SSymM -> Bool
== :: SSymM -> SSymM -> Bool
$c== :: SSymM -> SSymM -> Bool
Eq)
instance Ord SSymM where
compare :: SSymM -> SSymM -> Ordering
compare (SSymM xs :: [Int]
xs) (SSymM ys :: [Int]
ys) = (Int, [Int]) -> (Int, [Int]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs, [Int]
xs) ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ys, [Int]
ys)
instance Show SSymM where
show :: SSymM -> String
show (SSymM xs :: [Int]
xs) = "M " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
xs
instance Graded SSymM where grade :: SSymM -> Int
grade (SSymM xs :: [Int]
xs) = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs
ssymM :: [Int] -> Vect Q SSymM
ssymM :: [Int] -> Vect Q SSymM
ssymM xs :: [Int]
xs | [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort [Int]
xs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [1..Int
n] = SSymM -> Vect Q SSymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymM
SSymM [Int]
xs)
| Bool
otherwise = String -> Vect Q SSymM
forall a. HasCallStack => String -> a
error "Not a permutation of [1..n]"
where n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs
inversions :: [a] -> [(b, b)]
inversions xs :: [a]
xs = let ixs :: [(a, a)]
ixs = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..] [a]
xs
in [(b
i,b
j) | ((i :: b
i,xi :: a
xi),(j :: b
j,xj :: a
xj)) <- [(b, a)] -> [((b, a), (b, a))]
forall t. [t] -> [(t, t)]
pairs [(b, a)]
forall a. (Num a, Enum a) => [(a, a)]
ixs, a
xi a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
xj]
weakOrder :: [a] -> [a] -> Bool
weakOrder xs :: [a]
xs ys :: [a]
ys = [a] -> [(Integer, Integer)]
forall b a. (Num b, Enum b, Ord a) => [a] -> [(b, b)]
inversions [a]
xs [(Integer, Integer)] -> [(Integer, Integer)] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`isSubsetAsc` [a] -> [(Integer, Integer)]
forall b a. (Num b, Enum b, Ord a) => [a] -> [(b, b)]
inversions [a]
ys
mu :: ([t], t -> t -> Bool) -> t -> t -> p
mu (set :: [t]
set,po :: t -> t -> Bool
po) x :: t
x y :: t
y = t -> t -> p
forall p. Num p => t -> t -> p
mu' t
x t
y where
mu' :: t -> t -> p
mu' x :: t
x y :: t
y | t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
y = 1
| t -> t -> Bool
po t
x t
y = p -> p
forall a. Num a => a -> a
negate (p -> p) -> p -> p
forall a b. (a -> b) -> a -> b
$ [p] -> p
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [t -> t -> p
mu' t
x t
z | t
z <- [t]
set, t -> t -> Bool
po t
x t
z, t -> t -> Bool
po t
z t
y, t
z t -> t -> Bool
forall a. Eq a => a -> a -> Bool
/= t
y]
| Bool
otherwise = 0
ssymMtoF :: (Eq k, Num k) => Vect k SSymM -> Vect k SSymF
ssymMtoF :: Vect k SSymM -> Vect k SSymF
ssymMtoF = (SSymM -> Vect k SSymF) -> Vect k SSymM -> Vect k SSymF
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SSymM -> Vect k SSymF
forall k. (Eq k, Num k) => SSymM -> Vect k SSymF
ssymMtoF' where
ssymMtoF' :: SSymM -> Vect k SSymF
ssymMtoF' (SSymM u :: [Int]
u) = [Vect k SSymF] -> Vect k SSymF
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [([[Int]], [Int] -> [Int] -> Bool) -> [Int] -> [Int] -> k
forall p t. (Num p, Eq t) => ([t], t -> t -> Bool) -> t -> t -> p
mu ([[Int]]
set,[Int] -> [Int] -> Bool
forall a a. (Ord a, Ord a) => [a] -> [a] -> Bool
po) [Int]
u [Int]
v k -> Vect k SSymF -> Vect k SSymF
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> SSymF -> Vect k SSymF
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymF
SSymF [Int]
v) | [Int]
v <- [[Int]]
set, [Int] -> [Int] -> Bool
forall a a. (Ord a, Ord a) => [a] -> [a] -> Bool
po [Int]
u [Int]
v]
where set :: [[Int]]
set = [Int] -> [[Int]]
forall a. [a] -> [[a]]
L.permutations [Int]
u
po :: [a] -> [a] -> Bool
po = [a] -> [a] -> Bool
forall a a. (Ord a, Ord a) => [a] -> [a] -> Bool
weakOrder
ssymFtoM :: (Eq k, Num k) => Vect k SSymF -> Vect k SSymM
ssymFtoM :: Vect k SSymF -> Vect k SSymM
ssymFtoM = (SSymF -> Vect k SSymM) -> Vect k SSymF -> Vect k SSymM
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SSymF -> Vect k SSymM
forall k. (Eq k, Num k) => SSymF -> Vect k SSymM
ssymFtoM' where
ssymFtoM' :: SSymF -> Vect k SSymM
ssymFtoM' (SSymF u :: [Int]
u) = [Vect k SSymM] -> Vect k SSymM
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [SSymM -> Vect k SSymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymM
SSymM [Int]
v) | [Int]
v <- [[Int]]
set, [Int] -> [Int] -> Bool
forall a a. (Ord a, Ord a) => [a] -> [a] -> Bool
po [Int]
u [Int]
v]
where set :: [[Int]]
set = [Int] -> [[Int]]
forall a. [a] -> [[a]]
L.permutations [Int]
u
po :: [a] -> [a] -> Bool
po = [a] -> [a] -> Bool
forall a a. (Ord a, Ord a) => [a] -> [a] -> Bool
weakOrder
instance (Eq k, Num k) => Algebra k SSymM where
unit :: k -> Vect k SSymM
unit x :: k
x = k
x k -> Vect k SSymM -> Vect k SSymM
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> SSymM -> Vect k SSymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymM
SSymM [])
mult :: Vect k (Tensor SSymM SSymM) -> Vect k SSymM
mult = Vect k SSymF -> Vect k SSymM
forall k. (Eq k, Num k) => Vect k SSymF -> Vect k SSymM
ssymFtoM (Vect k SSymF -> Vect k SSymM)
-> (Vect k (Tensor SSymM SSymM) -> Vect k SSymF)
-> Vect k (Tensor SSymM SSymM)
-> Vect k SSymM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect k (Tensor SSymF SSymF) -> Vect k SSymF
forall k b. Algebra k b => Vect k (Tensor b b) -> Vect k b
mult (Vect k (Tensor SSymF SSymF) -> Vect k SSymF)
-> (Vect k (Tensor SSymM SSymM) -> Vect k (Tensor SSymF SSymF))
-> Vect k (Tensor SSymM SSymM)
-> Vect k SSymF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vect k SSymM -> Vect k SSymF
forall k. (Eq k, Num k) => Vect k SSymM -> Vect k SSymF
ssymMtoF (Vect k SSymM -> Vect k SSymF)
-> (Vect k SSymM -> Vect k SSymF)
-> Vect k (Tensor SSymM SSymM)
-> Vect k (Tensor SSymF SSymF)
forall k a' b' a b.
(Eq k, Num k, Ord a', Ord b') =>
(Vect k a -> Vect k a')
-> (Vect k b -> Vect k b')
-> Vect k (Tensor a b)
-> Vect k (Tensor a' b')
`tf` Vect k SSymM -> Vect k SSymF
forall k. (Eq k, Num k) => Vect k SSymM -> Vect k SSymF
ssymMtoF)
instance (Eq k, Num k) => Coalgebra k SSymM where
counit :: Vect k SSymM -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k)
-> (Vect k SSymM -> Vect k ()) -> Vect k SSymM -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SSymM -> Vect k ()) -> Vect k SSymM -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SSymM -> Vect k ()
forall p. Num p => SSymM -> p
counit' where counit' :: SSymM -> p
counit' (SSymM xs :: [Int]
xs) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs then 1 else 0
comult :: Vect k SSymM -> Vect k (Tensor SSymM SSymM)
comult = (SSymM -> Vect k (Tensor SSymM SSymM))
-> Vect k SSymM -> Vect k (Tensor SSymM SSymM)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SSymM -> Vect k (Tensor SSymM SSymM)
forall k. (Eq k, Num k) => SSymM -> Vect k (Tensor SSymM SSymM)
comult'
where comult' :: SSymM -> Vect k (Tensor SSymM SSymM)
comult' (SSymM xs :: [Int]
xs) = [Vect k (Tensor SSymM SSymM)] -> Vect k (Tensor SSymM SSymM)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Tensor SSymM SSymM -> Vect k (Tensor SSymM SSymM)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymM
SSymM ([Int] -> [Int]
forall a a. (Num a, Enum a, Ord a) => [a] -> [a]
flatten [Int]
ys), [Int] -> SSymM
SSymM ([Int] -> [Int]
forall a a. (Num a, Enum a, Ord a) => [a] -> [a]
flatten [Int]
zs))
| (ys :: [Int]
ys,zs :: [Int]
zs) <- [Int] -> [([Int], [Int])]
forall a. [a] -> [([a], [a])]
deconcatenations [Int]
xs,
[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Int
infinityInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ys) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
zs)]
infinity :: Int
infinity = Int
forall a. Bounded a => a
maxBound :: Int
instance (Eq k, Num k) => Bialgebra k SSymM where {}
instance (Eq k, Num k) => HopfAlgebra k SSymM where
antipode :: Vect k SSymM -> Vect k SSymM
antipode = Vect k SSymM -> Vect k SSymM
forall k b.
(Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode
instance (Eq k, Num k) => Algebra k (Dual SSymF) where
unit :: k -> Vect k (Dual SSymF)
unit x :: k
x = k
x k -> Vect k (Dual SSymF) -> Vect k (Dual SSymF)
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> Dual SSymF -> Vect k (Dual SSymF)
forall (m :: * -> *) a. Monad m => a -> m a
return (SSymF -> Dual SSymF
forall b. b -> Dual b
Dual ([Int] -> SSymF
SSymF []))
mult :: Vect k (Tensor (Dual SSymF) (Dual SSymF)) -> Vect k (Dual SSymF)
mult = (Tensor (Dual SSymF) (Dual SSymF) -> Vect k (Dual SSymF))
-> Vect k (Tensor (Dual SSymF) (Dual SSymF)) -> Vect k (Dual SSymF)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor (Dual SSymF) (Dual SSymF) -> Vect k (Dual SSymF)
forall k.
(Eq k, Num k) =>
Tensor (Dual SSymF) (Dual SSymF) -> Vect k (Dual SSymF)
mult' where
mult' :: Tensor (Dual SSymF) (Dual SSymF) -> Vect k (Dual SSymF)
mult' (Dual (SSymF xs :: [Int]
xs), Dual (SSymF ys :: [Int]
ys)) =
[Vect k (Dual SSymF)] -> Vect k (Dual SSymF)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [(Dual SSymF -> Vect k (Dual SSymF)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dual SSymF -> Vect k (Dual SSymF))
-> ([Int] -> Dual SSymF) -> [Int] -> Vect k (Dual SSymF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSymF -> Dual SSymF
forall b. b -> Dual b
Dual (SSymF -> Dual SSymF) -> ([Int] -> SSymF) -> [Int] -> Dual SSymF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> SSymF
SSymF) ([Int]
xs'' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
ys'')
| [Int]
xs' <- Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
r [1..Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s], let ys' :: [Int]
ys' = [Int] -> [Int] -> [Int]
forall a. Ord a => [a] -> [a] -> [a]
diffAsc [1..Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s] [Int]
xs',
[Int]
xs'' <- [Int] -> [[Int]]
forall a. [a] -> [[a]]
L.permutations [Int]
xs', [Int] -> [Int]
forall a a. (Num a, Enum a, Ord a) => [a] -> [a]
flatten [Int]
xs'' [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
xs,
[Int]
ys'' <- [Int] -> [[Int]]
forall a. [a] -> [[a]]
L.permutations [Int]
ys', [Int] -> [Int]
forall a a. (Num a, Enum a, Ord a) => [a] -> [a]
flatten [Int]
ys'' [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== [Int]
ys ]
where r :: Int
r = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs; s :: Int
s = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ys
instance (Eq k, Num k) => Coalgebra k (Dual SSymF) where
counit :: Vect k (Dual SSymF) -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k)
-> (Vect k (Dual SSymF) -> Vect k ()) -> Vect k (Dual SSymF) -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dual SSymF -> Vect k ()) -> Vect k (Dual SSymF) -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Dual SSymF -> Vect k ()
forall p. Num p => Dual SSymF -> p
counit' where counit' :: Dual SSymF -> p
counit' (Dual (SSymF xs :: [Int]
xs)) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs then 1 else 0
comult :: Vect k (Dual SSymF) -> Vect k (Tensor (Dual SSymF) (Dual SSymF))
comult = (Dual SSymF -> Vect k (Tensor (Dual SSymF) (Dual SSymF)))
-> Vect k (Dual SSymF) -> Vect k (Tensor (Dual SSymF) (Dual SSymF))
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Dual SSymF -> Vect k (Tensor (Dual SSymF) (Dual SSymF))
forall k.
(Eq k, Num k) =>
Dual SSymF -> Vect k (Tensor (Dual SSymF) (Dual SSymF))
comult' where
comult' :: Dual SSymF -> Vect k (Tensor (Dual SSymF) (Dual SSymF))
comult' (Dual (SSymF xs :: [Int]
xs)) =
[Vect k (Tensor (Dual SSymF) (Dual SSymF))]
-> Vect k (Tensor (Dual SSymF) (Dual SSymF))
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Tensor (Dual SSymF) (Dual SSymF)
-> Vect k (Tensor (Dual SSymF) (Dual SSymF))
forall (m :: * -> *) a. Monad m => a -> m a
return (SSymF -> Dual SSymF
forall b. b -> Dual b
Dual ([Int] -> SSymF
SSymF [Int]
ys), SSymF -> Dual SSymF
forall b. b -> Dual b
Dual ([Int] -> SSymF
SSymF ([Int] -> [Int]
forall a a. (Num a, Enum a, Ord a) => [a] -> [a]
flatten [Int]
zs))) | Int
i <- [0..Int
n], let (ys :: [Int]
ys,zs :: [Int]
zs) = (Int -> Bool) -> [Int] -> ([Int], [Int])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
i) [Int]
xs ]
where n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs
instance (Eq k, Num k) => Bialgebra k (Dual SSymF) where {}
instance (Eq k, Num k) => HopfAlgebra k (Dual SSymF) where
antipode :: Vect k (Dual SSymF) -> Vect k (Dual SSymF)
antipode = Vect k (Dual SSymF) -> Vect k (Dual SSymF)
forall k b.
(Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode
instance (Eq k, Num k) => HasPairing k SSymF (Dual SSymF) where
pairing :: Vect k (Tensor SSymF (Dual SSymF)) -> Vect k ()
pairing = (Tensor SSymF (Dual SSymF) -> Vect k ())
-> Vect k (Tensor SSymF (Dual SSymF)) -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor SSymF (Dual SSymF) -> Vect k ()
forall a p. (Eq a, Num p) => (a, Dual a) -> p
pairing' where
pairing' :: (a, Dual a) -> p
pairing' (x :: a
x, Dual y :: a
y) = a -> a -> p
forall a p. (Eq a, Num p) => a -> a -> p
delta a
x a
y
ssymFtoDual :: (Eq k, Num k) => Vect k SSymF -> Vect k (Dual SSymF)
ssymFtoDual :: Vect k SSymF -> Vect k (Dual SSymF)
ssymFtoDual = Vect k (Dual SSymF) -> Vect k (Dual SSymF)
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k (Dual SSymF) -> Vect k (Dual SSymF))
-> (Vect k SSymF -> Vect k (Dual SSymF))
-> Vect k SSymF
-> Vect k (Dual SSymF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SSymF -> Dual SSymF) -> Vect k SSymF -> Vect k (Dual SSymF)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SSymF -> Dual SSymF
forall b. b -> Dual b
Dual (SSymF -> Dual SSymF) -> (SSymF -> SSymF) -> SSymF -> Dual SSymF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSymF -> SSymF
forall a. HasInverses a => a -> a
inverse)
data PBT a = T (PBT a) a (PBT a) | E deriving (PBT a -> PBT a -> Bool
(PBT a -> PBT a -> Bool) -> (PBT a -> PBT a -> Bool) -> Eq (PBT a)
forall a. Eq a => PBT a -> PBT a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBT a -> PBT a -> Bool
$c/= :: forall a. Eq a => PBT a -> PBT a -> Bool
== :: PBT a -> PBT a -> Bool
$c== :: forall a. Eq a => PBT a -> PBT a -> Bool
Eq, Int -> PBT a -> ShowS
[PBT a] -> ShowS
PBT a -> String
(Int -> PBT a -> ShowS)
-> (PBT a -> String) -> ([PBT a] -> ShowS) -> Show (PBT a)
forall a. Show a => Int -> PBT a -> ShowS
forall a. Show a => [PBT a] -> ShowS
forall a. Show a => PBT a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBT a] -> ShowS
$cshowList :: forall a. Show a => [PBT a] -> ShowS
show :: PBT a -> String
$cshow :: forall a. Show a => PBT a -> String
showsPrec :: Int -> PBT a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PBT a -> ShowS
Show, a -> PBT b -> PBT a
(a -> b) -> PBT a -> PBT b
(forall a b. (a -> b) -> PBT a -> PBT b)
-> (forall a b. a -> PBT b -> PBT a) -> Functor PBT
forall a b. a -> PBT b -> PBT a
forall a b. (a -> b) -> PBT a -> PBT b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PBT b -> PBT a
$c<$ :: forall a b. a -> PBT b -> PBT a
fmap :: (a -> b) -> PBT a -> PBT b
$cfmap :: forall a b. (a -> b) -> PBT a -> PBT b
Functor)
instance Ord a => Ord (PBT a) where
compare :: PBT a -> PBT a -> Ordering
compare u :: PBT a
u v :: PBT a
v = ([Integer], [a]) -> ([Integer], [a]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PBT a -> [Integer]
forall a a. Num a => PBT a -> [a]
shapeSignature PBT a
u, PBT a -> [a]
forall a. PBT a -> [a]
prefix PBT a
u) (PBT a -> [Integer]
forall a a. Num a => PBT a -> [a]
shapeSignature PBT a
v, PBT a -> [a]
forall a. PBT a -> [a]
prefix PBT a
v)
newtype YSymF a = YSymF (PBT a) deriving (YSymF a -> YSymF a -> Bool
(YSymF a -> YSymF a -> Bool)
-> (YSymF a -> YSymF a -> Bool) -> Eq (YSymF a)
forall a. Eq a => YSymF a -> YSymF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: YSymF a -> YSymF a -> Bool
$c/= :: forall a. Eq a => YSymF a -> YSymF a -> Bool
== :: YSymF a -> YSymF a -> Bool
$c== :: forall a. Eq a => YSymF a -> YSymF a -> Bool
Eq, Eq (YSymF a)
Eq (YSymF a) =>
(YSymF a -> YSymF a -> Ordering)
-> (YSymF a -> YSymF a -> Bool)
-> (YSymF a -> YSymF a -> Bool)
-> (YSymF a -> YSymF a -> Bool)
-> (YSymF a -> YSymF a -> Bool)
-> (YSymF a -> YSymF a -> YSymF a)
-> (YSymF a -> YSymF a -> YSymF a)
-> Ord (YSymF a)
YSymF a -> YSymF a -> Bool
YSymF a -> YSymF a -> Ordering
YSymF a -> YSymF a -> YSymF a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (YSymF a)
forall a. Ord a => YSymF a -> YSymF a -> Bool
forall a. Ord a => YSymF a -> YSymF a -> Ordering
forall a. Ord a => YSymF a -> YSymF a -> YSymF a
min :: YSymF a -> YSymF a -> YSymF a
$cmin :: forall a. Ord a => YSymF a -> YSymF a -> YSymF a
max :: YSymF a -> YSymF a -> YSymF a
$cmax :: forall a. Ord a => YSymF a -> YSymF a -> YSymF a
>= :: YSymF a -> YSymF a -> Bool
$c>= :: forall a. Ord a => YSymF a -> YSymF a -> Bool
> :: YSymF a -> YSymF a -> Bool
$c> :: forall a. Ord a => YSymF a -> YSymF a -> Bool
<= :: YSymF a -> YSymF a -> Bool
$c<= :: forall a. Ord a => YSymF a -> YSymF a -> Bool
< :: YSymF a -> YSymF a -> Bool
$c< :: forall a. Ord a => YSymF a -> YSymF a -> Bool
compare :: YSymF a -> YSymF a -> Ordering
$ccompare :: forall a. Ord a => YSymF a -> YSymF a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (YSymF a)
Ord, a -> YSymF b -> YSymF a
(a -> b) -> YSymF a -> YSymF b
(forall a b. (a -> b) -> YSymF a -> YSymF b)
-> (forall a b. a -> YSymF b -> YSymF a) -> Functor YSymF
forall a b. a -> YSymF b -> YSymF a
forall a b. (a -> b) -> YSymF a -> YSymF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> YSymF b -> YSymF a
$c<$ :: forall a b. a -> YSymF b -> YSymF a
fmap :: (a -> b) -> YSymF a -> YSymF b
$cfmap :: forall a b. (a -> b) -> YSymF a -> YSymF b
Functor)
instance Show a => Show (YSymF a) where
show :: YSymF a -> String
show (YSymF t :: PBT a
t) = "F(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PBT a -> String
forall a. Show a => a -> String
show PBT a
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Graded (YSymF a) where grade :: YSymF a -> Int
grade (YSymF t :: PBT a
t) = PBT a -> Int
forall p a. Num p => PBT a -> p
nodecount PBT a
t
ysymF :: PBT a -> Vect Q (YSymF a)
ysymF :: PBT a -> Vect Q (YSymF a)
ysymF t :: PBT a
t = YSymF a -> Vect Q (YSymF a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PBT a -> YSymF a
forall a. PBT a -> YSymF a
YSymF PBT a
t)
nodecount :: PBT a -> p
nodecount (T l :: PBT a
l x :: a
x r :: PBT a
r) = 1 p -> p -> p
forall a. Num a => a -> a -> a
+ PBT a -> p
nodecount PBT a
l p -> p -> p
forall a. Num a => a -> a -> a
+ PBT a -> p
nodecount PBT a
r
nodecount E = 0
leafcount :: PBT a -> p
leafcount (T l :: PBT a
l x :: a
x r :: PBT a
r) = PBT a -> p
leafcount PBT a
l p -> p -> p
forall a. Num a => a -> a -> a
+ PBT a -> p
leafcount PBT a
r
leafcount E = 1
prefix :: PBT a -> [a]
prefix E = []
prefix (T l :: PBT a
l x :: a
x r :: PBT a
r) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: PBT a -> [a]
prefix PBT a
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ PBT a -> [a]
prefix PBT a
r
shapeSignature :: PBT a -> [a]
shapeSignature t :: PBT a
t = PBT a -> [a]
forall a. Num a => PBT a -> [a]
shapeSignature' (PBT a -> PBT a
forall a a. Num a => PBT a -> PBT a
nodeCountTree PBT a
t)
where shapeSignature' :: PBT a -> [a]
shapeSignature' E = [0]
shapeSignature' (T l :: PBT a
l x :: a
x r :: PBT a
r) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: PBT a -> [a]
shapeSignature' PBT a
r [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ PBT a -> [a]
shapeSignature' PBT a
l
nodeCountTree :: PBT a -> PBT a
nodeCountTree E = PBT a
forall a. PBT a
E
nodeCountTree (T l :: PBT a
l _ r :: PBT a
r) = PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
l' a
n PBT a
r'
where l' :: PBT a
l' = PBT a -> PBT a
nodeCountTree PBT a
l
r' :: PBT a
r' = PBT a -> PBT a
nodeCountTree PBT a
r
n :: a
n = 1 a -> a -> a
forall a. Num a => a -> a -> a
+ (case PBT a
l' of E -> 0; T _ lc _ -> a
lc) a -> a -> a
forall a. Num a => a -> a -> a
+ (case PBT a
r' of E -> 0; T _ rc _ -> a
rc)
leafCountTree :: PBT a -> PBT a
leafCountTree E = PBT a
forall a. PBT a
E
leafCountTree (T l :: PBT a
l _ r :: PBT a
r) = PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
l' a
n PBT a
r'
where l' :: PBT a
l' = PBT a -> PBT a
leafCountTree PBT a
l
r' :: PBT a
r' = PBT a -> PBT a
leafCountTree PBT a
r
n :: a
n = (case PBT a
l' of E -> 1; T _ lc _ -> a
lc) a -> a -> a
forall a. Num a => a -> a -> a
+ (case PBT a
r' of E -> 1; T _ rc _ -> a
rc)
lrCountTree :: PBT a -> PBT (b, b)
lrCountTree E = PBT (b, b)
forall a. PBT a
E
lrCountTree (T l :: PBT a
l _ r :: PBT a
r) = PBT (b, b) -> (b, b) -> PBT (b, b) -> PBT (b, b)
forall a. PBT a -> a -> PBT a -> PBT a
T PBT (b, b)
l' (b
lc,b
rc) PBT (b, b)
r'
where l' :: PBT (b, b)
l' = PBT a -> PBT (b, b)
lrCountTree PBT a
l
r' :: PBT (b, b)
r' = PBT a -> PBT (b, b)
lrCountTree PBT a
r
lc :: b
lc = case PBT (b, b)
l' of E -> 0; T _ (llc,lrc) _ -> 1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
llc b -> b -> b
forall a. Num a => a -> a -> a
+ b
lrc
rc :: b
rc = case PBT (b, b)
r' of E -> 0; T _ (rlc,rrc) _ -> 1 b -> b -> b
forall a. Num a => a -> a -> a
+ b
rlc b -> b -> b
forall a. Num a => a -> a -> a
+ b
rrc
shape :: PBT a -> PBT ()
shape :: PBT a -> PBT ()
shape t :: PBT a
t = (a -> ()) -> PBT a -> PBT ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\_ -> ()) PBT a
t
numbered :: PBT a -> PBT a
numbered t :: PBT a
t = a -> PBT a -> PBT a
forall a a. Num a => a -> PBT a -> PBT a
numbered' 1 PBT a
t
where numbered' :: a -> PBT a -> PBT a
numbered' _ E = PBT a
forall a. PBT a
E
numbered' i :: a
i (T l :: PBT a
l x :: a
x r :: PBT a
r) = let k :: p
k = PBT a -> p
forall p a. Num p => PBT a -> p
nodecount PBT a
l in PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T (a -> PBT a -> PBT a
numbered' a
i PBT a
l) (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
forall p. Num p => p
k) (a -> PBT a -> PBT a
numbered' (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
forall p. Num p => p
ka -> a -> a
forall a. Num a => a -> a -> a
+1) PBT a
r)
splits :: PBT a -> [(PBT a, PBT a)]
splits E = [(PBT a
forall a. PBT a
E,PBT a
forall a. PBT a
E)]
splits (T l :: PBT a
l x :: a
x r :: PBT a
r) = [(PBT a
u, PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
v a
x PBT a
r) | (u :: PBT a
u,v :: PBT a
v) <- PBT a -> [(PBT a, PBT a)]
splits PBT a
l] [(PBT a, PBT a)] -> [(PBT a, PBT a)] -> [(PBT a, PBT a)]
forall a. [a] -> [a] -> [a]
++ [(PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
l a
x PBT a
u, PBT a
v) | (u :: PBT a
u,v :: PBT a
v) <- PBT a -> [(PBT a, PBT a)]
splits PBT a
r]
instance (Eq k, Num k, Ord a) => Coalgebra k (YSymF a) where
counit :: Vect k (YSymF a) -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k)
-> (Vect k (YSymF a) -> Vect k ()) -> Vect k (YSymF a) -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YSymF a -> Vect k ()) -> Vect k (YSymF a) -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear YSymF a -> Vect k ()
forall p a. Num p => YSymF a -> p
counit' where counit' :: YSymF a -> p
counit' (YSymF E) = 1; counit' (YSymF (T _ _ _)) = 0
comult :: Vect k (YSymF a) -> Vect k (Tensor (YSymF a) (YSymF a))
comult = (YSymF a -> Vect k (Tensor (YSymF a) (YSymF a)))
-> Vect k (YSymF a) -> Vect k (Tensor (YSymF a) (YSymF a))
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear YSymF a -> Vect k (Tensor (YSymF a) (YSymF a))
forall k a.
(Num k, Ord a, Eq k) =>
YSymF a -> Vect k (YSymF a, YSymF a)
comult'
where comult' :: YSymF a -> Vect k (YSymF a, YSymF a)
comult' (YSymF t :: PBT a
t) = [Vect k (YSymF a, YSymF a)] -> Vect k (YSymF a, YSymF a)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [(YSymF a, YSymF a) -> Vect k (YSymF a, YSymF a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PBT a -> YSymF a
forall a. PBT a -> YSymF a
YSymF PBT a
u, PBT a -> YSymF a
forall a. PBT a -> YSymF a
YSymF PBT a
v) | (u :: PBT a
u,v :: PBT a
v) <- PBT a -> [(PBT a, PBT a)]
forall a. PBT a -> [(PBT a, PBT a)]
splits PBT a
t]
multisplits :: t -> PBT a -> [[PBT a]]
multisplits 1 t :: PBT a
t = [ [PBT a
t] ]
multisplits 2 t :: PBT a
t = [ [PBT a
u,PBT a
v] | (u :: PBT a
u,v :: PBT a
v) <- PBT a -> [(PBT a, PBT a)]
forall a. PBT a -> [(PBT a, PBT a)]
splits PBT a
t ]
multisplits n :: t
n t :: PBT a
t = [ PBT a
uPBT a -> [PBT a] -> [PBT a]
forall a. a -> [a] -> [a]
:[PBT a]
ws | (u :: PBT a
u,v :: PBT a
v) <- PBT a -> [(PBT a, PBT a)]
forall a. PBT a -> [(PBT a, PBT a)]
splits PBT a
t, [PBT a]
ws <- t -> PBT a -> [[PBT a]]
multisplits (t
nt -> t -> t
forall a. Num a => a -> a -> a
-1) PBT a
v ]
graft :: [PBT a] -> PBT a -> PBT a
graft [t :: PBT a
t] E = PBT a
t
graft ts :: [PBT a]
ts (T l :: PBT a
l x :: a
x r :: PBT a
r) = let (ls :: [PBT a]
ls,rs :: [PBT a]
rs) = Int -> [PBT a] -> ([PBT a], [PBT a])
forall a. Int -> [a] -> ([a], [a])
splitAt (PBT a -> Int
forall p a. Num p => PBT a -> p
leafcount PBT a
l) [PBT a]
ts
in PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T ([PBT a] -> PBT a -> PBT a
graft [PBT a]
ls PBT a
l) a
x ([PBT a] -> PBT a -> PBT a
graft [PBT a]
rs PBT a
r)
instance (Eq k, Num k, Ord a) => Algebra k (YSymF a) where
unit :: k -> Vect k (YSymF a)
unit x :: k
x = k
x k -> Vect k (YSymF a) -> Vect k (YSymF a)
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> YSymF a -> Vect k (YSymF a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PBT a -> YSymF a
forall a. PBT a -> YSymF a
YSymF PBT a
forall a. PBT a
E)
mult :: Vect k (Tensor (YSymF a) (YSymF a)) -> Vect k (YSymF a)
mult = (Tensor (YSymF a) (YSymF a) -> Vect k (YSymF a))
-> Vect k (Tensor (YSymF a) (YSymF a)) -> Vect k (YSymF a)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor (YSymF a) (YSymF a) -> Vect k (YSymF a)
forall a k.
(Ord a, Num k, Eq k) =>
(YSymF a, YSymF a) -> Vect k (YSymF a)
mult' where
mult' :: (YSymF a, YSymF a) -> Vect k (YSymF a)
mult' (YSymF t :: PBT a
t, YSymF u :: PBT a
u) = [Vect k (YSymF a)] -> Vect k (YSymF a)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [YSymF a -> Vect k (YSymF a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PBT a -> YSymF a
forall a. PBT a -> YSymF a
YSymF ([PBT a] -> PBT a -> PBT a
forall a. [PBT a] -> PBT a -> PBT a
graft [PBT a]
ts PBT a
u)) | [PBT a]
ts <- Integer -> PBT a -> [[PBT a]]
forall t a. (Eq t, Num t) => t -> PBT a -> [[PBT a]]
multisplits (PBT a -> Integer
forall p a. Num p => PBT a -> p
leafcount PBT a
u) PBT a
t]
instance (Eq k, Num k, Ord a) => Bialgebra k (YSymF a) where {}
instance (Eq k, Num k, Ord a) => HopfAlgebra k (YSymF a) where
antipode :: Vect k (YSymF a) -> Vect k (YSymF a)
antipode = Vect k (YSymF a) -> Vect k (YSymF a)
forall k b.
(Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode
newtype YSymM = YSymM (PBT ()) deriving (YSymM -> YSymM -> Bool
(YSymM -> YSymM -> Bool) -> (YSymM -> YSymM -> Bool) -> Eq YSymM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: YSymM -> YSymM -> Bool
$c/= :: YSymM -> YSymM -> Bool
== :: YSymM -> YSymM -> Bool
$c== :: YSymM -> YSymM -> Bool
Eq, Eq YSymM
Eq YSymM =>
(YSymM -> YSymM -> Ordering)
-> (YSymM -> YSymM -> Bool)
-> (YSymM -> YSymM -> Bool)
-> (YSymM -> YSymM -> Bool)
-> (YSymM -> YSymM -> Bool)
-> (YSymM -> YSymM -> YSymM)
-> (YSymM -> YSymM -> YSymM)
-> Ord YSymM
YSymM -> YSymM -> Bool
YSymM -> YSymM -> Ordering
YSymM -> YSymM -> YSymM
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: YSymM -> YSymM -> YSymM
$cmin :: YSymM -> YSymM -> YSymM
max :: YSymM -> YSymM -> YSymM
$cmax :: YSymM -> YSymM -> YSymM
>= :: YSymM -> YSymM -> Bool
$c>= :: YSymM -> YSymM -> Bool
> :: YSymM -> YSymM -> Bool
$c> :: YSymM -> YSymM -> Bool
<= :: YSymM -> YSymM -> Bool
$c<= :: YSymM -> YSymM -> Bool
< :: YSymM -> YSymM -> Bool
$c< :: YSymM -> YSymM -> Bool
compare :: YSymM -> YSymM -> Ordering
$ccompare :: YSymM -> YSymM -> Ordering
$cp1Ord :: Eq YSymM
Ord)
instance Show YSymM where
show :: YSymM -> String
show (YSymM t :: PBT ()
t) = "M(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PBT () -> String
forall a. Show a => a -> String
show PBT ()
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
instance Graded YSymM where grade :: YSymM -> Int
grade (YSymM t :: PBT ()
t) = PBT () -> Int
forall p a. Num p => PBT a -> p
nodecount PBT ()
t
ysymM :: PBT () -> Vect Q YSymM
ysymM :: PBT () -> Vect Q YSymM
ysymM t :: PBT ()
t = YSymM -> Vect Q YSymM
forall (m :: * -> *) a. Monad m => a -> m a
return (PBT () -> YSymM
YSymM PBT ()
t)
trees :: Int -> [PBT ()]
trees :: Int -> [PBT ()]
trees 0 = [PBT ()
forall a. PBT a
E]
trees n :: Int
n = [PBT () -> () -> PBT () -> PBT ()
forall a. PBT a -> a -> PBT a -> PBT a
T PBT ()
l () PBT ()
r | Int
i <- [0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1], PBT ()
l <- Int -> [PBT ()]
trees (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i), PBT ()
r <- Int -> [PBT ()]
trees Int
i]
tamariCovers :: PBT a -> [PBT a]
tamariCovers :: PBT a -> [PBT a]
tamariCovers E = []
tamariCovers (T t :: PBT a
t@(T u :: PBT a
u x :: a
x v :: PBT a
v) y :: a
y w :: PBT a
w) = [PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
t' a
y PBT a
w | PBT a
t' <- PBT a -> [PBT a]
forall a. PBT a -> [PBT a]
tamariCovers PBT a
t]
[PBT a] -> [PBT a] -> [PBT a]
forall a. [a] -> [a] -> [a]
++ [PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
t a
y PBT a
w' | PBT a
w' <- PBT a -> [PBT a]
forall a. PBT a -> [PBT a]
tamariCovers PBT a
w]
[PBT a] -> [PBT a] -> [PBT a]
forall a. [a] -> [a] -> [a]
++ [PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
u a
y (PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
v a
x PBT a
w)]
tamariCovers (T E x :: a
x u :: PBT a
u) = [PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
forall a. PBT a
E a
x PBT a
u' | PBT a
u' <- PBT a -> [PBT a]
forall a. PBT a -> [PBT a]
tamariCovers PBT a
u]
tamariUpSet :: Ord a => PBT a -> [PBT a]
tamariUpSet :: PBT a -> [PBT a]
tamariUpSet t :: PBT a
t = [PBT a] -> [PBT a] -> [PBT a]
forall a. Ord a => [PBT a] -> [PBT a] -> [PBT a]
upSet' [] [PBT a
t]
where upSet' :: [PBT a] -> [PBT a] -> [PBT a]
upSet' interior :: [PBT a]
interior boundary :: [PBT a]
boundary =
if [PBT a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PBT a]
boundary
then [PBT a]
interior
else let interior' :: [PBT a]
interior' = [PBT a] -> [PBT a] -> [PBT a]
forall a. Ord a => [a] -> [a] -> [a]
setUnionAsc [PBT a]
interior [PBT a]
boundary
boundary' :: [PBT a]
boundary' = [PBT a] -> [PBT a]
forall a. Ord a => [a] -> [a]
toSet ([PBT a] -> [PBT a]) -> [PBT a] -> [PBT a]
forall a b. (a -> b) -> a -> b
$ (PBT a -> [PBT a]) -> [PBT a] -> [PBT a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PBT a -> [PBT a]
forall a. PBT a -> [PBT a]
tamariCovers [PBT a]
boundary
in [PBT a] -> [PBT a] -> [PBT a]
upSet' [PBT a]
interior' [PBT a]
boundary'
tamariOrder :: PBT a -> PBT a -> Bool
tamariOrder :: PBT a -> PBT a -> Bool
tamariOrder u :: PBT a
u v :: PBT a
v = [Integer] -> [Integer] -> Bool
forall a a. (Ord a, Ord a) => [a] -> [a] -> Bool
weakOrder (PBT a -> [Integer]
forall a a. Num a => PBT a -> [a]
minPerm PBT a
u) (PBT a -> [Integer]
forall a a. Num a => PBT a -> [a]
minPerm PBT a
v)
ysymMtoF :: (Eq k, Num k) => Vect k YSymM -> Vect k (YSymF ())
ysymMtoF :: Vect k YSymM -> Vect k (YSymF ())
ysymMtoF = (YSymM -> Vect k (YSymF ())) -> Vect k YSymM -> Vect k (YSymF ())
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear YSymM -> Vect k (YSymF ())
forall k. (Eq k, Num k) => YSymM -> Vect k (YSymF ())
ysymMtoF' where
ysymMtoF' :: YSymM -> Vect k (YSymF ())
ysymMtoF' (YSymM t :: PBT ()
t) = [Vect k (YSymF ())] -> Vect k (YSymF ())
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [([PBT ()], PBT () -> PBT () -> Bool) -> PBT () -> PBT () -> k
forall p t. (Num p, Eq t) => ([t], t -> t -> Bool) -> t -> t -> p
mu ([PBT ()]
set,PBT () -> PBT () -> Bool
forall a. PBT a -> PBT a -> Bool
po) PBT ()
t PBT ()
s k -> Vect k (YSymF ()) -> Vect k (YSymF ())
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> YSymF () -> Vect k (YSymF ())
forall (m :: * -> *) a. Monad m => a -> m a
return (PBT () -> YSymF ()
forall a. PBT a -> YSymF a
YSymF PBT ()
s) | PBT ()
s <- [PBT ()]
set]
where po :: PBT a -> PBT a -> Bool
po = PBT a -> PBT a -> Bool
forall a. PBT a -> PBT a -> Bool
tamariOrder
set :: [PBT ()]
set = PBT () -> [PBT ()]
forall a. Ord a => PBT a -> [PBT a]
tamariUpSet PBT ()
t
ysymFtoM :: (Eq k, Num k) => Vect k (YSymF ()) -> Vect k YSymM
ysymFtoM :: Vect k (YSymF ()) -> Vect k YSymM
ysymFtoM = (YSymF () -> Vect k YSymM) -> Vect k (YSymF ()) -> Vect k YSymM
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear YSymF () -> Vect k YSymM
forall k. (Eq k, Num k) => YSymF () -> Vect k YSymM
ysymFtoM' where
ysymFtoM' :: YSymF () -> Vect k YSymM
ysymFtoM' (YSymF t :: PBT ()
t) = [Vect k YSymM] -> Vect k YSymM
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [YSymM -> Vect k YSymM
forall (m :: * -> *) a. Monad m => a -> m a
return (PBT () -> YSymM
YSymM PBT ()
s) | PBT ()
s <- PBT () -> [PBT ()]
forall a. Ord a => PBT a -> [PBT a]
tamariUpSet PBT ()
t]
instance (Eq k, Num k) => Algebra k YSymM where
unit :: k -> Vect k YSymM
unit x :: k
x = k
x k -> Vect k YSymM -> Vect k YSymM
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> YSymM -> Vect k YSymM
forall (m :: * -> *) a. Monad m => a -> m a
return (PBT () -> YSymM
YSymM PBT ()
forall a. PBT a
E)
mult :: Vect k (Tensor YSymM YSymM) -> Vect k YSymM
mult = Vect k (YSymF ()) -> Vect k YSymM
forall k. (Eq k, Num k) => Vect k (YSymF ()) -> Vect k YSymM
ysymFtoM (Vect k (YSymF ()) -> Vect k YSymM)
-> (Vect k (Tensor YSymM YSymM) -> Vect k (YSymF ()))
-> Vect k (Tensor YSymM YSymM)
-> Vect k YSymM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect k (Tensor (YSymF ()) (YSymF ())) -> Vect k (YSymF ())
forall k b. Algebra k b => Vect k (Tensor b b) -> Vect k b
mult (Vect k (Tensor (YSymF ()) (YSymF ())) -> Vect k (YSymF ()))
-> (Vect k (Tensor YSymM YSymM)
-> Vect k (Tensor (YSymF ()) (YSymF ())))
-> Vect k (Tensor YSymM YSymM)
-> Vect k (YSymF ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vect k YSymM -> Vect k (YSymF ())
forall k. (Eq k, Num k) => Vect k YSymM -> Vect k (YSymF ())
ysymMtoF (Vect k YSymM -> Vect k (YSymF ()))
-> (Vect k YSymM -> Vect k (YSymF ()))
-> Vect k (Tensor YSymM YSymM)
-> Vect k (Tensor (YSymF ()) (YSymF ()))
forall k a' b' a b.
(Eq k, Num k, Ord a', Ord b') =>
(Vect k a -> Vect k a')
-> (Vect k b -> Vect k b')
-> Vect k (Tensor a b)
-> Vect k (Tensor a' b')
`tf` Vect k YSymM -> Vect k (YSymF ())
forall k. (Eq k, Num k) => Vect k YSymM -> Vect k (YSymF ())
ysymMtoF)
instance (Eq k, Num k) => Coalgebra k YSymM where
counit :: Vect k YSymM -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k)
-> (Vect k YSymM -> Vect k ()) -> Vect k YSymM -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YSymM -> Vect k ()) -> Vect k YSymM -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear YSymM -> Vect k ()
forall p. Num p => YSymM -> p
counit' where counit' :: YSymM -> p
counit' (YSymM E) = 1; counit' (YSymM (T _ _ _)) = 0
comult :: Vect k YSymM -> Vect k (Tensor YSymM YSymM)
comult = (YSymM -> Vect k (Tensor YSymM YSymM))
-> Vect k YSymM -> Vect k (Tensor YSymM YSymM)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear YSymM -> Vect k (Tensor YSymM YSymM)
forall k. (Eq k, Num k) => YSymM -> Vect k (Tensor YSymM YSymM)
comult' where
comult' :: YSymM -> Vect k (Tensor YSymM YSymM)
comult' (YSymM t :: PBT ()
t) = [Vect k (Tensor YSymM YSymM)] -> Vect k (Tensor YSymM YSymM)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Tensor YSymM YSymM -> Vect k (Tensor YSymM YSymM)
forall (m :: * -> *) a. Monad m => a -> m a
return (PBT () -> YSymM
YSymM PBT ()
r, PBT () -> YSymM
YSymM PBT ()
s) | (rs :: [PBT ()]
rs,ss :: [PBT ()]
ss) <- [PBT ()] -> [([PBT ()], [PBT ()])]
forall a. [a] -> [([a], [a])]
deconcatenations (PBT () -> [PBT ()]
forall a. PBT a -> [PBT a]
underDecomposition PBT ()
t),
let r :: PBT ()
r = (PBT () -> PBT () -> PBT ()) -> PBT () -> [PBT ()] -> PBT ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl PBT () -> PBT () -> PBT ()
forall a. PBT a -> PBT a -> PBT a
under PBT ()
forall a. PBT a
E [PBT ()]
rs, let s :: PBT ()
s = (PBT () -> PBT () -> PBT ()) -> PBT () -> [PBT ()] -> PBT ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl PBT () -> PBT () -> PBT ()
forall a. PBT a -> PBT a -> PBT a
under PBT ()
forall a. PBT a
E [PBT ()]
ss]
instance (Eq k, Num k) => Bialgebra k YSymM where {}
instance (Eq k, Num k) => HopfAlgebra k YSymM where
antipode :: Vect k YSymM -> Vect k YSymM
antipode = Vect k YSymM -> Vect k YSymM
forall k b.
(Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode
compositions :: Int -> [[Int]]
compositions :: Int -> [[Int]]
compositions 0 = [[]]
compositions n :: Int
n = [Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is | Int
i <- [1..Int
n], [Int]
is <- Int -> [[Int]]
compositions (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)]
quasiShuffles :: [Int] -> [Int] -> [[Int]]
quasiShuffles :: [Int] -> [Int] -> [[Int]]
quasiShuffles (x :: Int
x:xs :: [Int]
xs) (y :: Int
y:ys :: [Int]
ys) = ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int] -> [[Int]]
quasiShuffles [Int]
xs (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ys)) [[Int]] -> [[Int]] -> [[Int]]
forall a. [a] -> [a] -> [a]
++
([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int] -> [[Int]]
quasiShuffles [Int]
xs [Int]
ys) [[Int]] -> [[Int]] -> [[Int]]
forall a. [a] -> [a] -> [a]
++
([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int] -> [[Int]]
quasiShuffles (Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs) [Int]
ys)
quasiShuffles xs :: [Int]
xs [] = [[Int]
xs]
quasiShuffles [] ys :: [Int]
ys = [[Int]
ys]
newtype QSymM = QSymM [Int] deriving (QSymM -> QSymM -> Bool
(QSymM -> QSymM -> Bool) -> (QSymM -> QSymM -> Bool) -> Eq QSymM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QSymM -> QSymM -> Bool
$c/= :: QSymM -> QSymM -> Bool
== :: QSymM -> QSymM -> Bool
$c== :: QSymM -> QSymM -> Bool
Eq)
instance Ord QSymM where
compare :: QSymM -> QSymM -> Ordering
compare (QSymM xs :: [Int]
xs) (QSymM ys :: [Int]
ys) = (Int, [Int]) -> (Int, [Int]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs, [Int]
xs) ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ys, [Int]
ys)
instance Show QSymM where
show :: QSymM -> String
show (QSymM xs :: [Int]
xs) = "M " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
xs
instance Graded QSymM where grade :: QSymM -> Int
grade (QSymM xs :: [Int]
xs) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs
qsymM :: [Int] -> Vect Q QSymM
qsymM :: [Int] -> Vect Q QSymM
qsymM xs :: [Int]
xs | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>0) [Int]
xs = QSymM -> Vect Q QSymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> QSymM
QSymM [Int]
xs)
| Bool
otherwise = String -> Vect Q QSymM
forall a. HasCallStack => String -> a
error "qsymM: not a composition"
instance (Eq k, Num k) => Algebra k QSymM where
unit :: k -> Vect k QSymM
unit x :: k
x = k
x k -> Vect k QSymM -> Vect k QSymM
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> QSymM -> Vect k QSymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> QSymM
QSymM [])
mult :: Vect k (Tensor QSymM QSymM) -> Vect k QSymM
mult = (Tensor QSymM QSymM -> Vect k QSymM)
-> Vect k (Tensor QSymM QSymM) -> Vect k QSymM
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor QSymM QSymM -> Vect k QSymM
forall k. (Eq k, Num k) => Tensor QSymM QSymM -> Vect k QSymM
mult' where
mult' :: Tensor QSymM QSymM -> Vect k QSymM
mult' (QSymM alpha :: [Int]
alpha, QSymM beta :: [Int]
beta) = [Vect k QSymM] -> Vect k QSymM
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [QSymM -> Vect k QSymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> QSymM
QSymM [Int]
gamma) | [Int]
gamma <- [Int] -> [Int] -> [[Int]]
quasiShuffles [Int]
alpha [Int]
beta]
instance (Eq k, Num k) => Coalgebra k QSymM where
counit :: Vect k QSymM -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k)
-> (Vect k QSymM -> Vect k ()) -> Vect k QSymM -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QSymM -> Vect k ()) -> Vect k QSymM -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear QSymM -> Vect k ()
forall p. Num p => QSymM -> p
counit' where counit' :: QSymM -> p
counit' (QSymM alpha :: [Int]
alpha) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
alpha then 1 else 0
comult :: Vect k QSymM -> Vect k (Tensor QSymM QSymM)
comult = (QSymM -> Vect k (Tensor QSymM QSymM))
-> Vect k QSymM -> Vect k (Tensor QSymM QSymM)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear QSymM -> Vect k (Tensor QSymM QSymM)
forall k. (Eq k, Num k) => QSymM -> Vect k (Tensor QSymM QSymM)
comult' where
comult' :: QSymM -> Vect k (Tensor QSymM QSymM)
comult' (QSymM gamma :: [Int]
gamma) = [Vect k (Tensor QSymM QSymM)] -> Vect k (Tensor QSymM QSymM)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Tensor QSymM QSymM -> Vect k (Tensor QSymM QSymM)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> QSymM
QSymM [Int]
alpha, [Int] -> QSymM
QSymM [Int]
beta) | (alpha :: [Int]
alpha,beta :: [Int]
beta) <- [Int] -> [([Int], [Int])]
forall a. [a] -> [([a], [a])]
deconcatenations [Int]
gamma]
instance (Eq k, Num k) => Bialgebra k QSymM where {}
instance (Eq k, Num k) => HopfAlgebra k QSymM where
antipode :: Vect k QSymM -> Vect k QSymM
antipode = Vect k QSymM -> Vect k QSymM
forall k b.
(Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode
coarsenings :: [a] -> [[a]]
coarsenings (x1 :: a
x1:x2 :: a
x2:xs :: [a]
xs) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [[a]]
coarsenings (a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)) [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [a] -> [[a]]
coarsenings ((a
x1a -> a -> a
forall a. Num a => a -> a -> a
+a
x2)a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
coarsenings xs :: [a]
xs = [[a]
xs]
refinements :: [Int] -> [[Int]]
refinements (x :: Int
x:xs :: [Int]
xs) = [[Int]
y[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int]
ys | [Int]
y <- Int -> [[Int]]
compositions Int
x, [Int]
ys <- [Int] -> [[Int]]
refinements [Int]
xs]
refinements [] = [[]]
newtype QSymF = QSymF [Int] deriving (QSymF -> QSymF -> Bool
(QSymF -> QSymF -> Bool) -> (QSymF -> QSymF -> Bool) -> Eq QSymF
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QSymF -> QSymF -> Bool
$c/= :: QSymF -> QSymF -> Bool
== :: QSymF -> QSymF -> Bool
$c== :: QSymF -> QSymF -> Bool
Eq)
instance Ord QSymF where
compare :: QSymF -> QSymF -> Ordering
compare (QSymF xs :: [Int]
xs) (QSymF ys :: [Int]
ys) = (Int, [Int]) -> (Int, [Int]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs, [Int]
xs) ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ys, [Int]
ys)
instance Show QSymF where
show :: QSymF -> String
show (QSymF xs :: [Int]
xs) = "F " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
xs
instance Graded QSymF where grade :: QSymF -> Int
grade (QSymF xs :: [Int]
xs) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs
qsymF :: [Int] -> Vect Q QSymF
qsymF :: [Int] -> Vect Q QSymF
qsymF xs :: [Int]
xs | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>0) [Int]
xs = QSymF -> Vect Q QSymF
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> QSymF
QSymF [Int]
xs)
| Bool
otherwise = String -> Vect Q QSymF
forall a. HasCallStack => String -> a
error "qsymF: not a composition"
qsymMtoF :: (Eq k, Num k) => Vect k QSymM -> Vect k QSymF
qsymMtoF :: Vect k QSymM -> Vect k QSymF
qsymMtoF = (QSymM -> Vect k QSymF) -> Vect k QSymM -> Vect k QSymF
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear QSymM -> Vect k QSymF
forall k. (Eq k, Num k) => QSymM -> Vect k QSymF
qsymMtoF' where
qsymMtoF' :: QSymM -> Vect k QSymF
qsymMtoF' (QSymM alpha :: [Int]
alpha) = [Vect k QSymF] -> Vect k QSymF
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [(-1) k -> Int -> k
forall a b. (Num a, Integral b) => a -> b -> a
^ ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
beta Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
alpha) k -> Vect k QSymF -> Vect k QSymF
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> QSymF -> Vect k QSymF
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> QSymF
QSymF [Int]
beta) | [Int]
beta <- [Int] -> [[Int]]
refinements [Int]
alpha]
qsymFtoM :: (Eq k, Num k) => Vect k QSymF -> Vect k QSymM
qsymFtoM :: Vect k QSymF -> Vect k QSymM
qsymFtoM = (QSymF -> Vect k QSymM) -> Vect k QSymF -> Vect k QSymM
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear QSymF -> Vect k QSymM
forall k. (Eq k, Num k) => QSymF -> Vect k QSymM
qsymFtoM' where
qsymFtoM' :: QSymF -> Vect k QSymM
qsymFtoM' (QSymF alpha :: [Int]
alpha) = [Vect k QSymM] -> Vect k QSymM
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [QSymM -> Vect k QSymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> QSymM
QSymM [Int]
beta) | [Int]
beta <- [Int] -> [[Int]]
refinements [Int]
alpha]
instance (Eq k, Num k) => Algebra k QSymF where
unit :: k -> Vect k QSymF
unit x :: k
x = k
x k -> Vect k QSymF -> Vect k QSymF
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> QSymF -> Vect k QSymF
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> QSymF
QSymF [])
mult :: Vect k (Tensor QSymF QSymF) -> Vect k QSymF
mult = Vect k QSymM -> Vect k QSymF
forall k. (Eq k, Num k) => Vect k QSymM -> Vect k QSymF
qsymMtoF (Vect k QSymM -> Vect k QSymF)
-> (Vect k (Tensor QSymF QSymF) -> Vect k QSymM)
-> Vect k (Tensor QSymF QSymF)
-> Vect k QSymF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect k (Tensor QSymM QSymM) -> Vect k QSymM
forall k b. Algebra k b => Vect k (Tensor b b) -> Vect k b
mult (Vect k (Tensor QSymM QSymM) -> Vect k QSymM)
-> (Vect k (Tensor QSymF QSymF) -> Vect k (Tensor QSymM QSymM))
-> Vect k (Tensor QSymF QSymF)
-> Vect k QSymM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vect k QSymF -> Vect k QSymM
forall k. (Eq k, Num k) => Vect k QSymF -> Vect k QSymM
qsymFtoM (Vect k QSymF -> Vect k QSymM)
-> (Vect k QSymF -> Vect k QSymM)
-> Vect k (Tensor QSymF QSymF)
-> Vect k (Tensor QSymM QSymM)
forall k a' b' a b.
(Eq k, Num k, Ord a', Ord b') =>
(Vect k a -> Vect k a')
-> (Vect k b -> Vect k b')
-> Vect k (Tensor a b)
-> Vect k (Tensor a' b')
`tf` Vect k QSymF -> Vect k QSymM
forall k. (Eq k, Num k) => Vect k QSymF -> Vect k QSymM
qsymFtoM)
instance (Eq k, Num k) => Coalgebra k QSymF where
counit :: Vect k QSymF -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k)
-> (Vect k QSymF -> Vect k ()) -> Vect k QSymF -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QSymF -> Vect k ()) -> Vect k QSymF -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear QSymF -> Vect k ()
forall p. Num p => QSymF -> p
counit' where counit' :: QSymF -> p
counit' (QSymF xs :: [Int]
xs) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
xs then 1 else 0
comult :: Vect k QSymF -> Vect k (Tensor QSymF QSymF)
comult = (Vect k QSymM -> Vect k QSymF
forall k. (Eq k, Num k) => Vect k QSymM -> Vect k QSymF
qsymMtoF (Vect k QSymM -> Vect k QSymF)
-> (Vect k QSymM -> Vect k QSymF)
-> Vect k (Tensor QSymM QSymM)
-> Vect k (Tensor QSymF QSymF)
forall k a' b' a b.
(Eq k, Num k, Ord a', Ord b') =>
(Vect k a -> Vect k a')
-> (Vect k b -> Vect k b')
-> Vect k (Tensor a b)
-> Vect k (Tensor a' b')
`tf` Vect k QSymM -> Vect k QSymF
forall k. (Eq k, Num k) => Vect k QSymM -> Vect k QSymF
qsymMtoF) (Vect k (Tensor QSymM QSymM) -> Vect k (Tensor QSymF QSymF))
-> (Vect k QSymF -> Vect k (Tensor QSymM QSymM))
-> Vect k QSymF
-> Vect k (Tensor QSymF QSymF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect k QSymM -> Vect k (Tensor QSymM QSymM)
forall k b. Coalgebra k b => Vect k b -> Vect k (Tensor b b)
comult (Vect k QSymM -> Vect k (Tensor QSymM QSymM))
-> (Vect k QSymF -> Vect k QSymM)
-> Vect k QSymF
-> Vect k (Tensor QSymM QSymM)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vect k QSymF -> Vect k QSymM
forall k. (Eq k, Num k) => Vect k QSymF -> Vect k QSymM
qsymFtoM
instance (Eq k, Num k) => Bialgebra k QSymF where {}
instance (Eq k, Num k) => HopfAlgebra k QSymF where
antipode :: Vect k QSymF -> Vect k QSymF
antipode = Vect k QSymF -> Vect k QSymF
forall k b.
(Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode
qsymPoly :: Int -> [Int] -> GlexPoly Q String
qsymPoly :: Int -> [Int] -> GlexPoly Q String
qsymPoly n :: Int
n is :: [Int]
is = [GlexPoly Q String] -> GlexPoly Q String
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [[GlexPoly Q String] -> GlexPoly Q String
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ((GlexPoly Q String -> Int -> GlexPoly Q String)
-> [GlexPoly Q String] -> [Int] -> [GlexPoly Q String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith GlexPoly Q String -> Int -> GlexPoly Q String
forall a b. (Num a, Integral b) => a -> b -> a
(^) [GlexPoly Q String]
xs' [Int]
is) | [GlexPoly Q String]
xs' <- Int -> [GlexPoly Q String] -> [[GlexPoly Q String]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
r [GlexPoly Q String]
xs]
where xs :: [GlexPoly Q String]
xs = [String -> GlexPoly Q String
forall v. v -> GlexPoly Q v
glexvar ("x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i) | Int
i <- [1..Int
n] ]
r :: Int
r = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
is
newtype SymM = SymM [Int] deriving (SymM -> SymM -> Bool
(SymM -> SymM -> Bool) -> (SymM -> SymM -> Bool) -> Eq SymM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymM -> SymM -> Bool
$c/= :: SymM -> SymM -> Bool
== :: SymM -> SymM -> Bool
$c== :: SymM -> SymM -> Bool
Eq,Int -> SymM -> ShowS
[SymM] -> ShowS
SymM -> String
(Int -> SymM -> ShowS)
-> (SymM -> String) -> ([SymM] -> ShowS) -> Show SymM
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymM] -> ShowS
$cshowList :: [SymM] -> ShowS
show :: SymM -> String
$cshow :: SymM -> String
showsPrec :: Int -> SymM -> ShowS
$cshowsPrec :: Int -> SymM -> ShowS
Show)
instance Ord SymM where
compare :: SymM -> SymM -> Ordering
compare (SymM xs :: [Int]
xs) (SymM ys :: [Int]
ys) = (Int, [Int]) -> (Int, [Int]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs, [Int]
ys) ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ys, [Int]
xs)
instance Graded SymM where grade :: SymM -> Int
grade (SymM xs :: [Int]
xs) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs
symM :: [Int] -> Vect Q SymM
symM :: [Int] -> Vect Q SymM
symM xs :: [Int]
xs | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>0) [Int]
xs = SymM -> Vect Q SymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymM
SymM ([Int] -> SymM) -> [Int] -> SymM
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortDesc [Int]
xs)
| Bool
otherwise = String -> Vect Q SymM
forall a. HasCallStack => String -> a
error "symM: not a partition"
instance (Eq k, Num k) => Algebra k SymM where
unit :: k -> Vect k SymM
unit x :: k
x = k
x k -> Vect k SymM -> Vect k SymM
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> SymM -> Vect k SymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymM
SymM [])
mult :: Vect k (Tensor SymM SymM) -> Vect k SymM
mult = (Tensor SymM SymM -> Vect k SymM)
-> Vect k (Tensor SymM SymM) -> Vect k SymM
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor SymM SymM -> Vect k SymM
forall k. (Eq k, Num k) => Tensor SymM SymM -> Vect k SymM
mult' where
mult' :: Tensor SymM SymM -> Vect k SymM
mult' (SymM lambda :: [Int]
lambda, SymM mu :: [Int]
mu) = [Vect k SymM] -> Vect k SymM
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [SymM -> Vect k SymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymM
SymM [Int]
nu) | [Int]
nu <- [Int] -> [Int] -> [[Int]]
symMult [Int]
lambda [Int]
mu]
compositionsFromPartition :: [a] -> [[a]]
compositionsFromPartition = ([a] -> [[a]] -> [[a]]) -> [[a]] -> [[a]] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\l :: [a]
l rs :: [[a]]
rs -> ([a] -> [[a]]) -> [[a]] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([a] -> [a] -> [[a]]
forall a. [a] -> [a] -> [[a]]
shuffles [a]
l) [[a]]
rs) [[]] ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
L.group
symMult :: [Int] -> [Int] -> [[Int]]
symMult xs :: [Int]
xs ys :: [Int]
ys = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Int] -> Bool
forall t. Ord t => [t] -> Bool
isWeaklyDecreasing ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [[[Int]]] -> [[Int]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[[Int] -> [Int] -> [[Int]]
quasiShuffles [Int]
xs' [Int]
ys' | [Int]
xs' <- [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
compositionsFromPartition [Int]
xs, [Int]
ys' <- [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
compositionsFromPartition [Int]
ys]
instance (Eq k, Num k) => Coalgebra k SymM where
counit :: Vect k SymM -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k) -> (Vect k SymM -> Vect k ()) -> Vect k SymM -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymM -> Vect k ()) -> Vect k SymM -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SymM -> Vect k ()
forall p. Num p => SymM -> p
counit' where counit' :: SymM -> p
counit' (SymM lambda :: [Int]
lambda) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
lambda then 1 else 0
comult :: Vect k SymM -> Vect k (Tensor SymM SymM)
comult = (SymM -> Vect k (Tensor SymM SymM))
-> Vect k SymM -> Vect k (Tensor SymM SymM)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SymM -> Vect k (Tensor SymM SymM)
forall k. (Eq k, Num k) => SymM -> Vect k (Tensor SymM SymM)
comult' where
comult' :: SymM -> Vect k (Tensor SymM SymM)
comult' (SymM lambda :: [Int]
lambda) = [Vect k (Tensor SymM SymM)] -> Vect k (Tensor SymM SymM)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Tensor SymM SymM -> Vect k (Tensor SymM SymM)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymM
SymM [Int]
mu, [Int] -> SymM
SymM [Int]
nu) | [Int]
mu <- [[Int]] -> [[Int]]
forall a. Ord a => [a] -> [a]
toSet ([Int] -> [[Int]]
forall a. [a] -> [[a]]
powersetdfs [Int]
lambda), let nu :: [Int]
nu = [Int] -> [Int] -> [Int]
forall a. Ord a => [a] -> [a] -> [a]
diffDesc [Int]
lambda [Int]
mu]
instance (Eq k, Num k) => Bialgebra k SymM where {}
instance (Eq k, Num k) => HopfAlgebra k SymM where
antipode :: Vect k SymM -> Vect k SymM
antipode = Vect k SymM -> Vect k SymM
forall k b.
(Eq k, Num k, Ord b, Bialgebra k b, Graded b) =>
Vect k b -> Vect k b
gradedConnectedAntipode
newtype SymE = SymE [Int] deriving (SymE -> SymE -> Bool
(SymE -> SymE -> Bool) -> (SymE -> SymE -> Bool) -> Eq SymE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymE -> SymE -> Bool
$c/= :: SymE -> SymE -> Bool
== :: SymE -> SymE -> Bool
$c== :: SymE -> SymE -> Bool
Eq,Eq SymE
Eq SymE =>
(SymE -> SymE -> Ordering)
-> (SymE -> SymE -> Bool)
-> (SymE -> SymE -> Bool)
-> (SymE -> SymE -> Bool)
-> (SymE -> SymE -> Bool)
-> (SymE -> SymE -> SymE)
-> (SymE -> SymE -> SymE)
-> Ord SymE
SymE -> SymE -> Bool
SymE -> SymE -> Ordering
SymE -> SymE -> SymE
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SymE -> SymE -> SymE
$cmin :: SymE -> SymE -> SymE
max :: SymE -> SymE -> SymE
$cmax :: SymE -> SymE -> SymE
>= :: SymE -> SymE -> Bool
$c>= :: SymE -> SymE -> Bool
> :: SymE -> SymE -> Bool
$c> :: SymE -> SymE -> Bool
<= :: SymE -> SymE -> Bool
$c<= :: SymE -> SymE -> Bool
< :: SymE -> SymE -> Bool
$c< :: SymE -> SymE -> Bool
compare :: SymE -> SymE -> Ordering
$ccompare :: SymE -> SymE -> Ordering
$cp1Ord :: Eq SymE
Ord,Int -> SymE -> ShowS
[SymE] -> ShowS
SymE -> String
(Int -> SymE -> ShowS)
-> (SymE -> String) -> ([SymE] -> ShowS) -> Show SymE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymE] -> ShowS
$cshowList :: [SymE] -> ShowS
show :: SymE -> String
$cshow :: SymE -> String
showsPrec :: Int -> SymE -> ShowS
$cshowsPrec :: Int -> SymE -> ShowS
Show)
instance Graded SymE where grade :: SymE -> Int
grade (SymE xs :: [Int]
xs) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs
symE :: [Int] -> Vect Q SymE
symE :: [Int] -> Vect Q SymE
symE xs :: [Int]
xs | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>0) [Int]
xs = SymE -> Vect Q SymE
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymE
SymE ([Int] -> SymE) -> [Int] -> SymE
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortDesc [Int]
xs)
| Bool
otherwise = String -> Vect Q SymE
forall a. HasCallStack => String -> a
error "symE: not a partition"
instance (Eq k, Num k) => Algebra k SymE where
unit :: k -> Vect k SymE
unit x :: k
x = k
x k -> Vect k SymE -> Vect k SymE
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> SymE -> Vect k SymE
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymE
SymE [])
mult :: Vect k (Tensor SymE SymE) -> Vect k SymE
mult = (Tensor SymE SymE -> Vect k SymE)
-> Vect k (Tensor SymE SymE) -> Vect k SymE
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear (\(SymE lambda :: [Int]
lambda, SymE mu :: [Int]
mu) -> SymE -> Vect k SymE
forall (m :: * -> *) a. Monad m => a -> m a
return (SymE -> Vect k SymE) -> SymE -> Vect k SymE
forall a b. (a -> b) -> a -> b
$ [Int] -> SymE
SymE ([Int] -> SymE) -> [Int] -> SymE
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int]
forall a. Ord a => [a] -> [a] -> [a]
multisetSumDesc [Int]
lambda [Int]
mu)
instance (Eq k, Num k) => Coalgebra k SymE where
counit :: Vect k SymE -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k) -> (Vect k SymE -> Vect k ()) -> Vect k SymE -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymE -> Vect k ()) -> Vect k SymE -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SymE -> Vect k ()
forall p. Num p => SymE -> p
counit' where counit' :: SymE -> p
counit' (SymE lambda :: [Int]
lambda) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
lambda then 1 else 0
comult :: Vect k SymE -> Vect k (Tensor SymE SymE)
comult = (SymE -> Vect k (Tensor SymE SymE))
-> Vect k SymE -> Vect k (Tensor SymE SymE)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SymE -> Vect k (Tensor SymE SymE)
forall k. (Eq k, Num k) => SymE -> Vect k (Tensor SymE SymE)
comult' where
comult' :: SymE -> Vect k (Tensor SymE SymE)
comult' (SymE [n :: Int
n]) = [Vect k (Tensor SymE SymE)] -> Vect k (Tensor SymE SymE)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Tensor SymE SymE -> Vect k (Tensor SymE SymE)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> SymE
e Int
i, Int -> SymE
e (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)) | Int
i <- [0..Int
n] ]
comult' (SymE lambda :: [Int]
lambda) = [Vect k (Tensor SymE SymE)] -> Vect k (Tensor SymE SymE)
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [SymE -> Vect k (Tensor SymE SymE)
comult' ([Int] -> SymE
SymE [Int
n]) | Int
n <- [Int]
lambda]
e :: Int -> SymE
e 0 = [Int] -> SymE
SymE []
e i :: Int
i = [Int] -> SymE
SymE [Int
i]
instance (Eq k, Num k) => Bialgebra k SymE where {}
symEtoM :: (Eq k, Num k) => Vect k SymE -> Vect k SymM
symEtoM :: Vect k SymE -> Vect k SymM
symEtoM = (SymE -> Vect k SymM) -> Vect k SymE -> Vect k SymM
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SymE -> Vect k SymM
forall (m :: * -> *). (Monad m, Num (m SymM)) => SymE -> m SymM
symEtoM' where
symEtoM' :: SymE -> m SymM
symEtoM' (SymE [n :: Int
n]) = SymM -> m SymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymM
SymM (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n 1))
symEtoM' (SymE lambda :: [Int]
lambda) = [m SymM] -> m SymM
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [SymE -> m SymM
symEtoM' ([Int] -> SymE
SymE [Int
p]) | Int
p <- [Int]
lambda]
newtype SymH = SymH [Int] deriving (SymH -> SymH -> Bool
(SymH -> SymH -> Bool) -> (SymH -> SymH -> Bool) -> Eq SymH
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymH -> SymH -> Bool
$c/= :: SymH -> SymH -> Bool
== :: SymH -> SymH -> Bool
$c== :: SymH -> SymH -> Bool
Eq,Eq SymH
Eq SymH =>
(SymH -> SymH -> Ordering)
-> (SymH -> SymH -> Bool)
-> (SymH -> SymH -> Bool)
-> (SymH -> SymH -> Bool)
-> (SymH -> SymH -> Bool)
-> (SymH -> SymH -> SymH)
-> (SymH -> SymH -> SymH)
-> Ord SymH
SymH -> SymH -> Bool
SymH -> SymH -> Ordering
SymH -> SymH -> SymH
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SymH -> SymH -> SymH
$cmin :: SymH -> SymH -> SymH
max :: SymH -> SymH -> SymH
$cmax :: SymH -> SymH -> SymH
>= :: SymH -> SymH -> Bool
$c>= :: SymH -> SymH -> Bool
> :: SymH -> SymH -> Bool
$c> :: SymH -> SymH -> Bool
<= :: SymH -> SymH -> Bool
$c<= :: SymH -> SymH -> Bool
< :: SymH -> SymH -> Bool
$c< :: SymH -> SymH -> Bool
compare :: SymH -> SymH -> Ordering
$ccompare :: SymH -> SymH -> Ordering
$cp1Ord :: Eq SymH
Ord,Int -> SymH -> ShowS
[SymH] -> ShowS
SymH -> String
(Int -> SymH -> ShowS)
-> (SymH -> String) -> ([SymH] -> ShowS) -> Show SymH
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymH] -> ShowS
$cshowList :: [SymH] -> ShowS
show :: SymH -> String
$cshow :: SymH -> String
showsPrec :: Int -> SymH -> ShowS
$cshowsPrec :: Int -> SymH -> ShowS
Show)
symH :: [Int] -> Vect Q SymH
symH :: [Int] -> Vect Q SymH
symH xs :: [Int]
xs | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>0) [Int]
xs = SymH -> Vect Q SymH
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymH
SymH ([Int] -> SymH) -> [Int] -> SymH
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortDesc [Int]
xs)
| Bool
otherwise = String -> Vect Q SymH
forall a. HasCallStack => String -> a
error "symH: not a partition"
instance (Eq k, Num k) => Algebra k SymH where
unit :: k -> Vect k SymH
unit x :: k
x = k
x k -> Vect k SymH -> Vect k SymH
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> SymH -> Vect k SymH
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymH
SymH [])
mult :: Vect k (Tensor SymH SymH) -> Vect k SymH
mult = (Tensor SymH SymH -> Vect k SymH)
-> Vect k (Tensor SymH SymH) -> Vect k SymH
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear (\(SymH lambda :: [Int]
lambda, SymH mu :: [Int]
mu) -> SymH -> Vect k SymH
forall (m :: * -> *) a. Monad m => a -> m a
return (SymH -> Vect k SymH) -> SymH -> Vect k SymH
forall a b. (a -> b) -> a -> b
$ [Int] -> SymH
SymH ([Int] -> SymH) -> [Int] -> SymH
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int]
forall a. Ord a => [a] -> [a] -> [a]
multisetSumDesc [Int]
lambda [Int]
mu)
instance (Eq k, Num k) => Coalgebra k SymH where
counit :: Vect k SymH -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k) -> (Vect k SymH -> Vect k ()) -> Vect k SymH -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymH -> Vect k ()) -> Vect k SymH -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SymH -> Vect k ()
forall p. Num p => SymH -> p
counit' where counit' :: SymH -> p
counit' (SymH lambda :: [Int]
lambda) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
lambda then 1 else 0
comult :: Vect k SymH -> Vect k (Tensor SymH SymH)
comult = (SymH -> Vect k (Tensor SymH SymH))
-> Vect k SymH -> Vect k (Tensor SymH SymH)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SymH -> Vect k (Tensor SymH SymH)
forall k. (Eq k, Num k) => SymH -> Vect k (Tensor SymH SymH)
comult' where
comult' :: SymH -> Vect k (Tensor SymH SymH)
comult' (SymH [n :: Int
n]) = [Vect k (Tensor SymH SymH)] -> Vect k (Tensor SymH SymH)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Tensor SymH SymH -> Vect k (Tensor SymH SymH)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> SymH
h Int
i, Int -> SymH
h (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)) | Int
i <- [0..Int
n] ]
comult' (SymH lambda :: [Int]
lambda) = [Vect k (Tensor SymH SymH)] -> Vect k (Tensor SymH SymH)
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [SymH -> Vect k (Tensor SymH SymH)
comult' ([Int] -> SymH
SymH [Int
n]) | Int
n <- [Int]
lambda]
h :: Int -> SymH
h 0 = [Int] -> SymH
SymH []
h i :: Int
i = [Int] -> SymH
SymH [Int
i]
instance (Eq k, Num k) => Bialgebra k SymH where {}
symHtoM :: (Eq k, Num k) => Vect k SymH -> Vect k SymM
symHtoM :: Vect k SymH -> Vect k SymM
symHtoM = (SymH -> Vect k SymM) -> Vect k SymH -> Vect k SymM
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SymH -> Vect k SymM
forall k. (Eq k, Num k) => SymH -> Vect k SymM
symHtoM' where
symHtoM' :: SymH -> Vect k SymM
symHtoM' (SymH [n :: Int
n]) = [Vect k SymM] -> Vect k SymM
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [SymM -> Vect k SymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymM
SymM [Int]
mu) | [Int]
mu <- Int -> [[Int]]
forall a. (Ord a, Num a) => a -> [[a]]
integerPartitions Int
n]
symHtoM' (SymH lambda :: [Int]
lambda) = [Vect k SymM] -> Vect k SymM
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [SymH -> Vect k SymM
symHtoM' ([Int] -> SymH
SymH [Int
p]) | Int
p <- [Int]
lambda]
newtype NSym = NSym [Int] deriving (NSym -> NSym -> Bool
(NSym -> NSym -> Bool) -> (NSym -> NSym -> Bool) -> Eq NSym
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NSym -> NSym -> Bool
$c/= :: NSym -> NSym -> Bool
== :: NSym -> NSym -> Bool
$c== :: NSym -> NSym -> Bool
Eq,Eq NSym
Eq NSym =>
(NSym -> NSym -> Ordering)
-> (NSym -> NSym -> Bool)
-> (NSym -> NSym -> Bool)
-> (NSym -> NSym -> Bool)
-> (NSym -> NSym -> Bool)
-> (NSym -> NSym -> NSym)
-> (NSym -> NSym -> NSym)
-> Ord NSym
NSym -> NSym -> Bool
NSym -> NSym -> Ordering
NSym -> NSym -> NSym
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NSym -> NSym -> NSym
$cmin :: NSym -> NSym -> NSym
max :: NSym -> NSym -> NSym
$cmax :: NSym -> NSym -> NSym
>= :: NSym -> NSym -> Bool
$c>= :: NSym -> NSym -> Bool
> :: NSym -> NSym -> Bool
$c> :: NSym -> NSym -> Bool
<= :: NSym -> NSym -> Bool
$c<= :: NSym -> NSym -> Bool
< :: NSym -> NSym -> Bool
$c< :: NSym -> NSym -> Bool
compare :: NSym -> NSym -> Ordering
$ccompare :: NSym -> NSym -> Ordering
$cp1Ord :: Eq NSym
Ord,Int -> NSym -> ShowS
[NSym] -> ShowS
NSym -> String
(Int -> NSym -> ShowS)
-> (NSym -> String) -> ([NSym] -> ShowS) -> Show NSym
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NSym] -> ShowS
$cshowList :: [NSym] -> ShowS
show :: NSym -> String
$cshow :: NSym -> String
showsPrec :: Int -> NSym -> ShowS
$cshowsPrec :: Int -> NSym -> ShowS
Show)
instance Graded NSym where grade :: NSym -> Int
grade (NSym xs :: [Int]
xs) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
xs
nsym :: [Int] -> Vect Q NSym
nsym :: [Int] -> Vect Q NSym
nsym xs :: [Int]
xs | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>0) [Int]
xs = NSym -> Vect Q NSym
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> NSym
NSym [Int]
xs)
| Bool
otherwise = String -> Vect Q NSym
forall a. HasCallStack => String -> a
error "nsym: not a composition"
instance (Eq k, Num k) => Algebra k NSym where
unit :: k -> Vect k NSym
unit x :: k
x = k
x k -> Vect k NSym -> Vect k NSym
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> NSym -> Vect k NSym
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> NSym
NSym [])
mult :: Vect k (Tensor NSym NSym) -> Vect k NSym
mult = (Tensor NSym NSym -> Vect k NSym)
-> Vect k (Tensor NSym NSym) -> Vect k NSym
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor NSym NSym -> Vect k NSym
forall (m :: * -> *). Monad m => Tensor NSym NSym -> m NSym
mult' where
mult' :: Tensor NSym NSym -> m NSym
mult' (NSym xs :: [Int]
xs, NSym ys :: [Int]
ys) = NSym -> m NSym
forall (m :: * -> *) a. Monad m => a -> m a
return (NSym -> m NSym) -> NSym -> m NSym
forall a b. (a -> b) -> a -> b
$ [Int] -> NSym
NSym ([Int] -> NSym) -> [Int] -> NSym
forall a b. (a -> b) -> a -> b
$ [Int]
xs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
ys
instance (Eq k, Num k) => Coalgebra k NSym where
counit :: Vect k NSym -> k
counit = Vect k () -> k
forall k. Num k => Vect k () -> k
unwrap (Vect k () -> k) -> (Vect k NSym -> Vect k ()) -> Vect k NSym -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NSym -> Vect k ()) -> Vect k NSym -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear NSym -> Vect k ()
forall p. Num p => NSym -> p
counit' where counit' :: NSym -> p
counit' (NSym zs :: [Int]
zs) = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
zs then 1 else 0
comult :: Vect k NSym -> Vect k (Tensor NSym NSym)
comult = (NSym -> Vect k (Tensor NSym NSym))
-> Vect k NSym -> Vect k (Tensor NSym NSym)
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear NSym -> Vect k (Tensor NSym NSym)
forall k. (Eq k, Num k) => NSym -> Vect k (Tensor NSym NSym)
comult' where
comult' :: NSym -> Vect k (Tensor NSym NSym)
comult' (NSym [n :: Int
n]) = [Vect k (Tensor NSym NSym)] -> Vect k (Tensor NSym NSym)
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [Tensor NSym NSym -> Vect k (Tensor NSym NSym)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> NSym
z Int
i, Int -> NSym
z (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)) | Int
i <- [0..Int
n] ]
comult' (NSym zs :: [Int]
zs) = [Vect k (Tensor NSym NSym)] -> Vect k (Tensor NSym NSym)
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [NSym -> Vect k (Tensor NSym NSym)
comult' ([Int] -> NSym
NSym [Int
n]) | Int
n <- [Int]
zs]
z :: Int -> NSym
z 0 = [Int] -> NSym
NSym []
z i :: Int
i = [Int] -> NSym
NSym [Int
i]
instance (Eq k, Num k) => Bialgebra k NSym where {}
instance (Eq k, Num k) => HopfAlgebra k NSym where
antipode :: Vect k NSym -> Vect k NSym
antipode = (NSym -> Vect k NSym) -> Vect k NSym -> Vect k NSym
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear NSym -> Vect k NSym
forall k. (Eq k, Num k) => NSym -> Vect k NSym
antipode' where
antipode' :: NSym -> Vect k NSym
antipode' (NSym alpha :: [Int]
alpha) = [Vect k NSym] -> Vect k NSym
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [(-1)k -> Int -> k
forall a b. (Num a, Integral b) => a -> b -> a
^[Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
beta k -> Vect k NSym -> Vect k NSym
forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
*> NSym -> Vect k NSym
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> NSym
NSym [Int]
beta) | [Int]
beta <- [Int] -> [[Int]]
refinements ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
alpha)]
descendingTree :: [a] -> PBT a
descendingTree [] = PBT a
forall a. PBT a
E
descendingTree [x :: a
x] = PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
forall a. PBT a
E a
x PBT a
forall a. PBT a
E
descendingTree xs :: [a]
xs = PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
l a
x PBT a
r
where x :: a
x = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
xs
(ls :: [a]
ls,_:rs :: [a]
rs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs
l :: PBT a
l = [a] -> PBT a
descendingTree [a]
ls
r :: PBT a
r = [a] -> PBT a
descendingTree [a]
rs
descendingTreeMap :: (Eq k, Num k) => Vect k SSymF -> Vect k (YSymF ())
descendingTreeMap :: Vect k SSymF -> Vect k (YSymF ())
descendingTreeMap = Vect k (YSymF ()) -> Vect k (YSymF ())
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k (YSymF ()) -> Vect k (YSymF ()))
-> (Vect k SSymF -> Vect k (YSymF ()))
-> Vect k SSymF
-> Vect k (YSymF ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SSymF -> YSymF ()) -> Vect k SSymF -> Vect k (YSymF ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PBT () -> YSymF ()
forall a. PBT a -> YSymF a
YSymF (PBT () -> YSymF ()) -> (SSymF -> PBT ()) -> SSymF -> YSymF ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBT Int -> PBT ()
forall a. PBT a -> PBT ()
shape (PBT Int -> PBT ()) -> (SSymF -> PBT Int) -> SSymF -> PBT ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSymF -> PBT Int
descendingTree')
where descendingTree' :: SSymF -> PBT Int
descendingTree' (SSymF xs :: [Int]
xs) = [Int] -> PBT Int
forall a. Ord a => [a] -> PBT a
descendingTree [Int]
xs
minPerm :: PBT a -> [a]
minPerm t :: PBT a
t = PBT (a, a) -> [a]
forall a. Num a => PBT (a, a) -> [a]
minPerm' (PBT a -> PBT (a, a)
forall b a. Num b => PBT a -> PBT (b, b)
lrCountTree PBT a
t)
where minPerm' :: PBT (a, a) -> [a]
minPerm' E = []
minPerm' (T l :: PBT (a, a)
l (lc :: a
lc,rc :: a
rc) r :: PBT (a, a)
r) = PBT (a, a) -> [a]
minPerm' PBT (a, a)
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
lca -> a -> a
forall a. Num a => a -> a -> a
+a
rca -> a -> a
forall a. Num a => a -> a -> a
+1] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Num a => a -> a -> a
+a
lc) (PBT (a, a) -> [a]
minPerm' PBT (a, a)
r)
maxPerm :: PBT a -> [a]
maxPerm t :: PBT a
t = PBT (a, a) -> [a]
forall a. Num a => PBT (a, a) -> [a]
maxPerm' (PBT a -> PBT (a, a)
forall b a. Num b => PBT a -> PBT (b, b)
lrCountTree PBT a
t)
where maxPerm' :: PBT (a, a) -> [a]
maxPerm' E = []
maxPerm' (T l :: PBT (a, a)
l (lc :: a
lc,rc :: a
rc) r :: PBT (a, a)
r) = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Num a => a -> a -> a
+a
rc) (PBT (a, a) -> [a]
maxPerm' PBT (a, a)
l) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
lca -> a -> a
forall a. Num a => a -> a -> a
+a
rca -> a -> a
forall a. Num a => a -> a -> a
+1] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ PBT (a, a) -> [a]
maxPerm' PBT (a, a)
r
leftLeafComposition :: PBT a -> [Int]
leftLeafComposition E = []
leftLeafComposition t :: PBT a
t = [Bool] -> [Int]
cuts ([Bool] -> [Int]) -> [Bool] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Bool] -> [Bool]
forall a. [a] -> [a]
tail ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ PBT a -> [Bool]
forall a. PBT a -> [Bool]
leftLeafs PBT a
t
where leftLeafs :: PBT a -> [Bool]
leftLeafs (T l :: PBT a
l x :: a
x E) = PBT a -> [Bool]
leftLeafs PBT a
l [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool
False]
leftLeafs (T l :: PBT a
l x :: a
x r :: PBT a
r) = PBT a -> [Bool]
leftLeafs PBT a
l [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ PBT a -> [Bool]
leftLeafs PBT a
r
leftLeafs E = [Bool
True]
cuts :: [Bool] -> [Int]
cuts bs :: [Bool]
bs = case (Bool -> Bool) -> [Bool] -> ([Bool], [Bool])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Bool -> Bool
forall a. a -> a
id [Bool]
bs of
(ls :: [Bool]
ls,r :: Bool
r:rs :: [Bool]
rs) -> ([Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Bool] -> [Int]
cuts [Bool]
rs
(ls :: [Bool]
ls,[]) -> [[Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
ls]
leftLeafComposition' :: YSymF a -> QSymF
leftLeafComposition' (YSymF t :: PBT a
t) = [Int] -> QSymF
QSymF (PBT a -> [Int]
forall a. PBT a -> [Int]
leftLeafComposition PBT a
t)
leftLeafCompositionMap :: (Eq k, Num k) => Vect k (YSymF a) -> Vect k QSymF
leftLeafCompositionMap :: Vect k (YSymF a) -> Vect k QSymF
leftLeafCompositionMap = Vect k QSymF -> Vect k QSymF
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k QSymF -> Vect k QSymF)
-> (Vect k (YSymF a) -> Vect k QSymF)
-> Vect k (YSymF a)
-> Vect k QSymF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YSymF a -> QSymF) -> Vect k (YSymF a) -> Vect k QSymF
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YSymF a -> QSymF
forall a. YSymF a -> QSymF
leftLeafComposition'
descents :: [a] -> [Int]
descents [] = []
descents xs :: [a]
xs = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Bool -> [Bool] -> [Int]
forall a. Eq a => a -> [a] -> [Int]
L.elemIndices Bool
True ([Bool] -> [Int]) -> [Bool] -> [Int]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [a] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>) [a]
xs ([a] -> [a]
forall a. [a] -> [a]
tail [a]
xs)
descentComposition :: [a] -> [a]
descentComposition [] = []
descentComposition xs :: [a]
xs = a -> [a] -> [a]
forall a a. (Ord a, Num a) => a -> [a] -> [a]
descComp 0 [a]
xs where
descComp :: a -> [a] -> [a]
descComp c :: a
c (x1 :: a
x1:x2 :: a
x2:xs :: [a]
xs) = if a
x1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x2 then a -> [a] -> [a]
descComp (a
ca -> a -> a
forall a. Num a => a -> a -> a
+1) (a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) else (a
ca -> a -> a
forall a. Num a => a -> a -> a
+1) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
descComp 0 (a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
descComp c :: a
c [x :: a
x] = [a
ca -> a -> a
forall a. Num a => a -> a -> a
+1]
descentMap :: (Eq k, Num k) => Vect k SSymF -> Vect k QSymF
descentMap :: Vect k SSymF -> Vect k QSymF
descentMap = Vect k QSymF -> Vect k QSymF
forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
nf (Vect k QSymF -> Vect k QSymF)
-> (Vect k SSymF -> Vect k QSymF) -> Vect k SSymF -> Vect k QSymF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SSymF -> QSymF) -> Vect k SSymF -> Vect k QSymF
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SSymF xs :: [Int]
xs) -> [Int] -> QSymF
QSymF ([Int] -> [Int]
forall a a. (Ord a, Num a) => [a] -> [a]
descentComposition [Int]
xs))
underComposition :: QSymF -> SSymF
underComposition (QSymF ps :: [Int]
ps) = (SSymF -> SSymF -> SSymF) -> SSymF -> [SSymF] -> SSymF
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SSymF -> SSymF -> SSymF
under ([Int] -> SSymF
SSymF []) [[Int] -> SSymF
SSymF [1..Int
p] | Int
p <- [Int]
ps]
where under :: SSymF -> SSymF -> SSymF
under (SSymF xs :: [Int]
xs) (SSymF ys :: [Int]
ys) = let q :: Int
q = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ys
zs :: [Int]
zs = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
q) [Int]
xs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
ys
in [Int] -> SSymF
SSymF [Int]
zs
under :: PBT a -> PBT a -> PBT a
under E t :: PBT a
t = PBT a
t
under (T l :: PBT a
l x :: a
x r :: PBT a
r) t :: PBT a
t = PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
l a
x (PBT a -> PBT a -> PBT a
under PBT a
r PBT a
t)
isUnderIrreducible :: PBT a -> Bool
isUnderIrreducible (T l :: PBT a
l x :: a
x E) = Bool
True
isUnderIrreducible _ = Bool
False
underDecomposition :: PBT a -> [PBT a]
underDecomposition (T l :: PBT a
l x :: a
x r :: PBT a
r) = PBT a -> a -> PBT a -> PBT a
forall a. PBT a -> a -> PBT a -> PBT a
T PBT a
l a
x PBT a
forall a. PBT a
E PBT a -> [PBT a] -> [PBT a]
forall a. a -> [a] -> [a]
: PBT a -> [PBT a]
underDecomposition PBT a
r
underDecomposition E = []
ysymmToSh :: f YSymM -> f (Shuffle (PBT ()))
ysymmToSh = (YSymM -> Shuffle (PBT ())) -> f YSymM -> f (Shuffle (PBT ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YSymM -> Shuffle (PBT ())
ysymmToSh'
where ysymmToSh' :: YSymM -> Shuffle (PBT ())
ysymmToSh' (YSymM t :: PBT ()
t) = [PBT ()] -> Shuffle (PBT ())
forall a. [a] -> Shuffle a
Sh (PBT () -> [PBT ()]
forall a. PBT a -> [PBT a]
underDecomposition PBT ()
t)
symToQSymM :: (Eq k, Num k) => Vect k SymM -> Vect k QSymM
symToQSymM :: Vect k SymM -> Vect k QSymM
symToQSymM = (SymM -> Vect k QSymM) -> Vect k SymM -> Vect k QSymM
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear SymM -> Vect k QSymM
forall k. (Eq k, Num k) => SymM -> Vect k QSymM
symToQSymM' where
symToQSymM' :: SymM -> Vect k QSymM
symToQSymM' (SymM ps :: [Int]
ps) = [Vect k QSymM] -> Vect k QSymM
forall k b. (Eq k, Num k, Ord b) => [Vect k b] -> Vect k b
sumv [QSymM -> Vect k QSymM
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> QSymM
QSymM [Int]
c) | [Int]
c <- [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
compositionsFromPartition [Int]
ps]
nsymToSymH :: (Eq k, Num k) => Vect k NSym -> Vect k SymH
nsymToSymH :: Vect k NSym -> Vect k SymH
nsymToSymH = (NSym -> Vect k SymH) -> Vect k NSym -> Vect k SymH
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear NSym -> Vect k SymH
forall (m :: * -> *). Monad m => NSym -> m SymH
nsymToSym' where
nsymToSym' :: NSym -> m SymH
nsymToSym' (NSym zs :: [Int]
zs) = SymH -> m SymH
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SymH
SymH ([Int] -> SymH) -> [Int] -> SymH
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sortDesc [Int]
zs)
nsymToSSym :: Vect k NSym -> Vect k SSymF
nsymToSSym = (NSym -> Vect k SSymF) -> Vect k NSym -> Vect k SSymF
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear NSym -> Vect k SSymF
forall (m :: * -> *). (Num (m SSymF), Monad m) => NSym -> m SSymF
nsymToSSym' where
nsymToSSym' :: NSym -> m SSymF
nsymToSSym' (NSym xs :: [Int]
xs) = [m SSymF] -> m SSymF
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [SSymF -> m SSymF
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> SSymF
SSymF [1..Int
n]) | Int
n <- [Int]
xs]
instance (Eq k, Num k) => HasPairing k SymH SymM where
pairing :: Vect k (Tensor SymH SymM) -> Vect k ()
pairing = (Tensor SymH SymM -> Vect k ())
-> Vect k (Tensor SymH SymM) -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor SymH SymM -> Vect k ()
forall p. Num p => Tensor SymH SymM -> p
pairing' where
pairing' :: Tensor SymH SymM -> p
pairing' (SymH alpha :: [Int]
alpha, SymM beta :: [Int]
beta) = [Int] -> [Int] -> p
forall a p. (Eq a, Num p) => a -> a -> p
delta [Int]
alpha [Int]
beta
instance (Eq k, Num k) => HasPairing k NSym QSymM where
pairing :: Vect k (Tensor NSym QSymM) -> Vect k ()
pairing = (Tensor NSym QSymM -> Vect k ())
-> Vect k (Tensor NSym QSymM) -> Vect k ()
forall k b a.
(Eq k, Num k, Ord b) =>
(a -> Vect k b) -> Vect k a -> Vect k b
linear Tensor NSym QSymM -> Vect k ()
forall p. Num p => Tensor NSym QSymM -> p
pairing' where
pairing' :: Tensor NSym QSymM -> p
pairing' (NSym alpha :: [Int]
alpha, QSymM beta :: [Int]
beta) = [Int] -> [Int] -> p
forall a p. (Eq a, Num p) => a -> a -> p
delta [Int]
alpha [Int]
beta