Any efficient way to make complete homogeneous symmetric functions in Mathematica?

Question

We do have elementary symmetric functions, SymmetricPolynomial[k, {x_1, ..., x_n}] .

But I didn't find complete homogeneous symmetric functions.

The induction method to compute $h_n$ from $e_i$ and $h_j$ ($j\leq n-1$) is not that efficient.

Is there any easier way to do this?

score 12 · Accepted Answer · edited Jun 09 '12 at 17:10

12

For example:

completeSymmetricPolynomial[i_?IntegerQ, vars_?ListQ] :=
      Total@Union@Tuples[Times @@ vars, {i}];

completeSymmetricPolynomial[2, {a, b, c, d}]

(* a^2 + a b + b^2 + a c + b c + c^2 + a d + b d + c d + d^2 *)

Edit

You can verify the fundamental relationship between complete and incomplete symmetric polynomials:

$$\sum_{i=0}^m (-1)^i e_i(X_1,\dots,X_n)h_{m-i}(X_1,\dots,X_n)=0$$

FullSimplify@
 Table[Sum[(-1)^i completeSymmetricPolynomial[i, {a, b, c, d}]     
                          SymmetricPolynomial[m - i, {a, b, c, d}], 
      {i, 0, m}], {m, 1, 4}]

(* -> {0, 0, 0, 0} *)

edited Jun 09 '12 at 17:10

J. M.'s missing motivation

124,525
11
401
574

answered Jun 09 '12 at 14:44

Dr. belisarius

115,881
13
203
453

I think you can replace Times[Sequence @@ vars] with Times @@ vars. – Mr.Wizard Jun 09 '12 at 15:21
...and the Plus @@ stuff is more compactly written as Total[stuff]. – J. M.'s missing motivation Jun 09 '12 at 15:33
The fundamental relationship belisarius is using to check his implementation is essentially the second method in my answer. – J. M.'s missing motivation Jun 09 '12 at 17:11
@J.M. So we could cross-check :) – Dr. belisarius Jun 09 '12 at 17:39
@belisarius Nice. Thank you. :) – Osiris Xu Jun 09 '12 at 21:17
1

The only little issue is 0-th order is not well defined, i.e. completeSymmetricPolynomial[0, {a, b, c, d}] – Osiris Xu Jun 12 '12 at 21:44
@Osiris, that's easy to fix; just define completeSymmetricPolynomial[0, vars_List] = 1; before the general definition. – J. M.'s missing motivation Jun 16 '12 at 15:37

J. M.'s missing motivation · Answer 2 · 2012-06-09T15:27:28.877

What I'd do, based on the generating function identity in your Wikipedia link:

completeSymmetricPolynomial[k_Integer, vars_List] := 
 SeriesCoefficient[
   Apply[Times, 1/(1 - vars \[FormalT])], {\[FormalT], 0, k}] /; 
  0 <= k <= Length[vars]

This is somewhat slower, but I want to demonstrate that the induction approach can be made to work as well (and is easily modified if you want all the $n$-variable polynomials all at once, as opposed to just one):

completeSymmetricPolynomial[k_Integer, vars_List] := 
 Expand[LinearSolve[ToeplitzMatrix[
     Table[(-1)^\[FormalK] SymmetricPolynomial[\[FormalK], vars],
           {\[FormalK], 0, Length[vars] - 1}], 
     UnitVector[Length[vars], 1]],
     -Table[(-1)^\[FormalK] SymmetricPolynomial[\[FormalK], vars],
            {\[FormalK], Length[vars]}]][[k]]]

score 7 · Answer 3 · answered Jun 09 '12 at 20:35

7

This variant seems competitive in terms of speed.

completeSymmetricPolynomial2[i_?IntegerQ, vars_?ListQ] :=
  Expand[(Total@vars)^i]/. aa_Integer*bb_ :> bb

answered Jun 09 '12 at 20:35

Daniel Lichtblau

58,970
2
101
199

