jackpolynomials 1.4.3.0 → 1.4.4.0
raw patch · 5 files changed
+202/−107 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Math.Algebra.SymmetricPolynomials: skewKostkaFoulkesPolynomial :: (Eq a, C a) => Partition -> Partition -> Partition -> Spray a
+ Math.Algebra.SymmetricPolynomials: skewKostkaFoulkesPolynomial' :: Partition -> Partition -> Partition -> QSpray
Files
- CHANGELOG.md +8/−0
- jackpolynomials.cabal +2/−1
- src/Math/Algebra/Jack/Internal.hs +145/−106
- src/Math/Algebra/SymmetricPolynomials.hs +30/−0
- tests/Main.hs +17/−0
CHANGELOG.md view
@@ -111,3 +111,11 @@ * new function `factorialSchurPol`, to get a factorial Schur polynomial * new function `skewFactorialSchurPol`, to get a skew factorial Schur polynomial + +1.4.4.0 +------- +* new function `skewKostkaFoulkesPolynomial`, to get a skew Kosta-Foulkes +polynomial + +* the efficiency of the function `skewHallLittlewoodPolynomial` has been +greatly improved
jackpolynomials.cabal view
@@ -1,5 +1,5 @@ name: jackpolynomials -version: 1.4.3.0 +version: 1.4.4.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 @@ -62,6 +62,7 @@ , containers >= 0.6.4.1 && < 0.8 , numeric-prelude >= 0.4.4 && < 0.5 , matrix >= 0.3.6.0 && < 0.4 + , unordered-containers >= 0.2.17.0 && < 0.3 Default-Language: Haskell2010 ghc-options: -Wall -Wcompat
src/Math/Algebra/Jack/Internal.hs view
@@ -31,6 +31,7 @@ , isIncreasing , flaggedSkewTableaux , skewTableauWeight + , _skewKostkaFoulkesPolynomial ) where import Prelude @@ -50,11 +51,12 @@ import qualified Data.HashMap.Strict as HM import Data.List ( nub - , foldl1' + -- , foldl1' , uncons ) import Data.List.Extra ( unsnoc + , drop1 ) import Data.List.Index ( iconcatMap ) import Data.Map.Strict ( Map ) @@ -74,9 +76,8 @@ ) import Data.Maybe ( fromJust, isJust ) import Data.Sequence ( - Seq + Seq , (|>) - , (<|) , (><) , Seq ( (:<|) ) ) @@ -92,12 +93,16 @@ , Powers (..) , SimpleParametricSpray , zeroSpray + , unitSpray , isZeroSpray - , lone, lone', unitSpray + , lone, lone' , sumOfSprays , productOfSprays , FunctionLike (..) ) +import Math.Combinat.Compositions ( + compositions + ) import Math.Combinat.Partitions.Integer ( fromPartition , dualPartition @@ -108,11 +113,6 @@ , dropTailingZeros ) import qualified Math.Combinat.Partitions.Integer as MCP -import Math.Combinat.Partitions.Skew ( - SkewPartition - , mkSkewPartition - , skewPartitionElements - ) import Math.Combinat.Tableaux.GelfandTsetlin ( GT , kostkaGelfandTsetlinPatterns @@ -121,13 +121,119 @@ type Partition = [Int] -gtPatternDiagonals :: GT -> (Int, [MCP.Partition]) +sandwichedPartitions :: Int -> Seq Int -> Seq Int -> [Seq Int] +sandwichedPartitions weight mu lambda = + recursiveFun weight (lambda `S.index` 0) mu' lambda + where + mu' = mu >< (S.replicate (S.length lambda - S.length mu) 0) + dropTrailingZeros = S.dropWhileR (== 0) + recursiveFun :: Int -> Int -> Seq Int -> Seq Int -> [Seq Int] + recursiveFun d h0 a_as b_bs + | d < 0 || d < DF.sum a_as || d > DF.sum b_bs = [] + | d == 0 = [S.empty] + | otherwise = + concatMap + (\h -> + [h :<| dropTrailingZeros hs | hs <- recursiveFun (d-h) h as bs] + ) + [max 0 a .. min h0 b] + where + a = a_as `S.index` 0 + b = b_bs `S.index` 0 + as = S.drop 1 a_as + bs = S.drop 1 b_bs + +skewGelfandTsetlinPatterns :: Partition -> Partition -> [Int] -> [[Seq Int]] +skewGelfandTsetlinPatterns lambda mu weight + -- | not (isSkewPartition lambda mu) = + -- error "skewGelfandTsetlinPatterns: invalid skew partition." + | any (< 0) weight = + [] + | wWeight /= wLambda - wMu = + [] + | wWeight == 0 = + [replicate (length weight + 1) lambda'] + | otherwise = + if any (== 0) weight + then map (\pattern -> [pattern `S.index` i | i <- indices]) patterns + else map DF.toList patterns + where + wWeight = sum weight + lambda' = S.fromList lambda + wLambda = DF.sum lambda' + mu' = S.fromList mu + wMu = DF.sum mu' + recursiveFun :: Seq Int -> Seq Int -> [Seq (Seq Int)] + recursiveFun kappa w = + if d == wMu + then + if ellKappa >= ellMu && + and (S.zipWith (>=) kappa mu') && + ellKappa <= ellMu + 1 && + and (S.zipWith (>=) (mu') (S.drop 1 kappa)) + then [S.fromList [mu', kappa]] + else [] + else + concatMap + (\nu -> [list |> kappa | list <- recursiveFun nu hw]) + (sandwichedPartitions d (S.drop 1 kappa |> 0) kappa) + where + ellKappa = S.length kappa + ellMu = S.length mu' + d = DF.sum kappa - w `S.index` 0 + hw = S.drop 1 w + weight' = S.filter (/= 0) (S.fromList weight) + patterns = recursiveFun lambda' (S.reverse weight') + indices = map (subtract 1) (scanl1 (+) (1 : map (min 1) (reverse weight))) + +skewGelfandTsetlinPatternToTableau :: [Seq Int] -> [(Int, Seq Int)] +skewGelfandTsetlinPatternToTableau pattern = + if ellLambda == 0 + then [] + else DF.toList skewTableau + where + lambda = pattern !! (length pattern - 1) + ellLambda = S.length lambda + mu = pattern !! 0 + mu' = mu >< (S.replicate (ellLambda - S.length mu) 0) + skewPartitionRows kappa nu = + concatMap (uncurry replicate) (S.zip differences indices) + where + indices = S.fromList [0 .. ellLambda] + differences = S.zipWith (-) kappa nu >< S.drop (S.length nu) kappa + startingTableau = S.replicate ellLambda S.Empty + growTableau :: Seq (Seq Int) -> (Int, Seq Int, Seq Int) -> Seq (Seq Int) + growTableau tableau (j, kappa, nu) = + DF.foldr (S.adjust' (flip (|>) j)) tableau (skewPartitionRows kappa nu) + skewPartitions = zip3 [1 ..] (drop1 pattern) pattern + skewTableau = + S.zip mu' (DF.foldl' growTableau startingTableau skewPartitions) + +skewTableauxWithGivenShapeAndWeight :: + Partition -> Partition -> [Int] -> [[(Int, Seq Int)]] +skewTableauxWithGivenShapeAndWeight lambda mu weight = + map skewGelfandTsetlinPatternToTableau + (skewGelfandTsetlinPatterns lambda mu weight) + +_skewKostkaFoulkesPolynomial :: + (Eq a, AlgRing.C a) => Partition -> Partition -> Partition -> Spray a +_skewKostkaFoulkesPolynomial lambda mu nu = + if sum lambda == sum mu + sum nu + then sumOfSprays sprays + else zeroSpray + where + tableaux = skewTableauxWithGivenShapeAndWeight lambda mu nu + word skewT = mconcat (map S.reverse (snd (unzip skewT))) + mm = lone' 1 + sprays = map (mm . charge . word) tableaux + +gtPatternDiagonals :: GT -> (Int, [Partition]) gtPatternDiagonals pattern = (corner, [diagonal j | j <- [1 .. l]]) where l = length pattern - 1 corner = pattern !! l !! 0 diagonal j = - (toPartitionUnsafe . dropTailingZeros) + dropTailingZeros [pattern !! r !! c | (r, c) <- zip [l-j .. l] [0 .. j]] gtPatternToTableau :: GT -> [Seq Int] @@ -137,22 +243,25 @@ else [S.replicate corner 1] where (corner, diagonals) = gtPatternDiagonals pattern - diagonals' = toPartitionUnsafe [corner] : diagonals + diagonals' = [corner] : diagonals l = length diagonals - 1 lambda = diagonals !! l - m = partitionWidth lambda + m = length lambda startingTableau = S.replicate m S.Empty - zippedDiagonals = zip diagonals diagonals' - skewPartition i = mkSkewPartition (zippedDiagonals !! i) + skewPartitions = zip diagonals diagonals' + skewPartitionRows (kappa, nu) = + concatMap (\(i, d) -> replicate d i) (zip [0 ..] differences) + where + differences = zipWith (-) kappa nu ++ drop (length nu) kappa 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) + go (i+1) (growTableau (i+1) tableau (skewPartitions !! (i-1))) + growTableau :: + Int -> Seq (Seq Int) -> (Partition, Partition) -> Seq (Seq Int) growTableau j tableau skewPart = - DF.foldr (\(i, _) -> S.adjust' (flip (|>) j) (i-1)) tableau - (skewPartitionElements skewPart) + DF.foldr (S.adjust' (flip (|>) j)) tableau (skewPartitionRows skewPart) semiStandardTableauxWithGivenShapeAndWeight :: Partition -> Partition -> [[Seq Int]] @@ -233,54 +342,19 @@ 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 + and (zipWith (<=) s (drop1 s)) _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 +_paths n lambda mu = + concatMap + (skewGelfandTsetlinPatterns (DF.toList lambda) (DF.toList mu)) + (compositions n (DF.sum lambda - DF.sum mu)) psi_lambda_mu :: forall a. (Eq a, AlgRing.C a) => Seq Int -> Seq Int -> Spray a -psi_lambda_mu lambda mu = productOfSprays sprays +psi_lambda_mu lambda mu = if S.null lambda + then unitSpray + else productOfSprays sprays where range = [1 .. lambda `S.index` 0] pair j = ( @@ -293,7 +367,9 @@ phi_lambda_mu :: forall a. (Eq a, AlgRing.C a) => Seq Int -> Seq Int -> Spray a -phi_lambda_mu lambda mu = productOfSprays sprays +phi_lambda_mu lambda mu = if S.null lambda + then unitSpray + else productOfSprays sprays where range = [1 .. lambda `S.index` 0] pair j = ( @@ -307,7 +383,7 @@ 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] + sumOfSprays [productOfSprays $ sprays path | path <- paths] where paths = _paths n lambda mu lones = [lone' i | i <- [1 .. n]] @@ -318,13 +394,13 @@ 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] + sumOfSprays [productOfSprays $ sprays 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] + | (next_nu_i, nu_i, lone_i) <- zip3 (drop1 nu) nu lones] charge :: Seq Int -> Int charge w = if l == 0 || n == 1 then 0 else DF.sum indices' + charge w' @@ -348,43 +424,6 @@ 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 = @@ -393,9 +432,9 @@ 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 + mm = lone' 1 + sprays = + map (mm . charge . (mconcat . (map S.reverse))) tableaux b_lambda :: (Eq a, AlgRing.C a) => Partition -> Spray a b_lambda lambda = productOfSprays sprays
src/Math/Algebra/SymmetricPolynomials.hs view
@@ -61,6 +61,8 @@ -- * Kostka-Foulkes polynomials , kostkaFoulkesPolynomial , kostkaFoulkesPolynomial' + , skewKostkaFoulkesPolynomial + , skewKostkaFoulkesPolynomial' -- * Hall-Littlewood polynomials , hallLittlewoodPolynomial , hallLittlewoodPolynomial' @@ -170,6 +172,7 @@ , _symbolicKostkaNumbers , _inverseSymbolicKostkaMatrix , _kostkaFoulkesPolynomial + , _skewKostkaFoulkesPolynomial , _hallLittlewoodPolynomialsInSchurBasis , _transitionMatrixHallLittlewoodSchur , skewHallLittlewoodP @@ -989,6 +992,33 @@ -- polynomial whose value at @1@ is the Kostka number of the two partitions. kostkaFoulkesPolynomial' :: Partition -> Partition -> QSpray kostkaFoulkesPolynomial' = kostkaFoulkesPolynomial + +-- | Skew Kostka-Foulkes polynomial. This is a univariate polynomial associated +-- to a skew partition and a partition, and its value at @1@ is the skew Kostka +-- number associated to these partitions. +skewKostkaFoulkesPolynomial :: + (Eq a, AlgRing.C a) + => Partition -- ^ outer partition of the skew partition + -> Partition -- ^ inner partition of the skew partition + -> Partition -- ^ integer partition; the equality of the weight of this partition with the weight of the skew partition is a necessary condition to get a non-zero polynomial + -> Spray a +skewKostkaFoulkesPolynomial lambda mu nu + | not (isSkewPartition lambda mu) = + error "skewKostkaFoulkesPolynomial: invalid skew partition" + | not (_isPartition nu) = + error "skewKostkaFoulkesPolynomial: invalid partition" + | otherwise = + _skewKostkaFoulkesPolynomial lambda mu nu + +-- | Skew Kostka-Foulkes polynomial. This is a univariate polynomial associated +-- to a skew partition and a partition, and its value at @1@ is the skew Kostka +-- number associated to these partitions. +skewKostkaFoulkesPolynomial' :: + Partition -- ^ outer partition of the skew partition + -> Partition -- ^ inner partition of the skew partition + -> Partition -- ^ integer partition; the equality of the weight of this partition with the weight of the skew partition is a necessary condition to get a non-zero polynomial + -> QSpray +skewKostkaFoulkesPolynomial' = skewKostkaFoulkesPolynomial -- | Hall-Littlewood polynomial of a given partition. This is a multivariate -- symmetric polynomial whose coefficients are polynomial in one parameter.
tests/Main.hs view
@@ -1,6 +1,7 @@ module Main ( main ) where import qualified Algebra.Additive as AlgAdd import qualified Algebra.Module as AlgMod +import qualified Data.HashMap.Strict as HM import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as DM import Data.Matrix ( @@ -25,6 +26,7 @@ , sumOfSprays , productOfSprays , detLaplace + , getConstantTerm ) import qualified Math.Algebra.Hspray as Hspray import Math.Algebra.Jack ( schur, skewSchur @@ -57,6 +59,7 @@ , kostkaNumbers , symbolicKostkaNumbers , kostkaFoulkesPolynomial + , skewKostkaFoulkesPolynomial' , hallLittlewoodPolynomial , hallLittlewoodPolynomial' , skewHallLittlewoodPolynomial' @@ -677,6 +680,20 @@ t = lone 1 :: Spray Int expected = t^**^3 ^+^ t^**^4 ^+^ 2*^t^**^5 ^+^ t^**^6 ^+^ t^**^7 assertEqual "" (kfPoly, kfPolyAt1) (expected, kNumber) + + , testCase "Skew Kostka-Foulkes polynomials" $ do + let + lambda = [3, 3, 2, 1] + mu = [1, 1, 1] + n = sum lambda - sum mu + nus = map fromPartition (partitions n) + skewKFpolys = map (skewKostkaFoulkesPolynomial' lambda mu) nus + hlPolys = map (\nu -> hallLittlewoodPolynomial' n nu 'P') nus + combo = sumOfSprays $ zipWith (*^) skewKFpolys hlPolys + comboIsConstant = all (== 0) (map numberOfVariables (HM.elems combo)) + combo' = HM.map getConstantTerm combo + skewSchurPoly = skewSchurPol' n lambda mu + assertEqual "" (comboIsConstant, combo') (True, skewSchurPoly) , testCase "Hall-Littlewood polynomial P" $ do let