    -- Copyright (c) 2012-2015, David Amos. All rights reserved.

    {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, NoMonomorphismRestriction, ScopedTypeVariables, DeriveFunctor #-}

    -- |A module defining the following Combinatorial Hopf Algebras, together with coalgebra or Hopf algebra morphisms between them:
    --
    -- * Sh, the Shuffle Hopf algebra
    --
    -- * SSym, the Malvenuto-Reutnenauer Hopf algebra of permutations
    --
    -- * YSym, the (dual of the) Loday-Ronco Hopf algebra of binary trees
    --
    -- * QSym, the Hopf algebra of quasi-symmetric functions (having a basis indexed by compositions)
    --
    -- * Sym, the Hopf algebra of symmetric functions (having a basis indexed by integer partitions)
    --
    -- * NSym, the Hopf algebra of non-commutative symmetric functions
    module Math.Combinatorics.CombinatorialHopfAlgebra where

    -- Sources:

    -- Structure of the Malvenuto-Reutenauer Hopf algebra of permutations
    -- Marcelo Aguiar and Frank Sottile
    -- http://www.math.tamu.edu/~sottile/research/pdf/SSym.pdf

    -- Structure of the Loday-Ronco Hopf algebra of trees
    -- Marcelo Aguiar and Frank Sottile
    -- http://www.math.tamu.edu/~sottile/research/pdf/Loday.pdf

    -- Hopf Structures on the Multiplihedra
    -- Stefan Forcey, Aaron Lauve and Frank Sottile
    -- http://www.math.tamu.edu/~sottile/research/pdf/MSym.pdf

    -- Lie Algebras and Hopf Algebras
    -- Michiel Hazewinkel, Nadiya Gubareni, V.V.Kirichenko

    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.Algebra.Group.PermutationGroup
    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 ()

    -- Hazewinkel et al, p155.
    -- Given a graded, connected Hopf algebra, we can calculate the antipode recursively.
    -- (A connected Hopf algebra means that the counit is projection onto the grade 0 part.)
    -- Then we can calculate the antipode using mult . (id `tf` antipode) . comult == unit . counit
    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 :: Graded b => Vect k (b,b) -> Vect k (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

    -- SHUFFLE ALGEBRA
    -- This is just the tensor algebra, but with shuffle product (and deconcatenation coproduct)

    -- |A basis for the shuffle algebra. As a vector space, the shuffle algebra is identical to the tensor algebra.
    -- However, we consider a different algebra structure, based on the shuffle product. Together with the
    -- deconcatenation coproduct, this leads to a Hopf algebra structure.
    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

    -- |Construct a basis element of the shuffle algebra
    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)))

    -- SSYM: PERMUTATIONS
    -- (This is permutations considered as combinatorial objects rather than as algebraic objects)

    -- Permutations with shifted shuffle product and flattened deconcatenation coproduct
    -- This is the Malvenuto-Reutenauer Hopf algebra of permutations, SSym.
    -- It is neither commutative nor co-commutative

    -- ssymF xs is the fundamental basis F_xs (Aguiar and Sottile)

    -- |The fundamental basis for the Malvenuto-Reutenauer Hopf algebra of permutations, SSym.
    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

    -- |Construct a fundamental basis element in SSym.
    -- The list of ints must be a permutation of [1..n], eg [1,2], [3,4,2,1].
    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

    -- so this is a candidate mult. It is associative and SSymF [] is obviously a left and right identity
    -- (need quickcheck properties to prove that)
    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

    -- > quickCheck (prop_Associative shiftedConcat)
    -- +++ OK, passed 100 tests.

    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)]

    -- standard permutation, also called flattening, eg [6,2,5] -> [3,1,2]
    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
        {-
        antipode = linear antipode' where
            antipode' (SSymF []) = return (SSymF [])
            antipode' x@(SSymF xs) = (negatev . mult . (id `tf` antipode) . removeTerm (SSymF [],x) . comult . return) x
            -- This expression for antipode is derived from mult . (id `tf` antipode) . comult == unit . counit
            -- It's possible because this is a graded, connected Hopf algebra. (connected means the counit is projection onto the grade 0 part)
        -}
    -- It would be nicer to have an explicit expression for antipode.
    {-
    instance (Eq k, Num k) => HopfAlgebra k SSymF where
        antipode = linear antipode'
            where antipode' (SSymF v) = sumv [lambda v w *> return (SSymF w) | w <- L.permutations v]
                  lambda v w = length [s | s <- powerset [1..n-1],  odd (length s), descentSet (w^-1 * v_s) `isSubset` s]
                             - length [s | s <- powerset [1..n-1],  even (length s), descentSet (w^-1 * v_s) `isSubset` s]
    -}

    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

    -- Hazewinkel p267
    -- |A pairing showing that SSym is self-adjoint
    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)
    -- Not entirely clear to me why this works
    -- The pairing is *not* positive definite (Hazewinkel p267)
    -- eg (\x -> pairing' x x >= 0) (ssymF [1,3,2] + ssymF [2,3,1] - ssymF [3,1,2]) == False

    -- |An alternative \"monomial\" basis for the Malvenuto-Reutenauer Hopf algebra of permutations, SSym.
    -- This basis is related to the fundamental basis by Mobius inversion in the poset of permutations with the weak order.
    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

    -- |Construct a monomial basis element in SSym.
    -- The list of ints must be a permutation of [1..n], eg [1,2], [3,4,2,1].
    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]

    -- should really check that xs and ys have the same length, and perhaps insist also on same type
    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

    -- |Convert an element of SSym represented in the monomial basis to the fundamental basis
    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

    -- |Convert an element of SSym represented in the fundamental basis to the monomial basis
    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

    -- (p,q)-shuffles: permutations of [1..p+q] having at most one descent, at position p
    -- denoted S^{(p,q)} in Aguiar&Sottile
    -- (Grassmannian permutations?)
    -- pqShuffles p q = [u++v | u <- combinationsOf p [1..n], let v = [1..n] `diffAsc` u] where n = p+q

    -- The inverse of a (p,q)-shuffle.
    -- The special form of (p,q)-shuffles makes an O(n) algorithm possible
    -- pqInverse :: Int -> Int -> [Int] -> [Int]
    {-
    -- incorrect
    pqInverse p q xs = pqInverse' [1..p] [p+1..p+q] xs
        where pqInverse' (l:ls) (r:rs) (x:xs) =
                  if x <= p then l : pqInverse' ls (r:rs) xs else r : pqInverse' (l:ls) rs xs
              pqInverse' ls rs _ = ls ++ rs -- one of them is null
    -}
    -- pqInverseShuffles p q = shuffles [1..p] [p+1..p+q]

    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)

    {-
    mult2 = linear mult'
        where mult' (SSymM u, SSymM v) = sumv [alpha u v w *> return (SSymM w) | w <- L.permutations [1..p+q] ]
                                         where p = length u; q = length v

    alpha u v w = length [z | z <- pqInverseShuffles p q, let uv = shiftedConcat u v,
                              uv * z `weakOrder` w, u and v are maximal, ie no transposition of adjacents in either also works]
        where p = length u
              q = length v
    -- so we need to define (*) for permutations in row form
    -}

    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 = (ssymFtoM `tf` ssymFtoM) . comult . ssymMtoF
        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)] -- ie deconcatenations at a global descent
                  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
        -- antipode = ssymFtoM . antipode . ssymMtoF

    -- Hazewinkel p265
    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
    -- In other words, mult x y is the sum of those z whose comult (in SSymF) has an (x,y) term
    -- So the matrix for mult is the transpose of the matrix for comult in SSymF

    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
    -- In other words, comult x is the sum of those (y,z) whose mult (in SSymF) has a z term
    -- So the matrix for comult is the transpose of the matrix for mult in SSymF

    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
        {-
        antipode = linear antipode' where
            antipode' (Dual (SSymF [])) = return (Dual (SSymF []))
            antipode' x@(Dual (SSymF xs)) =
                (negatev . mult . (id `tf` antipode) . removeTerm (Dual (SSymF []),x) . comult . return) x
        -}

    -- This pairing is positive definite (Hazewinkel p267)
    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

    -- |The isomorphism from SSym to its dual that takes a permutation in the fundamental basis to its inverse in the dual basis
    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)
    -- This is theta on Hazewinkel p266 (though later he also uses theta for the inverse of this map)

    -- YSYM: PLANAR BINARY TREES
    -- These are really rooted planar binary trees.
    -- It's because they're planar that we can distinguish left and right child branches.
    -- (Non-planar would be if we considered trees where left and right children are swapped relative to one another as the same tree)
    -- It is neither commutative nor co-commutative

    -- |A type for (rooted) planar binary trees. The basis elements of the Loday-Ronco Hopf algebra are indexed by these.
    --
    -- Although the trees are labelled, we're really only interested in the shapes of the trees, and hence in the type PBT ().
    -- The Algebra, Coalgebra and HopfAlgebra instances all ignore the labels.
    -- However, it is convenient to allow labels, as they can be useful for seeing what is going on, and they also make it possible
    -- to define various ways to create trees from lists of labels.
    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)

    -- |The fundamental basis for (the dual of) the Loday-Ronco Hopf algebra of binary trees, YSym.
    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

    -- |Construct the element of YSym in the fundamental basis indexed by the given tree
    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)

    {-
    depth (T l x r) = 1 + max (depth l) (depth r)
    depth E = 0
    -}
    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

    -- in fact leafcount t = 1 + nodecount t (easiest to see with a picture)
    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

    -- The shape signature uniquely identifies the shape of a tree.
    -- Trees with distinct shapes have distinct signatures.
    -- In addition, if sorting on shapeSignature, smaller trees sort before larger trees,
    -- and leftward leaning trees sort before rightward leaning trees
    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] -- not [], otherwise we can't distinguish T (T E () E) () E from T E () (T E () E)
              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)

    -- A tree that counts nodes in left and right subtrees
    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

    -- label the nodes of a tree in infix order while preserving its shape
    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)
    -- could also pair the numbers with the input labels

    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]
                  -- using sumv rather than sum to avoid requiring Show a
        -- so again this is a kind of deconcatenation coproduct

    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]
            -- using sumv rather than sum to avoid requiring Show a

    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
        {-
        antipode = linear antipode' where
            antipode' (YSymF E) = return (YSymF E)
            antipode' x = (negatev . mult . (id `tf` antipode) . removeTerm (YSymF E,x) . comult . return) x
        -}

    -- |An alternative \"monomial\" basis for (the dual of) the Loday-Ronco Hopf algebra of binary trees, YSym.
    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

    -- |Construct the element of YSym in the monomial basis indexed by the given tree
    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)

    -- |List all trees with the given number of nodes
    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]

    -- |The covering relation for the Tamari partial order on binary trees
    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)]
                                    -- Note that this preserves the descending property, and hence the bijection with permutations
                                    -- If we were to swap x and y, we would preserve the binary search tree property instead (if our trees had it)
    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]

    -- |The up-set of a binary tree in the Tamari partial order
    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'

    -- tamariOrder1 u v = v `elem` upSet u

    -- |The Tamari partial order on binary trees.
    -- This is only defined between trees of the same size (number of nodes).
    -- The result between trees of different sizes is undefined (we don't check).
    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)
    -- It should be possible to unpack this to be a statement purely about trees, but probably not worth it

    -- |Convert an element of YSym represented in the monomial basis to the fundamental basis
    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 -- [s | s <- trees (nodecount t), t `tamariOrder` s]

    -- |Convert an element of YSym represented in the fundamental basis to the monomial basis
    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]
                           -- sumv [return (YSymM s) | s <- trees (nodecount t), t `tamariOrder` s]

    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 = (ysymFtoM `tf` ysymFtoM) . comult . ysymMtoF
        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
        -- antipode = ysymFtoM . antipode . ysymMtoF

    -- QSYM: QUASI-SYMMETRIC FUNCTIONS
    -- The following is the Hopf algebra QSym of quasi-symmetric functions
    -- using the monomial and fundamental bases (indexed by compositions)

    -- compositions in ascending order
    -- might be better to use bfs to get length order
    -- |List the compositions of an integer n. For example, the compositions of 4 are [[1,1,1,1],[1,1,2],[1,2,1],[1,3],[2,1,1],[2,2],[3,1],[4]]
    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)]

    -- can retrieve subsets of [1..n-1] from compositions n as follows
    -- > map (tail . scanl (+) 0) (map init $ compositions 4)
    -- [[],[3],[2],[2,3],[1],[1,3],[1,2],[1,2,3]]

    -- quasi shuffles of two compositions
    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]

    -- |A type for the monomial basis for the quasi-symmetric functions, indexed by compositions.
    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

    -- |Construct the element of QSym in the monomial basis indexed by the given composition
    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
        {-
        antipode = linear antipode' where
            antipode' (QSymM alpha) = (-1)^length alpha * sumv [return (QSymM beta) | beta <- coarsenings (reverse alpha)]
            -- antipode' (QSymM alpha) = (-1)^length alpha * sumv [return (QSymM (reverse beta)) | beta <- coarsenings alpha]
        -}

    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] -- for xs a singleton or null

    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 [] = [[]]

    -- |A type for the fundamental basis for the quasi-symmetric functions, indexed by compositions.
    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

    -- |Construct the element of QSym in the fundamental basis indexed by the given composition
    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"

    -- |Convert an element of QSym represented in the monomial basis to the fundamental basis
    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]

    -- |Convert an element of QSym represented in the fundamental basis to the monomial basis
    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] -- ie beta <- up-set of 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
        -- antipode = qsymMtoF . antipode . qsymFtoM

    -- QUASI-SYMMETRIC POLYNOMIALS

    -- the above induces Hopf algebra structure on quasi-symmetric functions via
    -- m_alpha -> sum [product (zipWith (^) (map x_ is) alpha | is <- combinationsOf k [] ] where k = length alpha

    -- xvars n = [glexvar ("x" ++ show i) | i <- [1..n] ]

    -- |@qsymPoly n is@ is the quasi-symmetric polynomial in n variables for the indices is. (This corresponds to the
    -- monomial basis for QSym.) For example, qsymPoly 3 [2,1] == x1^2*x2+x1^2*x3+x2^2*x3.
    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

    -- SYM, THE HOPF ALGEBRA OF SYMMETRIC FUNCTIONS

    -- |A type for the monomial basis for Sym, the Hopf algebra of symmetric functions, indexed by integer partitions
    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) -- note the order reversal in snd

    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

    -- |Construct the element of Sym in the monomial basis indexed by the given integer partition
    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]

    -- multisetPermutations = toSet . L.permutations

    -- compositionsFromPartition2 = foldl (\xss ys -> concatMap (shuffles ys) xss) [[]] . L.group
    -- compositionsFromPartition2 = foldl (\ls r -> concat [shuffles l r | l <- ls]) [[]] . L.group

    -- The partition must be in either ascending or descending order (so that L.group does as expected)
    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

    -- In effect, we multiply in Sym by converting to QSym, multiplying there, and converting back.
    -- It would be nice to find a more direct method.
    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
        {-
        antipode = linear antipode' where
            antipode' (SymM []) = return (SymM [])
            antipode' x = (negatev . mult . (id `tf` antipode) . removeTerm (SymM [],x) . comult . return) x
        -}

    -- |The elementary basis for Sym, the Hopf algebra of symmetric functions. Defined informally as
    -- > symE [n] = symM (replicate n 1)
    -- > symE lambda = product [symE [p] | p <- lambda]
    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 {}

    -- TODO: HopfAlgebra instance?

    -- |Convert from the elementary to the monomial basis of Sym
    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]

    -- |The complete basis for Sym, the Hopf algebra of symmetric functions. Defined informally as
    -- > symH [n] = sum [symM lambda | lambda <- integerPartitions n] -- == all monomials of weight n
    -- > symH lambda = product [symH [p] | p <- 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 {}

    -- TODO: HopfAlgebra instance?

    -- |Convert from the complete to the monomial basis of Sym
    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]

    -- NSYM, THE HOPF ALGEBRA OF NON-COMMUTATIVE SYMMETRIC FUNCTIONS

    -- |A basis for NSym, the Hopf algebra of non-commutative symmetric functions, indexed by compositions
    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 {}

    -- Hazewinkel et al p233
    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)]

    -- MAPS BETWEEN (POSETS AND) HOPF ALGEBRAS

    -- A descending tree is one in which a child is always less than a parent.
    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
    -- This is a bijection from permutations to "ordered trees".
    -- It is order-preserving on trees with the same nodecount.
    -- We can recover the permutation by reading the node labels in infix order.
    -- This is the map called lambda in Loday.pdf

    -- |Given a permutation p of [1..n], we can construct a tree (the descending tree of p) as follows:
    --
    -- * Split the permutation as p = ls ++ [n] ++ rs
    --
    -- * Place n at the root of the tree, and recursively place the descending trees of ls and rs as the left and right children of the root
    --
    -- * To bottom out the recursion, the descending tree of the empty permutation is of course the empty tree
    --
    -- This map between bases SSymF -> YSymF turns out to induce a morphism of Hopf algebras.
    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
    -- This is the map called Lambda in Loday.pdf, or tau in MSym.pdf
    -- It is an algebra morphism.

    -- One of the ideas in the MSym paper is to look at the intermediate result (fmap descendingTree' x),
    -- which is an "ordered tree", and consider the map as factored through this

    -- The map is surjective but not injective. The fibers tau^-1(t) are intervals in the weak order on permutations

    -- "inverse" for descendingTree
    -- These are the maps called gamma in Loday.pdf
    -- or are they? - these give the min and max inverse images in the lexicographic order, rather than the weak order?
    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

    -- The composition of [1..n] obtained by treating each left-facing leaf as a cut
    -- Specifically, we visit the nodes in infix order, cutting after a node if it does not have an E as its right child
    -- This is the map called L in Loday.pdf
    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)

    -- |A Hopf algebra morphism from YSymF to QSymF
    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'

    -- The descent set of a permutation is [i | x_i > x_i+1], where we start the indexing from 1
    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)

    -- The composition of [1..n] obtained by treating each descent as a cut
    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]

    -- |Given a permutation of [1..n], its descents are those positions where the next number is less than the previous number.
    -- For example, the permutation [2,3,5,1,6,4] has descents from 5 to 1 and from 6 to 4. The descents can be regarded as cutting
    -- the permutation sequence into segments - 235-16-4 - and by counting the lengths of the segments, we get a composition 3+2+1.
    -- This map between bases SSymF -> QSymF turns out to induce a morphism of Hopf algebras.
    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))
    -- descentMap == leftLeafCompositionMap . descendingTreeMap

    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 -- so it has a global descent at the split
                                            in [Int] -> SSymF
    SSymF [Int]
    zs
    -- This is a poset morphism (indeed, it forms a Galois connection with descentComposition)
    -- but it does not extend to a Hopf algebra morphism.
    -- (It does extend to a coalgebra morphism.)
    -- (It is picking the maximum permutation having a given descent composition,
    -- so there's an element of arbitrariness to it.)
    -- This is the map called Z (Zeta?) in Loday.pdf

    {-
    -- This is O(n^2), whereas an O(n) implementation should be possible
    -- Also, we would really like the associated composition (obtained by treating each global descent as a cut)?
    globalDescents xs = globalDescents' 0 [] xs
        where globalDescents' i ls (r:rs) = (if minimum (infinity:ls) > maximum (0:r:rs) then [i] else [])
                                         ++ globalDescents' (i+1) (r:ls) rs
              globalDescents' n _ [] = [n]
              infinity = maxBound :: Int
    -- The idea is that this leads to a map from SSymM to QSymM

    globalDescentComposition [] = []
    globalDescentComposition (x:xs) = globalDescents' 1 x xs
        where globalDescents' i minl (r:rs) = if minl > maximum (r:rs)
                                              then i : globalDescents' 1 r rs
                                              else globalDescents' (i+1) r rs
              globalDescents' i _ [] = [i]

    globalDescentMap :: (Eq k, Num k) => Vect k SSymM -> Vect k QSymM
    globalDescentMap = nf . fmap (\(SSymM xs) -> QSymM (globalDescentComposition xs))
    -}

    -- A multiplication operation on trees
    -- (Connected with their being cofree)
    -- (intended to be used as infix)
    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 = []

    -- GHC7.4.1 doesn't like the following type signature - a bug.
    -- ysymmToSh :: (Eq k, Num k) => Vect k (YSymM) => Vect k (Shuffle (PBT ()))
    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)
    -- This is a coalgebra morphism (but not an algebra morphism)
    -- It shows that YSym is co-free
    {-
    -- This one not working yet - perhaps it needs an nf, or to go via S/YSymF, or ...
    ssymmToSh = nf . fmap ssymmToSh'
        where ssymmToSh' (SSymM xs) = (Sh . underDecomposition . shape . descendingTree) xs
    -}

    -- |The injection of Sym into QSym (defined over the monomial basis)
    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]

    -- We could equally well send NSym -> SymE, since the algebra and coalgebra definitions for SymE and SymH are exactly analogous.
    -- However, NSym -> SymH is more natural, since it is consistent with the duality pairings below.
    -- eg Hazewinkel 238ff
    -- (Why do SymE and SymH have the same definitions? They're not dual bases. It's because of the Wronski relations.)
    -- |A surjection of NSym onto Sym (defined over the complete basis)
    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)

    -- The Hopf algebra morphism NSym -> Sym factors through NSym -> SSym -> YSym -> Sym (contained in QSym)
    -- (?? This map NSym -> SSym is the dual of the descent map SSym -> QSym ??)
    -- (Loday.pdf, p30)
    -- (See also Hazewinkel p267-9)
    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]

    -- |A duality pairing between the complete and monomial bases of Sym, showing that Sym is self-dual.
    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 -- Kronecker delta
    -- Hazewinkel p178
    -- Actually to show duality you would need to show that the map SymH -> SymM*, v -> <v,.> is onto

    -- |A duality pairing between NSym and QSymM (monomial basis), showing that NSym and QSym are dual.
    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 -- Kronecker delta
    -- Hazewinkel p236-7
    -- Actually to show duality you would need to show that the map NSym -> QSymM*, v -> <v,.> is onto