cool. Thanks. :) – Osiris Xu Jun 09 '12 at 21:22
This version 2 gives me different polynomials than version 1, and version 1 seems to be correct if I check it against dimensions of representations; just a caveat if somebody tries to use this for computations, as I did :( – jj_p May 15 '17 at 21:15
On what example did an incorrect result appear? – Daniel Lichtblau May 15 '17 at 23:16
@DanielLichtblau (You should link me, otherwise I'll never see your comments.) try e.g. completeSymmetricPolynomial[3, {a, b, 1, a^-1, b^-1}] - completeSymmetricPolynomial2[3, {a, b, 1, a^-1, b^-1}], but also simpler stuff. – jj_p May 17 '17 at 20:22
@jj_p Sorry I forgot that link. I'll have a look at the example. – Daniel Lichtblau May 17 '17 at 20:51
@jj_p Right, that code was for independent variables. Could do: completeSymmetricPolynomial3[i_?IntegerQ, vars_?ListQ] := Module[{v, x}, v = Array[x, Length[vars]]; (Expand[(Total@v)^i] /. aa_Integer*bb_ :> bb) /. Thread[v -> vars]] – Daniel Lichtblau May 17 '17 at 21:11

user688486 · Answer 4 · 2023-06-02T14:34:43.603

Each of following functions is much faster (?) than other versions:

chsf1[k_ ? (# \[Element] NonNegativeIntegers&), vars_?VectorQ] :=
    Which[
        vars === {},
            Nothing
        ,
        k == 0,
            1
        ,
        True,
            ToExpression[StringJoin @@ Array["Table[{i" <> ToString[##
                ] <> ", "&, Length @ vars - 1] <> "{{" <> ToString[k] <> " - (" <> ToString[
                (Sum["i" <> ToString[j], {j, Length @ vars - 1}])] <> "), 1}}" <> StringJoin
                 @@ Table["}, {" <> "i" <> ToString[j] <> ", " <> ToString[k - Sum["i"
                 <> ToString[l], {l, j - 1}]] <> ", 0, -1}]", {j, Length @ vars - 1, 
                1, -1}], InputForm, Curry[Algebra`Polynomial`FromNestedTermsList][vars
                ]]
    ]

chsf2[k_ ? (# \[Element] NonNegativeIntegers&), vars_?VectorQ] :=
    Which[
        vars === {},
            Nothing
        ,
        k == 0,
            1
        ,
        True,
            Plus @@ Times @@@ Thread[vars ^ FrobeniusSolve[1 ~ ConstantArray
                 ~ Length @ vars, k]\[Transpose]]
    ]

chsf3[k_ ? (# \[Element] NonNegativeIntegers&), vars_?VectorQ] :=
    Which[
        vars === {},
            Nothing
        ,
        k == 0,
            1
        ,
        True,
            Inner[Power, vars, FrobeniusSolve[1 ~ ConstantArray ~ Length
                 @ vars, k]\[Transpose], Times] // Total
    ]

chsf4[k_ ? (# \[Element] NonNegativeIntegers&), vars_?VectorQ] :=
    Which[
        vars === {},
            Nothing
        ,
        k == 0,
            1
        ,
        True,
            GroebnerBasis`FromDistributedTermsList[{Append[1] /@ ({FrobeniusSolve[
                1 ~ ConstantArray ~ Length @ vars, k]}\[Transpose]), vars}]
    ]

chsf5[k_ ? (# \[Element] NonNegativeIntegers&), vars_?VectorQ] :=
    Which[
        vars === {},
            Nothing
        ,
        k == 0,
            1
        ,
        True,
            FromCoefficientRules[Thread[FrobeniusSolve[1 ~ ConstantArray
                 ~ Length @ vars, k] -> 1], vars]
    ]

Unfortunately, rather inefficient implementations exist as well:

chsf6[k_ ? (# \[Element] NonNegativeIntegers&), vars_?VectorQ] :=
    Which[
        vars === {},
            Nothing
        ,
        k == 0,
            1
        ,
        True,
            Internal`FromCoefficientList[SparseArray[FrobeniusSolve[1
                 ~ ConstantArray ~ Length @ vars, k] + 1 -> 1] // Normal, vars]
    ]

chsf7[k_ ? (# \[Element] NonNegativeIntegers&), vars_?VectorQ] :=
    Which[
        vars === {},
            Nothing
        ,
        k == 0,
            1
        ,
        True,
            Fold[Dot, SparseArray[n : {_ ~ RepeatedNull ~ {k}} /; LessEqual
                 @@ n :> 1, Length @ vars ~ ConstantArray ~ k], vars ~ ConstantArray ~
                 k]
    ]

Any efficient way to make complete homogeneous symmetric functions in Mathematica?

4 Answers4