jackpolynomials 1.4.2.0 → 1.4.3.0
raw patch · 8 files changed
+1045/−51 lines, 8 filesdep ~hsprayPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hspray
API changes (from Hackage documentation)
+ Math.Algebra.SymmetricPolynomials: factorialSchurPol :: (Eq a, C a) => Int -> Partition -> [a] -> Spray a
+ Math.Algebra.SymmetricPolynomials: factorialSchurPol' :: Int -> Partition -> [Rational] -> QSpray
+ Math.Algebra.SymmetricPolynomials: flaggedSchurPol :: (Eq a, C a) => Partition -> [Int] -> [Int] -> Spray a
+ Math.Algebra.SymmetricPolynomials: flaggedSchurPol' :: Partition -> [Int] -> [Int] -> QSpray
+ Math.Algebra.SymmetricPolynomials: flaggedSkewSchurPol :: (Eq a, C a) => Partition -> Partition -> [Int] -> [Int] -> Spray a
+ Math.Algebra.SymmetricPolynomials: flaggedSkewSchurPol' :: Partition -> Partition -> [Int] -> [Int] -> QSpray
+ Math.Algebra.SymmetricPolynomials: hallLittlewoodPolynomial :: (Eq a, C a) => Int -> Partition -> Char -> SimpleParametricSpray a
+ Math.Algebra.SymmetricPolynomials: hallLittlewoodPolynomial' :: Int -> Partition -> Char -> SimpleParametricQSpray
+ Math.Algebra.SymmetricPolynomials: kostkaFoulkesPolynomial :: (Eq a, C a) => Partition -> Partition -> Spray a
+ Math.Algebra.SymmetricPolynomials: kostkaFoulkesPolynomial' :: Partition -> Partition -> QSpray
+ Math.Algebra.SymmetricPolynomials: prettySymmetricSimpleParametricQSpray :: [String] -> SimpleParametricQSpray -> String
+ Math.Algebra.SymmetricPolynomials: skewFactorialSchurPol :: (Eq a, C a) => Int -> Partition -> Partition -> IntMap a -> Spray a
+ Math.Algebra.SymmetricPolynomials: skewFactorialSchurPol' :: Int -> Partition -> Partition -> IntMap Rational -> QSpray
+ Math.Algebra.SymmetricPolynomials: skewHallLittlewoodPolynomial :: (Eq a, C a) => Int -> Partition -> Partition -> Char -> SimpleParametricSpray a
+ Math.Algebra.SymmetricPolynomials: skewHallLittlewoodPolynomial' :: Int -> Partition -> Partition -> Char -> SimpleParametricQSpray
+ Math.Algebra.SymmetricPolynomials: transitionsSchurToHallLittlewood :: Int -> Char -> Map Partition (Map Partition (Spray Int))
Files
- CHANGELOG.md +19/−2
- README.md +30/−3
- jackpolynomials.cabal +7/−6
- src/Math/Algebra/Jack.hs +3/−3
- src/Math/Algebra/Jack/Internal.hs +383/−4
- src/Math/Algebra/JackPol.hs +18/−11
- src/Math/Algebra/SymmetricPolynomials.hs +375/−21
- tests/Main.hs +210/−1
CHANGELOG.md view
@@ -87,10 +87,27 @@ combination of some Schur polynomials * new function `jackCombination`, to get a symmetric polynomial as a linear -combination of some Jack polynomials +combination of some Jack polynomials with a fixed Jack parameter * new function `jackSymbolicCombination`, to get a symmetric polynomial as a linear combination of some Jack polynomials with symbolic Jack parameter * new functions `kostkaNumbers` and `symbolicKostkaNumbers`, to get the Kostka -numbers with parameter+numbers with parameter + +1.4.3.0 +------- +* new function `kostkaFoulkesPolynomial`, to get a Kostka-Foulkes polynomial + +* new function `hallLittlewoodPolynomial`, to get a Hall-Littlewood polynomial + +* new function `skewHallLittlewoodPolynomial`, to get a skew Hall-Littlewood +polynomial + +* new function `flaggedSchurPol`, to get a flagged Schur polynomial + +* new function `flaggedSkewSchurPol`, to get a flagged skew Schur polynomial + +* new function `factorialSchurPol`, to get a factorial Schur polynomial + +* new function `skewFactorialSchurPol`, to get a skew factorial Schur polynomial
README.md view
@@ -1,6 +1,6 @@ # jackpolynomials -***Jack, zonal, Schur and skew Schur polynomials.*** +***Jack, zonal, Schur, skew Schur, and Hall-Littlewood polynomials.*** <!-- badges: start --> [](https://github.com/stla/jackpolynomials/actions/workflows/Stack-lts.yml) @@ -10,8 +10,9 @@ Schur polynomials have applications in combinatorics and zonal polynomials have applications in multivariate statistics. They are particular cases of [Jack polynomials](https://en.wikipedia.org/wiki/Jack_function). This package -allows to evaluate these polynomials and to compute them in symbolic form. It -also provides some utilities for symmetric polynomials. +allows to evaluate these polynomials as well as the Hall-Littlewood polynomials +and to compute them in symbolic form. It also provides some utilities for +symmetric polynomials. ___ @@ -179,6 +180,32 @@ -- [ 3*t^4 + 10*t^3 + 27*t^2 + 16*t ] %//% [ t^2 + 2*t + 1 ] ``` + +### Hall-Littlewood polynomials + +The package can also compute the Hall-Littlewood polynomials. A Hall-Littlewood +polynomial is a multivariate symmetric polynomial associated to an integer +partition and whose coefficients depend on a parameter. More precisely, the +coefficients are some polynomials in this parameter. So the Hall-Littlewood +polynomials implemented in the package, returned by the +`hallLittlewoodPolynomial` function, are represented by some sprays of type +`SimpleParametricSpray a`, an alias of the type `Spray (Spray a)`. + +When the value of the parameter of a Hall-Littlewood polynomial is `0`, then +this polynomial is the Schur polynomial of the given partition. + +```haskell +import Math.Algebra.JackPol +import Math.Algebra.SymmetricPolynomials +import Math.Algebra.Hspray +lambda = [2, 1] +hlPoly = hallLittlewoodPolynomial 3 lambda 'P' :: SimpleParametricQSpray +putStrLn $ prettySymmetricSimpleParametricQSpray ["t"] hlPoly +-- (1)*M[2,1] + (-t^2 - t + 2)*M[1,1,1] +hlPolyAt0 = substituteParameters hlPoly [0] +hlPolyAt0 == schurPol' 3 lambda +-- True +``` ## References
jackpolynomials.cabal view
@@ -1,7 +1,7 @@ name: jackpolynomials -version: 1.4.2.0 -synopsis: Jack, zonal, Schur and skew Schur polynomials -description: This library can compute Jack polynomials, zonal polynomials, Schur and skew Schur polynomials. It also provides some utilities for symmetric polynomials. +version: 1.4.3.0 +synopsis: Jack, zonal, Schur, and Hall-Littlewood polynomials +description: This library can compute Jack polynomials, zonal polynomials, Schur polynomials, skew Schur polynomials, Hall-Littlewood polynomials, skew Hall-Littlewood polynomials, flagged Schur polynomials, skew flagged Schur polynomials, factorial Schur polynomials, and skew factorial Schur polynomials. It also provides some utilities for symmetric polynomials. homepage: https://github.com/stla/jackpolynomials#readme license: GPL-3 license-file: LICENSE @@ -26,7 +26,7 @@ , ilist >= 0.4.0.1 && < 0.4.1 , array >= 0.5.4.0 && < 0.6 , lens >= 5.0.1 && < 5.3 - , hspray >= 0.5.0.0 && < 0.6.0.0 + , hspray >= 0.5.3.0 && < 0.6.0.0 , numeric-prelude >= 0.4.4 && < 0.5 , combinat >= 0.2.10 && < 0.3 , containers >= 0.6.4.1 && < 0.8 @@ -56,11 +56,12 @@ , tasty >= 1.4 && < 1.6 , tasty-hunit >= 0.10 && < 0.11 , jackpolynomials - , hspray >= 0.5.0.0 && < 0.6.0.0 + , hspray >= 0.5.3.0 && < 0.6.0.0 , hypergeomatrix >= 1.1.0.2 && < 2 , combinat >= 0.2.10 && < 0.3 , containers >= 0.6.4.1 && < 0.8 , numeric-prelude >= 0.4.4 && < 0.5 + , matrix >= 0.3.6.0 && < 0.4 Default-Language: Haskell2010 ghc-options: -Wall -Wcompat @@ -78,7 +79,7 @@ Build-Depends: base >= 4.7 && < 5 , miniterion >= 0.1.1.0 && < 0.2 , jackpolynomials - , hspray >= 0.5.0.0 && < 0.6.0.0 + , hspray >= 0.5.3.0 && < 0.6.0.0 Default-Language: Haskell2010 ghc-options: -Wall -Wcompat
src/Math/Algebra/Jack.hs view
@@ -48,16 +48,16 @@ -> a -- ^ Jack parameter -> Char -- ^ which Jack polynomial, @'J'@, @'C'@, @'P'@ or @'Q'@ -> a -jack [] _ _ _ = error "jack: empty list of variables" +jack [] _ _ _ = error "jack: empty list of variables." jack x@(x0:_) lambda alpha which = case _isPartition lambda of - False -> error "jack: invalid integer partition" + False -> error "jack: invalid integer partition." True -> case which of 'J' -> resultJ 'C' -> jackCoeffC lambda alpha * resultJ 'P' -> jackCoeffP lambda alpha * resultJ 'Q' -> jackCoeffQ lambda alpha * resultJ - _ -> error "jack: please use 'J', 'C', 'P' or 'Q' for last argument" + _ -> error "jack: please use 'J', 'C', 'P' or 'Q' for last argument." where resultJ = jac (length x) 0 lambda lambda arr0 one nll = _N lambda lambda
src/Math/Algebra/Jack/Internal.hs view
@@ -21,6 +21,16 @@ , _inverseKostkaMatrix , _symbolicKostkaNumbers , _inverseSymbolicKostkaMatrix + , _kostkaFoulkesPolynomial + , _hallLittlewoodPolynomialsInSchurBasis + , _transitionMatrixHallLittlewoodSchur + , skewHallLittlewoodP + , skewHallLittlewoodQ + , flaggedSemiStandardYoungTableaux + , tableauWeight + , isIncreasing + , flaggedSkewTableaux + , skewTableauWeight ) where import Prelude @@ -38,7 +48,14 @@ import Algebra.ToInteger ( fromIntegral ) import qualified Data.Foldable as DF import qualified Data.HashMap.Strict as HM -import Data.List.Extra ( unsnoc ) +import Data.List ( + nub + , foldl1' + , uncons + ) +import Data.List.Extra ( + unsnoc + ) import Data.List.Index ( iconcatMap ) import Data.Map.Strict ( Map ) import qualified Data.Map.Strict as DM @@ -55,8 +72,14 @@ , getElem , fromLists ) -import Data.Maybe ( fromJust ) -import Data.Sequence ( Seq ) +import Data.Maybe ( fromJust, isJust ) +import Data.Sequence ( + Seq + , (|>) + , (<|) + , (><) + , Seq ( (:<|) ) + ) import qualified Data.Sequence as S import Data.Tuple.Extra ( fst3 ) import qualified Data.Vector as V @@ -67,8 +90,12 @@ , asRatioOfSprays , Spray, (.^) , Powers (..) - , lone, unitSpray + , SimpleParametricSpray + , zeroSpray + , isZeroSpray + , lone, lone', unitSpray , sumOfSprays + , productOfSprays , FunctionLike (..) ) import Math.Combinat.Partitions.Integer ( @@ -77,13 +104,344 @@ , partitions , dominates , partitionWidth + , toPartitionUnsafe + , dropTailingZeros ) import qualified Math.Combinat.Partitions.Integer as MCP +import Math.Combinat.Partitions.Skew ( + SkewPartition + , mkSkewPartition + , skewPartitionElements + ) +import Math.Combinat.Tableaux.GelfandTsetlin ( + GT + , kostkaGelfandTsetlinPatterns + ) import Math.Combinat.Tableaux.LittlewoodRichardson ( _lrRule ) type Partition = [Int] +gtPatternDiagonals :: GT -> (Int, [MCP.Partition]) +gtPatternDiagonals pattern = (corner, [diagonal j | j <- [1 .. l]]) + where + l = length pattern - 1 + corner = pattern !! l !! 0 + diagonal j = + (toPartitionUnsafe . dropTailingZeros) + [pattern !! r !! c | (r, c) <- zip [l-j .. l] [0 .. j]] +gtPatternToTableau :: GT -> [Seq Int] +gtPatternToTableau pattern = + if l >= 0 + then DF.toList $ go 0 startingTableau + else [S.replicate corner 1] + where + (corner, diagonals) = gtPatternDiagonals pattern + diagonals' = toPartitionUnsafe [corner] : diagonals + l = length diagonals - 1 + lambda = diagonals !! l + m = partitionWidth lambda + startingTableau = S.replicate m S.Empty + zippedDiagonals = zip diagonals diagonals' + skewPartition i = mkSkewPartition (zippedDiagonals !! i) + go i tableau + | i == 0 = go 1 (S.adjust' (flip (><) (S.replicate corner 1)) 0 tableau) + | i == l+2 = tableau + | otherwise = + go (i+1) (growTableau (i+1) tableau (skewPartition (i-1))) + growTableau :: Int -> Seq (Seq Int) -> SkewPartition -> Seq (Seq Int) + growTableau j tableau skewPart = + DF.foldr (\(i, _) -> S.adjust' (flip (|>) j) (i-1)) tableau + (skewPartitionElements skewPart) + +semiStandardTableauxWithGivenShapeAndWeight :: + Partition -> Partition -> [[Seq Int]] +semiStandardTableauxWithGivenShapeAndWeight lambda mu = + if lambda' `dominates` mu' + then map gtPatternToTableau (kostkaGelfandTsetlinPatterns lambda' mu') + else [] + where + lambda' = toPartitionUnsafe lambda + mu' = toPartitionUnsafe mu + +-- length lambda = length as = length bs; as <= bs; last bs >= length lambda +flaggedSemiStandardYoungTableaux :: Partition -> [Int] -> [Int] -> [[[Int]]] +flaggedSemiStandardYoungTableaux lambda as bs = + worker (repeat 0) lambda 0 + where + worker _ [] _ = [[]] + worker prevRow (s:ss) i + = [ (r:rs) + | r <- row (bs !! i) s (as !! i) prevRow + , rs <- worker (map (+1) r) ss (i + 1) ] + -- weekly increasing lists of length @len@, pointwise at least @xs@, + -- maximum value @n@, minimum value @prev@. + row :: Int -> Int -> Int -> [Int] -> [[Int]] + row n len prev xxs = + if len == 0 + then [[]] + else [ (j:js) | j <- [max x prev .. n], js <- row n (len-1) j xs ] + where + (x, xs) = fromJust (uncons xxs) + +tableauWeight :: [[Int]] -> [Int] +tableauWeight tableau = [count i | i <- [1 .. m]] + where + x = concat tableau + m = maximum x + count i = sum [fromEnum (k == i) | k <- x] + +flaggedSkewTableaux :: + Partition -> Partition -> [Int] -> [Int] -> [[(Int,[Int])]] +flaggedSkewTableaux lambda mu as bs = worker uus vvs dds (repeat 1) 0 + where + uus = mu ++ (replicate (length lambda - length mu) 0) + vvs = zipWith (-) lambda uus + dds = _diffSequence uus + _diffSequence :: [Int] -> [Int] + _diffSequence = go where + go (x:ys@(y:_)) = (x-y) : go ys + go [x] = [x] + go [] = [] + -- | @worker inner outerMinusInner innerdiffs lowerbound + worker :: [Int] -> [Int] -> [Int] -> [Int] -> Int -> [[(Int,[Int])]] + worker (u:us) (v:vs) (d:ds) lb i + = [ (u, this):rest + | this <- row (bs !! i) v (as !! i) lb + , let lb' = (replicate d 1 ++ map (+1) this) + , rest <- worker us vs ds lb' (i + 1)] + worker [] _ _ _ _ = [ [] ] + worker (_:_) [] _ _ _ = [ [] ] + worker (_:_) (_:_) [] _ _ = [ [] ] + -- weekly increasing lists of length @len@, pointwise at least @xs@, + -- maximum value @n@, minimum value @prev@. + row :: Int -> Int -> Int -> [Int] -> [[Int]] + row n len prev xxs = + if len == 0 + then [[]] + else [ (j:js) | j <- [max x prev .. n], js <- row n (len-1) j xs ] + where + (x, xs) = fromJust (uncons xxs) + +skewTableauWeight :: [(Int, [Int])] -> [Int] +skewTableauWeight skewT = [count i | i <- [1 .. m]] + where + (_, entries) = unzip skewT + x = concat entries + m = maximum x + count i = sum [fromEnum (k == i) | k <- x] + +isIncreasing :: [Int] -> Bool +isIncreasing s = + and [s !! i <= s !! (i+1) | i <- [0 .. length s - 2]] + +isDecreasing :: Seq Int -> Bool +isDecreasing s = + and [s `S.index` i >= s `S.index` (i+1) | i <- [0 .. S.length s - 2]] + +cartesianProduct :: Seq Int -> [Seq Int] +cartesianProduct (S.Empty) = [] +cartesianProduct (i:<|is) + | S.null is = [S.singleton j | j <- [i, i-1 .. 0]] + | otherwise = [j <| s | j <- [i, i-1 .. 0], s <- previous] + where + previous = cartesianProduct is + +horizontalStrip :: Seq Int -> Seq Int -> Bool +horizontalStrip lambda mu = all (`elem` [0, 1]) theta' + where + lambda' = S.fromList $ _dualPartition (DF.toList lambda) + mu' = S.fromList $ _dualPartition (DF.toList mu) + mu'' = mu' >< (S.replicate (S.length lambda' - S.length mu') 0) + theta' = S.zipWith (-) lambda' mu'' + +columnStrictTableau :: [Seq Int] -> Bool +columnStrictTableau tableau = + and (zipWith horizontalStrip tableau tail_tableau) + where tail_tableau = drop 1 tableau + +_paths :: Int -> Seq Int -> Seq Int -> [[Seq Int]] +_paths n lambda mu = filter columnStrictTableau tableaux + where + mu' = mu >< (S.replicate (S.length lambda - S.length mu) 0) + diffs = S.zipWith (-) lambda mu' + grid = cartesianProduct diffs + kappas = filter isDecreasing [S.zipWith (+) kappa mu' | kappa <- grid] + combos = combinations 0 (length kappas - 1) (n-1) + where + combinations :: Int -> Int -> Int -> [[Int]] + combinations a b m + | m == 0 = [[]] + | m == 1 = [[i] | i <- [a .. b]] + | otherwise = + [i : combo | i <- [a .. b], combo <- combinations i b (m-1)] + tableaux = + map (\combo -> lambda : (map ((!!) kappas) combo) ++ [mu']) combos + +psi_lambda_mu :: forall a. (Eq a, AlgRing.C a) + => Seq Int -> Seq Int -> Spray a +psi_lambda_mu lambda mu = productOfSprays sprays + where + range = [1 .. lambda `S.index` 0] + pair j = ( + 1 + DF.sum (fmap (\k -> fromEnum (k == j)) lambda) + , DF.sum (fmap (\k -> fromEnum (k == j)) mu) + ) + pairs = filter (\(l, m) -> l == m) (map pair range) + t = lone' 1 + sprays = map (\(_, m) -> AlgRing.one +> AlgAdd.negate (t m)) pairs + +phi_lambda_mu :: forall a. (Eq a, AlgRing.C a) + => Seq Int -> Seq Int -> Spray a +phi_lambda_mu lambda mu = productOfSprays sprays + where + range = [1 .. lambda `S.index` 0] + pair j = ( + DF.sum (fmap (\k -> fromEnum (k == j)) lambda) + , 1 + DF.sum (fmap (\k -> fromEnum (k == j)) mu) + ) + pairs = filter (\(l, m) -> l == m) (map pair range) + t = lone' 1 + sprays = map (\(m, _) -> AlgRing.one +> AlgAdd.negate (t m)) pairs + +skewHallLittlewoodP :: forall a. (Eq a, AlgRing.C a) + => Int -> Seq Int -> Seq Int -> SimpleParametricSpray a +skewHallLittlewoodP n lambda mu = + sumOfSprays [productOfSprays $ sprays (reverse path) | path <- paths] + where + paths = _paths n lambda mu + lones = [lone' i | i <- [1 .. n]] + sprays nu = + [psi_lambda_mu next_nu_i nu_i *^ lone_i (DF.sum next_nu_i - DF.sum nu_i) + | (next_nu_i, nu_i, lone_i) <- zip3 (drop 1 nu) nu lones] + +skewHallLittlewoodQ :: forall a. (Eq a, AlgRing.C a) + => Int -> Seq Int -> Seq Int -> SimpleParametricSpray a +skewHallLittlewoodQ n lambda mu = + sumOfSprays [productOfSprays $ sprays (reverse path) | path <- paths] + where + paths = _paths n lambda mu + lones = [lone' i | i <- [1 .. n]] + sprays nu = + [phi_lambda_mu next_nu_i nu_i *^ lone_i (DF.sum next_nu_i - DF.sum nu_i) + | (next_nu_i, nu_i, lone_i) <- zip3 (drop 1 nu) nu lones] + +charge :: Seq Int -> Int +charge w = if l == 0 || n == 1 then 0 else DF.sum indices' + charge w' + where + l = S.length w + n = DF.maximum w + (positions', indices') = + go 1 (S.singleton (fromJust $ S.elemIndexL 1 w)) (S.singleton 0) + w' = DF.foldr S.deleteAt w (S.sort positions') + go :: Int -> Seq Int -> Seq Int -> (Seq Int, Seq Int) + go r positions indices + | r == n = (positions, indices) + | otherwise = go (r+1) (positions |> pos') (indices |> index') + where + pos = positions `S.index` (r-1) + index = indices `S.index` (r-1) + v = S.drop (pos+1) w + rindex = S.elemIndexL (r+1) v + (pos', index') = + if isJust rindex + then (1 + pos + fromJust rindex, index) + else (fromJust (S.elemIndexL (r+1) w), index + 1) + +-- isDominated :: Seq Int -> Seq Int -> Bool +-- isDominated mu lambda = +-- (MCP.Partition (DF.toList lambda)) `dominates` (MCP.Partition (DF.toList mu)) + +-- -- assumes sum lambda == sum mu +-- ssytxWithGivenShapeAndContent :: Seq Int -> Seq Int -> [Seq (Seq Int)] +-- ssytxWithGivenShapeAndContent lambda mu = +-- if all (== 1) lambda +-- then if all (== 1) mu +-- then [S.fromList [S.singleton i | i <- [1 .. S.length lambda]]] +-- else [] +-- else if isDominated mu lambda +-- then nub all_ssytx +-- else [] +-- where +-- dropTrailingZeros = S.dropWhileR (== 0) +-- l = S.length lambda +-- m = S.length mu +-- mu' = dropTrailingZeros $ S.adjust' (subtract 1) (m-1) mu +-- zippedKappas = +-- zip [0 ..] [S.adjust' (subtract 1) i lambda | i <- [0 .. l - 1]] +-- all_ssytx = concatMap f zippedKappas +-- where +-- f (i, kappa) = +-- if isDecreasing kappa +-- then nub $ +-- map g (ssytxWithGivenShapeAndContent kappa' mu') +-- else [] +-- where +-- kappa' = dropTrailingZeros kappa +-- g ssyt = if i < S.length ssyt +-- then S.adjust' (|> m) i ssyt +-- else ssyt |> (S.singleton m) +-- -- g ssyt = if i < length ssyt +-- -- then (element i .~ ssyt !! i |> l) ssyt +-- -- else ssyt ++ [S.singleton l] + +_kostkaFoulkesPolynomial :: + (Eq a, AlgRing.C a) => Partition -> Partition -> Spray a +_kostkaFoulkesPolynomial lambda mu = + if sum lambda == sum mu + then sumOfSprays sprays + else zeroSpray + where + tableaux = semiStandardTableauxWithGivenShapeAndWeight lambda mu + mm = lone' 1 -- TODO: fix lone' 1 0 (= fromList [(Powers {exponents = fromList [0], nvariables = 1},1 % 1)]) + sprays = + map (mm . charge . ((foldl1' (S.><)) . (map S.reverse))) tableaux + +b_lambda :: (Eq a, AlgRing.C a) => Partition -> Spray a +b_lambda lambda = productOfSprays sprays + where + table = [sum [fromEnum (k == j) | k <- lambda] | j <- nub lambda] + sprays = map phi table + where + phi r = productOfSprays + [AlgRing.one +> AlgAdd.negate (lone' 1 i) | i <- [1 .. r]] + +_transitionMatrixHallLittlewoodSchur :: + (Eq a, AlgRing.C a) => Char -> Int -> Map Partition (Map Partition (Spray a)) +_transitionMatrixHallLittlewoodSchur which weight = + DM.fromDistinctDescList $ if which == 'P' + then zip lambdas [maps i | i <- rg] + else zip lambdas + [DM.mapWithKey (\lambda c -> b_lambda lambda ^*^ c) (maps i) | i <- rg] + where + lambdas = reverse (map fromPartition (partitions weight)) + rg = [1 .. length lambdas] + kfs = map f lambdas + f kappa = + map (\mu -> _kostkaFoulkesPolynomial kappa mu) + lambdas + matrix = inverseUnitTriangularMatrix (fromLists kfs) + maps i = DM.filter (not . isZeroSpray) + (DM.fromDistinctDescList (zip lambdas (V.toList (getRow i matrix)))) + +_hallLittlewoodPolynomialsInSchurBasis :: + (Eq a, AlgRing.C a) => Char -> Partition -> Map Partition (Spray a) +_hallLittlewoodPolynomialsInSchurBasis which lambda = + if which == 'P' + then coeffs + else DM.map ((^*^) (b_lambda lambda)) coeffs + where + weight = sum lambda + lambdas = + reverse $ filter (<= lambda) (map fromPartition (partitions weight)) + kfs = map f lambdas + f kappa = + map (\mu -> _kostkaFoulkesPolynomial kappa mu) + lambdas -- (dominatedPartitions kappa) + matrix = inverseUnitTriangularMatrix (fromLists kfs) + coeffs = DM.filter (not . isZeroSpray) + (DM.fromDistinctDescList (zip lambdas (V.toList (getRow 1 matrix)))) + _e :: AlgRing.C a => MCP.Partition -> a -> a _e lambda alpha = alpha * fromIntegral (_n (dualPartition lambda)) - fromIntegral (_n lambda) @@ -300,6 +658,27 @@ | (u, v) <- vectors] ) newRow = rowVector (V.snoc (V.replicate (d - 1) AlgAdd.zero) lastEntry) + invmat = (invminor <|> newColumn) <-> newRow + +inverseUnitTriangularMatrix :: (Eq a, AlgRing.C a) => Matrix a -> Matrix a +inverseUnitTriangularMatrix mat = + if d == 1 then mat else invmat + where + d = nrows mat + invminor = inverseUnitTriangularMatrix (minorMatrix d d mat) + lastColumn = V.init (getCol d mat) + vectors = [ + ( + V.drop (i-1) (getRow i invminor) + , V.drop (i-1) lastColumn + ) + | i <- [1 .. d-1] + ] + newColumn = colVector (V.fromList + [AlgAdd.negate (V.foldl1 (AlgAdd.+) (V.zipWith (*) u v)) + | (u, v) <- vectors] + ) + newRow = rowVector (V.snoc (V.replicate (d - 1) AlgAdd.zero) AlgRing.one) invmat = (invminor <|> newColumn) <-> newRow _isPartition :: Partition -> Bool
src/Math/Algebra/JackPol.hs view
@@ -50,15 +50,20 @@ -> a -- ^ Jack parameter -> Char -- ^ which Jack polynomial, @'J'@, @'C'@, @'P'@ or @'Q'@ -> Spray a -jackPol n lambda alpha which = - case _isPartition lambda of - False -> error "jackPol: invalid integer partition" - True -> case which of +jackPol n lambda alpha which + | n < 0 = error "jackPol: negative number of variables." + | not (_isPartition lambda) = error "jackPol: invalid integer partition." + | not (which `elem` ['J', 'C', 'P', 'Q']) = + error "jackPol: please use 'J', 'C', 'P' or 'Q' for last argument." + | n == 0 = if null lambda + then unitSpray + else zeroSpray + | otherwise = + case which of 'J' -> resultJ 'C' -> jackCoeffC lambda alpha *^ resultJ 'P' -> jackCoeffP lambda alpha *^ resultJ - 'Q' -> jackCoeffQ lambda alpha *^ resultJ - _ -> error "jackPol: please use 'J', 'C', 'P' or 'Q' for last argument" + _ -> jackCoeffQ lambda alpha *^ resultJ where resultJ = jac (length x) 0 lambda lambda arr0 one nll = _N lambda lambda @@ -134,10 +139,12 @@ => Int -- ^ number of variables -> Partition -- ^ partition of integers -> Spray a -schurPol n lambda = - case _isPartition lambda of - False -> error "schurPol: invalid integer partition" - True -> sch n 1 lambda arr0 +schurPol n lambda + | n < 0 = error "schurPol: negative number of variables." + | not (_isPartition lambda) = + error "schurPol: invalid integer partition." + | n == 0 = if null lambda then unitSpray else zeroSpray + | otherwise = sch n 1 lambda arr0 where x = map lone [1 .. n] :: [Spray a] nll = _N lambda lambda @@ -193,7 +200,7 @@ -> Spray a skewSchurPol n lambda mu = case isSkewPartition lambda mu of - False -> error "skewSchurPol: invalid skew partition" + False -> error "skewSchurPol: invalid skew partition." True -> DM.foldlWithKey' f zeroSpray lrCoefficients where lrCoefficients = skewSchurLRCoefficients lambda mu
src/Math/Algebra/SymmetricPolynomials.hs view
@@ -42,6 +42,7 @@ , prettySymmetricQSpray , prettySymmetricQSpray' , prettySymmetricParametricQSpray + , prettySymmetricSimpleParametricQSpray -- * Operators on the space of symmetric polynomials , laplaceBeltrami , calogeroSutherland @@ -57,6 +58,25 @@ -- * Kostka numbers , kostkaNumbers , symbolicKostkaNumbers + -- * Kostka-Foulkes polynomials + , kostkaFoulkesPolynomial + , kostkaFoulkesPolynomial' + -- * Hall-Littlewood polynomials + , hallLittlewoodPolynomial + , hallLittlewoodPolynomial' + , transitionsSchurToHallLittlewood + , skewHallLittlewoodPolynomial + , skewHallLittlewoodPolynomial' + -- * Flagged Schur polynomials + , flaggedSchurPol + , flaggedSchurPol' + , flaggedSkewSchurPol + , flaggedSkewSchurPol' + -- * Factorial Schur polynomials + , factorialSchurPol + , factorialSchurPol' + , skewFactorialSchurPol + , skewFactorialSchurPol' ) where import Prelude hiding ( fromIntegral, fromRational ) import qualified Algebra.Additive as AlgAdd @@ -67,8 +87,17 @@ import Algebra.ToInteger ( fromIntegral ) import qualified Data.Foldable as DF import qualified Data.HashMap.Strict as HM -import Data.List ( foldl1', nub ) -import Data.List.Extra ( unsnoc ) +import Data.List ( + foldl1' + , nub + ) +import Data.List.Extra ( + unsnoc + , allSame + ) +import Data.IntMap.Strict ( + IntMap + ) import qualified Data.IntMap.Strict as IM import Data.Map.Merge.Strict ( merge @@ -103,6 +132,8 @@ , QSpray' , ParametricSpray , ParametricQSpray + , SimpleParametricSpray + , SimpleParametricQSpray , lone , qlone , lone' @@ -115,11 +146,13 @@ , RatioOfQSprays , constantRatioOfSprays , zeroRatioOfSprays + , unitRatioOfSprays , prettyRatioOfQSpraysXYZ , showNumSpray , showQSpray , showQSpray' , showSpray + , prettyQSprayXYZ , zeroSpray , unitSpray , productOfSprays @@ -136,16 +169,39 @@ , _kostkaNumbers , _symbolicKostkaNumbers , _inverseSymbolicKostkaMatrix + , _kostkaFoulkesPolynomial + , _hallLittlewoodPolynomialsInSchurBasis + , _transitionMatrixHallLittlewoodSchur + , skewHallLittlewoodP + , skewHallLittlewoodQ + , isSkewPartition + , flaggedSemiStandardYoungTableaux + , tableauWeight + , isIncreasing + , flaggedSkewTableaux + , skewTableauWeight ) +import Math.Algebra.JackPol ( + schurPol + ) import Math.Combinat.Compositions ( compositions1 ) import Math.Combinat.Partitions.Integer ( fromPartition + , toPartition , mkPartition , partitions , partitionWidth ) +import Math.Combinat.Partitions.Skew ( + mkSkewPartition + ) import Math.Combinat.Permutations ( permuteMultiset ) +import Math.Combinat.Tableaux ( semiStandardYoungTableaux ) import Math.Combinat.Tableaux.GelfandTsetlin ( kostkaNumbersWithGivenMu ) +import Math.Combinat.Tableaux.Skew ( + SkewTableau (..) + , semiStandardSkewTableaux + ) -- | monomial symmetric polynomial @@ -243,7 +299,7 @@ mspray = makeMSpray spray -- | Prints a symmetric parametric spray as a linear combination of monomial --- symmetric polynomials +-- symmetric polynomials. -- -- >>> putStrLn $ prettySymmetricParametricQSpray ["a"] $ jackSymbolicPol' 3 [3, 1, 1] 'J' -- { [ 4*a^2 + 10*a + 6 ] }*M[3,1,1] + { [ 8*a + 12 ] }*M[2,2,1] @@ -254,8 +310,18 @@ where mspray = makeMSpray spray +-- | Prints a symmetric simple parametric spray as a linear combination of monomial +-- symmetric polynomials. +prettySymmetricSimpleParametricQSpray :: + [String] -> SimpleParametricQSpray -> String +prettySymmetricSimpleParametricQSpray letters spray = + showSpray (prettyQSprayXYZ letters) ("(", ")") + showSymmetricMonomials mspray + where + mspray = makeMSpray spray + -- | Laplace-Beltrami operator on the space of homogeneous symmetric polynomials; --- neither symmetry and homogeneity are checked +-- neither symmetry and homogeneity are checked. laplaceBeltrami :: (Eq a, AlgField.C a) => a -> Spray a -> Spray a laplaceBeltrami alpha spray = if isConstant spray @@ -308,10 +374,10 @@ error "psPolynomial: invalid partition." | null lambda = unitSpray -- | any (> n) lambda = zeroSpray --- | llambda > n = zeroSpray + | llambda > n = zeroSpray | otherwise = productOfSprays sprays where - -- llambda = length lambda + llambda = length lambda sprays = [HM.fromList $ [f i k | i <- [1 .. n]] | k <- lambda] f j k = (Powers expts j, AlgRing.one) where @@ -627,15 +693,16 @@ | not (_isPartition lambda) = error "cshPolynomial: invalid partition." | null lambda = unitSpray --- | llambda > n = zeroSpray + | llambda > n = zeroSpray | otherwise = productOfSprays (map cshPolynomialK lambda) where - -- llambda = length lambda + llambda = length lambda cshPolynomialK k = sumOfSprays msSprays where parts = partitions k msSprays = - [msPolynomialUnsafe n (fromPartition part) | part <- parts, partitionWidth part <= n] + [msPolynomialUnsafe n (fromPartition part) + | part <- parts, partitionWidth part <= n] -- | power sum polynomial as a linear combination of -- complete symmetric homogeneous polynomials @@ -796,9 +863,15 @@ -- \(K_{\lambda,\mu}(\alpha) \neq 0\). kostkaNumbers :: Int -- ^ weight of the partitions - -> Rational -- Jack parameter + -> Rational -- ^ Jack parameter -> Map Partition (Map Partition Rational) -kostkaNumbers weight alpha = _kostkaNumbers weight weight alpha 'P' +kostkaNumbers weight alpha + | weight < 0 = + error "kostkaNumbers: negative weight." + | weight == 0 = + DM.singleton [] (DM.singleton [] 1) + | otherwise = + _kostkaNumbers weight weight alpha 'P' -- | Kostka numbers \(K_{\lambda,\mu}(\alpha)\) with symbolic parameter \(\alpha\) -- for a given weight of the partitions \(\lambda\) and \(\mu\). This returns a map @@ -808,7 +881,13 @@ -- partition \(\mu\) is included in the keys of this map if and only if -- \(K_{\lambda,\mu}(\alpha) \neq 0\). symbolicKostkaNumbers :: Int -> Map Partition (Map Partition RatioOfQSprays) -symbolicKostkaNumbers weight = _symbolicKostkaNumbers weight weight 'P' +symbolicKostkaNumbers weight + | weight < 0 = + error "symbolicKostkaNumbers: negative weight." + | weight == 0 = + DM.singleton [] (DM.singleton [] unitRatioOfSprays) + | otherwise = + _symbolicKostkaNumbers weight weight 'P' -- | monomial symmetric polynomials in Jack polynomials basis msPolynomialsInJackBasis :: @@ -841,9 +920,12 @@ -> Spray a -- ^ spray representing a symmetric polynomial -> Map Partition a -- ^ map representing the linear combination; a partition @lambda@ in the keys of this map corresponds to the term @coeff *^ jackPol' n lambda alpha which@, where @coeff@ is the value attached to this key and @n@ is the number of variables of the spray jackCombination alpha which spray = - _symmPolyCombination - (\lambda -> (combos IM.! (sum lambda)) DM.! lambda) - (AlgRing.*) spray + if not (which `elem` ['J', 'C', 'P', 'Q']) + then error "jackCombination: invalid character, must be 'J', 'C', 'P' or 'Q'." + else + _symmPolyCombination + (\lambda -> (combos IM.! (sum lambda)) DM.! lambda) + (AlgRing.*) spray where weights = filter (/= 0) (map DF.sum (allExponents spray)) n = numberOfVariables spray @@ -858,9 +940,11 @@ -> QSpray -- ^ spray representing a symmetric polynomial -> Map Partition RatioOfQSprays -- ^ map representing the linear combination; a partition @lambda@ in the keys of this map corresponds to the term @coeff *^ jackSymbolicPol' n lambda which@, where @coeff@ is the value attached to this key and @n@ is the number of variables of the spray jackSymbolicCombination which qspray = - _symmPolyCombination - (\lambda -> (combos IM.! (sum lambda)) DM.! lambda) - (AlgRing.*) (HM.map constantRatioOfSprays qspray) + if not (which `elem` ['J', 'C', 'P', 'Q']) + then error "jackSymbolicCombination: invalid character, must be 'J', 'C', 'P' or 'Q'." + else _symmPolyCombination + (\lambda -> (combos IM.! (sum lambda)) DM.! lambda) + (AlgRing.*) (HM.map constantRatioOfSprays qspray) where weights = filter (/= 0) (map DF.sum (allExponents qspray)) n = numberOfVariables qspray @@ -877,9 +961,11 @@ -> ParametricSpray a -- ^ parametric spray representing a symmetric polynomial -> Map Partition (RatioOfSprays a) -- ^ map representing the linear combination; a partition @lambda@ in the keys of this map corresponds to the term @coeff *^ jackSymbolicPol' n lambda which@, where @coeff@ is the value attached to this key and @n@ is the number of variables of the spray jackSymbolicCombination' which spray = - _symmPolyCombination - (\lambda -> (combos IM.! (sum lambda)) DM.! lambda) - (AlgRing.*) spray + if not (which `elem` ['J', 'C', 'P', 'Q']) + then error "jackSymbolicCombination': invalid character, must be 'J', 'C', 'P' or 'Q'." + else _symmPolyCombination + (\lambda -> (combos IM.! (sum lambda)) DM.! lambda) + (AlgRing.*) spray where weights = filter (/= 0) (map DF.sum (allExponents spray)) n = numberOfVariables spray @@ -887,6 +973,274 @@ IM.fromList (zip weights (map (msPolynomialsInJackSymbolicBasis which n) weights)) +-- | Kostka-Foulkes polynomial of two given partitions. This is a univariate +-- polynomial whose value at @1@ is the Kostka number of the two partitions. +kostkaFoulkesPolynomial :: + (Eq a, AlgRing.C a) => Partition -> Partition -> Spray a +kostkaFoulkesPolynomial lambda mu + | not (_isPartition lambda) = + error "kostkaFoulkesPolynomial: invalid partition." + | not (_isPartition mu) = + error "kostkaFoulkesPolynomial: invalid partition." + | otherwise = + _kostkaFoulkesPolynomial lambda mu + +-- | Kostka-Foulkes polynomial of two given partitions. This is a univariate +-- polynomial whose value at @1@ is the Kostka number of the two partitions. +kostkaFoulkesPolynomial' :: Partition -> Partition -> QSpray +kostkaFoulkesPolynomial' = kostkaFoulkesPolynomial + +-- | Hall-Littlewood polynomial of a given partition. This is a multivariate +-- symmetric polynomial whose coefficients are polynomial in one parameter. +hallLittlewoodPolynomial :: + (Eq a, AlgRing.C a) + => Int -- ^ number of variables + -> Partition -- ^ integer partition + -> Char -- ^ which Hall-Littlewood polynomial, @'P'@ or @'Q'@ + -> SimpleParametricSpray a +hallLittlewoodPolynomial n lambda which + | n < 0 = error "hallLittlewoodPolynomial: negative number of variables." + | not (_isPartition lambda) = + error "hallLittlewoodPolynomial: invalid partition." + | not (which `elem` ['P', 'Q']) = + error "hallLittlewoodPolynomial: last argument must be 'P' or 'Q'." + | null lambda = unitSpray + | length lambda > n = zeroSpray + | otherwise = sumOfSprays sprays + where + coeffs = _hallLittlewoodPolynomialsInSchurBasis which lambda + sprays = + DM.elems + (DM.mapWithKey + (\mu c -> c *^ (HM.map constantSpray (schurPol n mu))) coeffs) + +-- | Hall-Littlewood polynomial of a given partition. This is a multivariate +-- symmetric polynomial whose coefficients are polynomial in one parameter. +hallLittlewoodPolynomial' :: + Int -- ^ number of variables + -> Partition -- ^ integer partition + -> Char -- ^ which Hall-Littlewood polynomial, @'P'@ or @'Q'@ + -> SimpleParametricQSpray +hallLittlewoodPolynomial' = hallLittlewoodPolynomial + +-- | Hall-Littlewood polynomials as linear combinations of Schur polynomials. +transitionsSchurToHallLittlewood :: + Int -- ^ weight of the partitions of the Hall-Littlewood polynomials + -> Char -- ^ which Hall-Littlewood polynomials, @'P'@ or @'Q'@ + -> Map Partition (Map Partition (Spray Int)) +transitionsSchurToHallLittlewood weight which + | weight <= 0 = + error "transitionsHallLittlewoodToSchur: negative weight." + | not (which `elem` ['P', 'Q']) = + error "transitionsHallLittlewoodToSchur: the character must be 'P' or 'Q'." + | otherwise = + _transitionMatrixHallLittlewoodSchur which weight + +-- | Skew Hall-Littlewood polynomial of a given skew partition. This is a multivariate +-- symmetric polynomial whose coefficients are polynomial in one parameter. +skewHallLittlewoodPolynomial :: (Eq a, AlgRing.C a) + => Int -- ^ number of variables + -> Partition -- ^ outer partition of the skew partition + -> Partition -- ^ inner partition of the skew partition + -> Char -- ^ which skew Hall-Littlewood polynomial, @'P'@ or @'Q'@ + -> SimpleParametricSpray a +skewHallLittlewoodPolynomial n lambda mu which + | n < 0 = + error "skewHallLittlewoodPolynomial: negative number of variables." + | not (isSkewPartition lambda mu) = + error "skewHallLittlewoodPolynomial: invalid skew partition." + | not (which `elem` ['P', 'Q']) = + error "skewHallLittlewoodPolynomial: the character must be 'P' or 'Q'." + | n == 0 = + if lambda == mu then unitSpray else zeroSpray + | otherwise = + if which == 'P' + then skewHallLittlewoodP n (S.fromList lambda) (S.fromList mu) + else skewHallLittlewoodQ n (S.fromList lambda) (S.fromList mu) + +-- | Skew Hall-Littlewood polynomial of a given skew partition. This is a multivariate +-- symmetric polynomial whose coefficients are polynomial in one parameter. +skewHallLittlewoodPolynomial' :: + Int -- ^ number of variables + -> Partition -- ^ outer partition of the skew partition + -> Partition -- ^ inner partition of the skew partition + -> Char -- ^ which skew Hall-Littlewood polynomial, @'P'@ or @'Q'@ + -> SimpleParametricQSpray +skewHallLittlewoodPolynomial' = skewHallLittlewoodPolynomial + +-- | Flagged Schur polynomial. A flagged Schur polynomial is not symmetric +-- in general. +flaggedSchurPol :: + (Eq a, AlgRing.C a) + => Partition -- ^ integer partition + -> [Int] -- ^ lower bounds + -> [Int] -- ^ upper bounds + -> Spray a +flaggedSchurPol lambda as bs + | not (_isPartition lambda) = + error "flaggedSchurPol: invalid partition." + | not (allSame [llambda, las, lbs]) = + error "flaggedSchurPol: the partition and the lists of lower bounds and upper bounds must have the same length." + | llambda == 0 = + unitSpray + | not (isIncreasing as) = + error "flaggedSchurPol: the list of lower bounds is not increasing." + | not (isIncreasing bs) = + error "flaggedSchurPol: the list of upper bounds is not increasing." + | any (== True) (zipWith (>) as bs) = + error "flaggedSchurPol: lower bounds must be smaller than upper bounds." + | otherwise = sumOfSprays sprays + where + llambda = length lambda + las = length as + lbs = length bs + tableaux = flaggedSemiStandardYoungTableaux lambda as bs + monomial tableau = + productOfSprays $ zipWith lone' [1 ..] (tableauWeight tableau) + sprays = map monomial tableaux + +-- | Flagged Schur polynomial. A flagged Schur polynomial is not symmetric +-- in general. +flaggedSchurPol' :: + Partition -- ^ integer partition + -> [Int] -- ^ lower bounds + -> [Int] -- ^ upper bounds + -> QSpray +flaggedSchurPol' = flaggedSchurPol + +-- | Flagged skew Schur polynomial. A flagged skew Schur polynomial is not symmetric +-- in general. +flaggedSkewSchurPol :: + (Eq a, AlgRing.C a) + => Partition -- ^ outer partition of the skew partition + -> Partition -- ^ inner partition of the skew partition + -> [Int] -- ^ lower bounds + -> [Int] -- ^ upper bounds + -> Spray a +flaggedSkewSchurPol lambda mu as bs + | not (isSkewPartition lambda mu) = + error "flaggedSkewSchurPol: invalid skew partition." + | not (allSame [llambda, las, lbs]) = + error "flaggedSkewSchurPol: the outer partition and the lists of lower bounds and upper bounds must have the same length." + | not (isIncreasing as) = + error "flaggedSkewSchurPol: the list of lower bounds is not increasing." + | not (isIncreasing bs) = + error "flaggedSkewSchurPol: the list of upper bounds is not increasing." + | any (== True) (zipWith (>) as bs) = + error "flaggedSkewSchurPol: lower bounds must be smaller than upper bounds." + | lambda == mu = + unitSpray + | otherwise = sumOfSprays sprays + where + llambda = length lambda + las = length as + lbs = length bs + tableaux = flaggedSkewTableaux lambda mu as bs + monomial tableau = + productOfSprays $ zipWith lone' [1 ..] (skewTableauWeight tableau) + sprays = map monomial tableaux + +-- | Flagged skew Schur polynomial. A flagged skew Schur polynomial is not symmetric +-- in general. +flaggedSkewSchurPol' :: + Partition -- ^ outer partition of the skew partition + -> Partition -- ^ inner partition of the skew partition + -> [Int] -- ^ lower bounds + -> [Int] -- ^ upper bounds + -> QSpray +flaggedSkewSchurPol' = flaggedSkewSchurPol + +-- | Factorial Schur polynomial. See +-- [Kreiman's paper](https://www.combinatorics.org/ojs/index.php/eljc/article/view/v15i1r84/pdf) +-- /Products of factorial Schur functions/ for the definition. +factorialSchurPol :: + (Eq a, AlgRing.C a) + => Int -- ^ number of variables + -> Partition -- ^ integer partition + -> [a] -- ^ the sequence denoted by \(y\) in the reference paper + -> Spray a +factorialSchurPol n lambda y + | n < 0 = + error "factorialSchurPol: negative number of variables." + | not (_isPartition lambda) = + error "factorialSchurPol: invalid integer partition." + | n == 0 = + if l == 0 then unitSpray else zeroSpray + | otherwise = + sumOfSprays sprays + where + l = length lambda + tableaux = semiStandardYoungTableaux n (toPartition lambda) + lones = [lone i | i <- [1 .. n]] + idx tableau i j = + let row = tableau !! (i-1) + a = row !! (j-1) + in (a, a + j - i) + factor tableau i j = + let (a, k) = idx tableau i j in lones !! (a-1) <+ y !! (k-1) + i_ = [1 .. l] + ij_ = [(i, j) | i <- i_, j <- [1 .. lambda !! (i-1)]] + factors tableau = [factor tableau i j | (i, j) <- ij_] + spray tableau = productOfSprays (factors tableau) + sprays = map spray tableaux + +-- | Factorial Schur polynomial. See +-- [Kreiman's paper](https://www.combinatorics.org/ojs/index.php/eljc/article/view/v15i1r84/pdf) +-- /Products of factorial Schur functions/ for the definition. +factorialSchurPol' :: + Int -- ^ number of variables + -> Partition -- ^ integer partition + -> [Rational] -- ^ the sequence denoted by \(y\) in the reference paper + -> QSpray +factorialSchurPol' = factorialSchurPol + +-- | Skew factorial Schur polynomial. See +-- [Macdonald's paper](https://www.kurims.kyoto-u.ac.jp/EMIS/journals/SLC/opapers/s28macdonald.pdf) +-- /Schur functions: theme and variations/, 6th variation, for the definition. +skewFactorialSchurPol :: + (Eq a, AlgRing.C a) + => Int -- ^ number of variables + -> Partition -- ^ outer partition of the skew partition + -> Partition -- ^ inner partition of the skew partition + -> IntMap a -- ^ the sequence denoted by \(a\) in the reference paper + -> Spray a +skewFactorialSchurPol n lambda mu y + | n < 0 = + error "skewFactorialSchurPol: negative number of variables." + | not (isSkewPartition lambda mu) = + error "skewFactorialSchurPol: invalid skew integer partition." + | n == 0 = + if lambda == mu then unitSpray else zeroSpray + | otherwise = + sumOfSprays sprays + where + skewPartition = mkSkewPartition (toPartition lambda, toPartition mu) + skewTableaux = semiStandardSkewTableaux n skewPartition + getSkewTableau (SkewTableau x) = x + lones = [lone i | i <- [1 .. n]] + idx tableau i j = + let (offset, entries) = tableau !! (i-1) + a = entries !! (j-1) + in (a, a + offset + j - i) + factor tableau i j = + let (a, k) = idx tableau i j in lones !! (a-1) <+ y IM.! k + i_ = [1 .. length lambda] + ij_ tableau = + [(i, j) | i <- i_, j <- [1 .. length (snd (tableau !! (i-1)))]] + factors tableau = [factor tableau i j | (i, j) <- ij_ tableau] + spray tableau = productOfSprays (factors (getSkewTableau tableau)) + sprays = map spray skewTableaux + +-- | Skew factorial Schur polynomial. See +-- [Macdonald's paper](https://www.kurims.kyoto-u.ac.jp/EMIS/journals/SLC/opapers/s28macdonald.pdf) +-- /Schur functions: theme and variations/, 6th variation, for the definition. +skewFactorialSchurPol' :: + Int -- ^ number of variables + -> Partition -- ^ outer partition of the skew partition + -> Partition -- ^ inner partition of the skew partition + -> IntMap Rational -- ^ the sequence denoted by \(a\) in the reference paper + -> QSpray +skewFactorialSchurPol' = skewFactorialSchurPol -- test :: Bool -- test = poly == sumOfSprays sprays
tests/Main.hs view
@@ -1,10 +1,17 @@ module Main ( main ) where +import qualified Algebra.Additive as AlgAdd import qualified Algebra.Module as AlgMod +import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as DM +import Data.Matrix ( + fromLists + ) import Data.Ratio ( (%) ) import Math.Algebra.Hspray ( FunctionLike (..) , Spray, QSpray + , SimpleParametricSpray , lone, qlone + , zeroSpray , unitSpray , evalSpray , evalParametricSpray' @@ -16,6 +23,8 @@ , (%//%) , (/^) , sumOfSprays + , productOfSprays + , detLaplace ) import qualified Math.Algebra.Hspray as Hspray import Math.Algebra.Jack ( schur, skewSchur @@ -34,6 +43,7 @@ , symbolicHallInnerProduct , symbolicHallInnerProduct'' , msPolynomial + , msCombination , psPolynomial , psCombination , cshPolynomial @@ -46,6 +56,14 @@ , jackSymbolicCombination' , kostkaNumbers , symbolicKostkaNumbers + , kostkaFoulkesPolynomial + , hallLittlewoodPolynomial + , hallLittlewoodPolynomial' + , skewHallLittlewoodPolynomial' + , flaggedSchurPol' + , flaggedSkewSchurPol' + , factorialSchurPol' + , skewFactorialSchurPol' ) import Math.Combinat.Partitions.Integer ( toPartition @@ -90,7 +108,117 @@ "Tests" [ - testCase "jackSymbolicPol J" $ do + testCase "Factorial Schur polynomial with y=[0 .. ] is Schur polynomial" $ do + let + n = 4 + lambda = [3, 3, 2, 2] + y = replicate (n + lambda !! 0 - 1) 0 + factorialSchurPoly = factorialSchurPol' n lambda y + schurPoly = schurPol' n lambda + assertEqual "" schurPoly factorialSchurPoly + + , testCase "Factorial Schur polynomial as determinant" $ do + let + n = 3 + lambda = [3, 2, 2] + y = [2, 6, 1, 2, 3] + factorialSchurPoly = factorialSchurPol' n lambda y + lones = [qlone i | i <- [1 .. n]] + vandermonde = + productOfSprays [lones !! (i-1) ^-^ lones !! (j-1) + | i <- [1 .. n-1], j <- [i+1 .. n]] + x j k = productOfSprays [lones !! (j-1) <+ (y !! i) | i <- [0 .. k-1]] + l = length lambda + row i = [x i (lambda !! (j-1) + n - j) | j <- [1 .. l]] + matrix = fromLists [row i | i <- [1 .. l]] + det = detLaplace matrix + assertEqual "" det (vandermonde ^*^ factorialSchurPoly) + + , testCase "Skew factorial Schur polynomial with y=0 is skew Schur polynomial" $ do + let + n = 5 + lambda = [4, 3, 2, 2] + mu = [2, 2] + y = IM.fromList (zip [-2 .. 8] (repeat 0)) + skewFactorialSchurPoly = skewFactorialSchurPol' n lambda mu y + assertEqual "" skewFactorialSchurPoly (skewSchurPol' n lambda mu) + + , testCase "Skew factorial Schur polynomial as determinant" $ do + let + n = 3 + lambda = [3, 2, 2] + mu = [2, 1] + mu' = mu ++ [0] + y = IM.fromList (zip [-2 ..] [2, 6, 1, 2, 3, 4, 5, 6]) + tau r = IM.mapKeys (subtract r) y + skewFactorialSchurPoly = skewFactorialSchurPol' n lambda mu y + kappa r = if r == 0 then [] else [r] + h r a = if r < 0 then zeroSpray else factorialSchurPol' n (kappa r) a + getSequence imap = [imap IM.! i | i <- [1 .. IM.size imap]] + h' i j = h (lambda !! (i-1) - mu' !! (j-1) - i + j) + (getSequence (tau (mu' !! (j-1) - j + 1))) + l = length lambda + row i = [h' i j | j <- [1 .. l]] + matrix = fromLists [row i | i <- [1 .. l]] + det = detLaplace matrix + assertEqual "" det skewFactorialSchurPoly + + , testCase "Flagged Schur polynomial" $ do + let + lambda = [5, 3, 2, 2] + n = 5 + flaggedSchurPoly = flaggedSchurPol' lambda [1, 1, 1, 1] [n, n, n, n] + schurPoly = schurPol' n lambda + assertEqual "" flaggedSchurPoly schurPoly + + , testCase "Flagged skew Schur polynomial" $ do + let + lambda = [5, 3, 2, 2] + mu = [3, 1, 1] + n = 5 + flaggedSkewSchurPoly = + flaggedSkewSchurPol' lambda mu [1, 1, 1, 1] [n, n, n, n] + skewSchurPoly = skewSchurPol' n lambda mu + assertEqual "" flaggedSkewSchurPoly skewSchurPoly + + , testCase "Jacobi-Trudi identity for flagged skew Schur polynomial" $ do + let + lambda = [5, 3, 2, 2] + mu = [3, 1, 1] + as = [1, 1, 2, 4] + bs = [2, 3, 4, 5] + flaggedSkewSchurPoly = + flaggedSkewSchurPol' lambda mu as bs + newVariables a b = map qlone [a .. b] + h k a b + | k < 0 = zeroSpray + | k == 0 = changeVariables (cshPolynomial n []) variables + | otherwise = changeVariables (cshPolynomial n [k]) variables + where + n = max 0 (b - a + 1) + variables = newVariables a b + l = length lambda + mu' = mu ++ [0] + row i = [h (lambda !! (i-1) - mu' !! (j-1) + j - i) (as !! (j-1)) (bs !! (i-1))| j <- [1 .. l]] + matrix = fromLists [row i | i <- [1 .. l]] + det = detLaplace matrix + assertEqual "" det flaggedSkewSchurPoly + + , testCase "Jacobi-Trudi identity" $ do + let + n = 5 + lambda = [3, 2, 1, 1] + schurPoly = schurPol' n lambda + h k + | k < 0 = zeroSpray + | k == 0 = cshPolynomial n [] :: QSpray + | otherwise = cshPolynomial n [k] :: QSpray + row i = [h (lambda !! (i-1) + j - i) | j <- [1 .. 4]] + matrix = fromLists [row i | i <- [1 .. 4]] + det = detLaplace matrix + assertEqual "" det schurPoly + + , testCase "jackSymbolicPol J" $ do let jp = jackSymbolicPol' 3 [3, 1] 'J' v = evalParametricSpray' jp [2] [-3, 4, 5] assertEqual "" v 1488 @@ -538,5 +666,86 @@ kn2 = DM.mapKeys fromPartition (GT.kostkaNumbersWithGivenLambda (mkPartition lambda) :: DM.Map PI.Partition Rational) assertEqual "" kn1 kn2 + + , testCase "Kostka-Foulkes polynomials" $ do + let + lambda = [3, 1, 1] + mu = [1, 1, 1, 1, 1] + kfPoly = kostkaFoulkesPolynomial lambda mu :: Spray Int + kNumber = kostkaNumber (toPartition lambda) (toPartition mu) + kfPolyAt1 = evaluateAt [1] kfPoly + t = lone 1 :: Spray Int + expected = t^**^3 ^+^ t^**^4 ^+^ 2*^t^**^5 ^+^ t^**^6 ^+^ t^**^7 + assertEqual "" (kfPoly, kfPolyAt1) (expected, kNumber) + + , testCase "Hall-Littlewood polynomial P" $ do + let + hlPoly = hallLittlewoodPolynomial 5 [2, 2, 1] 'P' :: SimpleParametricSpray Int + msCombo = msCombination hlPoly + t = lone 1 :: Spray Int + expected = DM.fromList + [ + ([2, 2, 1], unitSpray) + , ([2, 1, 1, 1], 2 +> (AlgAdd.negate (t ^+^ t^**^2))) + , ([1, 1, 1, 1, 1], 5 +> ((-4)*^t ^-^ 4*^t^**^2 ^+^ t^**^3 ^+^ t^**^4 ^+^ t^**^5)) + ] + assertEqual "" msCombo expected + + , testCase "Hall-Littlewood polynomial Q" $ do + let + hlQ2 = hallLittlewoodPolynomial 4 [2] 'Q' :: SimpleParametricSpray Int + hlQ22 = hallLittlewoodPolynomial 4 [2, 2] 'Q' + hlQ31 = hallLittlewoodPolynomial 4 [3, 1] 'Q' + hlQ4 = hallLittlewoodPolynomial 4 [4] 'Q' + spray = 1 +> (AlgAdd.negate (lone 1)) :: Spray Int + expected = hlQ22 ^+^ spray *^ hlQ31 ^+^ spray *^ hlQ4 + assertEqual "" (hlQ2 ^**^ 2) expected + + , testCase "Skew Hall-Littlewood at t=0 is skew Schur polynomial" $ do + let + n = 3 + lambda = [3, 2, 1] + mu = [1, 1] + skewHLpoly = skewHallLittlewoodPolynomial' n lambda mu 'P' + skewSchurPoly = skewSchurPol' n lambda mu + assertEqual "" skewSchurPoly (substituteParameters skewHLpoly [0]) + + , testCase "Skew Hall-Littlewood with mu=[] is Hall-Littlewood polynomial" $ do + let + n = 6 + lambda = [3, 2, 1] + which = 'Q' + skewHLpoly = skewHallLittlewoodPolynomial' n lambda [] which + hlPoly = hallLittlewoodPolynomial' n lambda which + assertEqual "" skewHLpoly hlPoly + + , testCase "Branching rule Hall-Littlewood P" $ do + let + lambda = [3, 1] + mus = [[], [1], [2], [3], [1, 1], [2, 1], [3, 1]] + nx = 2 + nz = 2 + which = 'P' + hlLambda = hallLittlewoodPolynomial' (nx+nz) lambda which + z = [lone 3, lone 4] + terms = [skewHallLittlewoodPolynomial' nx lambda mu which ^*^ + changeVariables (hallLittlewoodPolynomial' nz mu which) z + | mu <- mus] + assertEqual "" hlLambda (sumOfSprays terms) + + , testCase "Branching rule Hall-Littlewood Q" $ do + let + lambda = [3, 1] + mus = [[], [1], [2], [3], [1, 1], [2, 1], [3, 1]] + nx = 2 + nz = 2 + which = 'Q' + hlLambda = hallLittlewoodPolynomial' (nx+nz) lambda which + z = [lone 3, lone 4] + terms = [skewHallLittlewoodPolynomial' nx lambda mu which ^*^ + changeVariables (hallLittlewoodPolynomial' nz mu which) z + | mu <- mus] + assertEqual "" hlLambda (sumOfSprays terms) + ]