Roots of polynomial using sigmma notation (code improvement) and some maths related question

Question

Comes from exploring roots of polynomials and using the recurrence relationship of $S_n = \sum \alpha^n$ notation. Like this: $$ S_2 = \left( \sum \alpha \right)^2 - 2 \sum \alpha \beta $$ where $\alpha,\beta,\gamma, \delta$ are the roots of the polynomials where necessary. We can even get with a few lines of algebra.

Now for higher orders, I get the following:

Using the code to double check:

mysum[n_, m_ : 6] := Times @@@ Subsets[Take[Alphabet[], m], {n}]
Block[
    {m, t0, t1, t2, t3, t4, t5},
    m = 18;
    t0 = (mysum[1, m] // Total)^4;
    t1 = mysum[1, m]^4 // Total;
    t2 = 4*Total[mysum[2, m]]*Total[mysum[1, m]^2];
    t3 = 6*Total[mysum[2, m]^2];
    t4 = 8*Total[mysum[3, m]]*Total[mysum[1, m]];
    t5 = 8*Total[mysum[4, m]];

    t0 - (t1 + t2 + t3 + t4 - t5) // Expand
]

for order 4 and

Block[
    {m, t0, t1, t2, t3, t4, t5, t6, t7},
    
    m = 6;
    
    t0 = Total[mysum[1, m]]^5;
    t1 = 1*mysum[1, m]^5 // Total;
    t2 = 5*Total[mysum[2, m]]*Total[mysum[1, m]^3];
    t3 = 10*Total[mysum[2, m]^2]*Total[mysum[1, m]];
    t4 = 15*Flatten[
        {
        (#1^3*#2*#3) & @@@ mysum[3, m],
        (#1*#2^3*#3) & @@@ mysum[3, m],
        (#1*#2*#3^3) & @@@ mysum[3, m]
        }
        ] // Total;
    t5 = 20*Flatten[
            {
            (#1^2*#2^2*#3^1) & @@@ mysum[3, m],
            (#1^2*#2^1*#3^2) & @@@ mysum[3, m],
            (#1^1*#2^2*#3^2) & @@@ mysum[3, m]
            }
            ] // Total;
    t6 = 60*Flatten[
            {
            (#1^2*#2*#3*#4) & @@@ mysum[4, m],
            (#1*#2^2*#3*#4) & @@@ mysum[4, m],
            (#1*#2*#3^2*#4) & @@@ mysum[4, m],
            (#1*#2*#3*#4^2) & @@@ mysum[4, m]
            }
            ] // Total;
    t7 = 120*Total[mysum[5, m]];
    
    t0 - (t1 + t2 + t3 + t4 + t5 + t6 + t7) // Expand
]

for order 5. I check by by changing m in the code and look at the result to see if it is 0.

To my surprise, I was looking for something with the coefficient to be binomial expansion ? Is there an easier pattern to this? How could I improve the code to desmonstrate with higher powers like 6,7,8,ect...

Any specific name for this mathematics?

PS: I know in computation, we really just use recurrence formula in $S_n$ instead of using the $\sum$, but I want to just explore this...

Answer 1

Thanks to @Daniel Lichtblau for his comments. After a bit reseach and I found that ?SymmetricReduction is the command I need.

Something like

SymmetricReduction[(a + b)^3 - (a^3 + b^3), {a, b}]
SymmetricReduction[(a + b + c)^3 - (a^3 + b^3 + c^3), {a, b, c}]
SymmetricReduction[(a + b + c + d)^3 - (a^3 + b^3 + c^3 + d^3), {a, b, c, d}]

would give me exactly what I want.

mysum[x_, y_] := 
    Times @@@ Subsets[Take[{a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t}, y], {x}
]

mygo[npars_, order_] := SymmetricReduction[
    Total[mysum[1, npars]]^order - Total[mysum[1, npars]^order],
    Take[
        {a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t},
        npars
    ],
    Take[{s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12}, npars]
    
] // First;

TableForm[Table[mygo[x, 2], {x, 2, 9}], TableAlignments -> Left]
TableForm[Table[mygo[x, 3], {x, 2, 9}], TableAlignments -> Left]
TableForm[Table[mygo[x, 4], {x, 2, 9}], TableAlignments -> Left]
TableForm[Table[mygo[x, 5], {x, 2, 9}], TableAlignments -> Left]
TableForm[Table[mygo[x, 6], {x, 2, 9}], TableAlignments -> Left]
TableForm[Table[mygo[x, 7], {x, 2, 9}], TableAlignments -> Left]
TableForm[Table[mygo[x, 8], {x, 2, 9}], TableAlignments -> Left]
TableForm[Table[mygo[x, 9], {x, 2, 9}], TableAlignments -> Left]

The above will give me the summation terms in terms of sX.

I can easily check my findings using this

mycheck[npars_, order_] := If[
        npars < order, 0,
        SymmetricPolynomial[order,
            Take[{a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t}, npars]
        ]
    ];

mycheck[2, 1]
mycheck[2, 2]
mycheck[2, 3]


myFinalCheck[npars_, power_, res_] := Module[
    {t0, rules},

    rules = Thread[{s1, s2, s3, s4, s5, s6, s7, s8, s9} ->  Table[mycheck[npars, x], {x, 1, 9}]];

    (* Print[rules//Column]; *)

    Total[mysum[1, npars]]^power - (
        Total[mysum[1, npars]^power]
        + 
        Total[{res /. rules}]   
    ) // Expand

];


myFinalCheck[2, 3, 3 s1*s2 - 3 s3]
myFinalCheck[3, 3, 3 s1*s2 - 3 s3]
myFinalCheck[4, 3, 3 s1*s2 - 3 s3]
myFinalCheck[5, 3, 3 s1*s2 - 3 s3]
myFinalCheck[6, 3, 3 s1*s2 - 3 s3]

myFinalCheck[#, 7, 
    7 s1^5*s2 - 14 s1^3*s2^2 + 7 s1*s2^3 - 7 s1^4*s3 + 21 s1^2*s2*s3 - 
    7 s2^2*s3 - 7 s1*s3^2 + 7 s1^3*s4 - 14*s1*s2*s4 + 7 s3*s4 - 
    7 s1^2*s5 + 7 s2*s5 + 7 s1*s6 - 7 s7
] & /@ Range[10]

myFinalCheck[#, 8, 
    8*s1^6*s2 - 20*s1^4*s2^2 + 16*s1^2*s2^3 - 2*s2^4 - 8*s1^5*s3 + 
    32*s1^3*s2*s3 - 24*s1*s2^2*s3 - 12*s1^2*s3^2 + 8*s2*s3^2 + 
    8*s1^4*s4 - 24*s1^2*s2*s4 + 8*s2^2*s4 + 16*s1*s3*s4 - 4*s4^2 - 
    8*s1^3*s5 + 16*s1*s2*s5 - 8*s3*s5 + 8*s1^2*s6 - 8*s2*s6 - 
    8*s1*s7 + 8*s8
] & /@ Range[10]


myFinalCheck[#, 9, 
    9*s1^7*s2 - 27*s1^5*s2^2 + 30*s1^3*s2^3 - 9*s1*s2^4 - 9*s1^6*s3 + 
    45*s1^4*s2*s3 - 54*s1^2*s2^2*s3 + 9*s2^3*s3 - 18*s1^3*s3^2 + 
    27*s1*s2*s3^2 - 3*s3^3 + 9*s1^5*s4 - 36*s1^3*s2*s4 + 
    27*s1*s2^2*s4 + 27*s1^2*s3*s4 - 18*s2*s3*s4 - 9*s1*s4^2 - 
    9*s1^4*s5 + 27*s1^2*s2*s5 - 9*s2^2*s5 - 18*s1*s3*s5 + 9*s4*s5 + 
    9*s1^3*s6 - 18*s1*s2*s6 + 9*s3*s6 - 9*s1^2*s7 + 9*s2*s7 + 
    9*s1*s8 - 9*s9
] & /@ Range[10]