1
$\begingroup$

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 enter image description here with a few lines of algebra.

Now for higher orders, I get the following: enter image description here

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$, enter image description here but I want to just explore this...

$\endgroup$
2
  • $\begingroup$ Possibly you are looking for the Newton identities $\endgroup$ Dec 1, 2022 at 14:33
  • $\begingroup$ @DanielLichtblau Thanks. Will have a read and try to see if I can improve the codes... $\endgroup$
    – CasperYC
    Dec 2, 2022 at 8:25

1 Answer 1

0
$\begingroup$

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.

enter image description here

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]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.