# Reducing roots of power sums

Often I encounter expressions like for example

1. Root[ 1 - # + #^2 - #^3 + #^4 - #^5 + #^6 &, 3 ] or
2. Root[ 1 + 2 #^2 + 4 #^4 + 8 #^6 &, 2 ]

and neither Simplify, FullSimplify, RootReduce, ComplexExpand, ... or any of those functions seem to recognize that the polynomial in question is just a power sum $$p=\sum_{i=0}^n(c x)^i$$ and therefore the roots can be found by solving the equation $$(cx)^{n+1} =1$$ for $$x$$. The solution (lets assume $$c$$ is real for this question) is always an expression of the form $$\frac{\exp\left( \frac{2 \pi i k}{n+1} \right) }{ c }$$

I think expressions of the form  a Exp[ 2 Pi I / b ] are more desirable than the root objects. (both in clarity, memory, and speed if used later on) and therefore tried to write my own function to reduce such expressions:

PowerSumReduce[ r : Root[ f_, __ ] ] :=
With[{ deg = Exponent[ f[x], x ] },
If[
!PowerSumQ[ f[x], x ],
r,
FirstCase[
PowerSumRoots[ f[x], x ],
root_ /; N[ root - r, { Infinity, 1000 } ] == 0
]
]
];

PowerSumQ[ f_, x_ ] :=
With[ { deg = Exponent[ f, x ] },
TrueQ @
And[
MatchQ[
f, Sum[ _. * Power[ x, i ], { i, 0, deg } ]
],
With[{ c = f[[2]] /. x -> 1 },
Sum[ (c x)^i, {i, 0, deg } ] === f
]
]
];

PowerSumRoots[ f_, x_ ] :=
With[{ deg = Exponent[ f, x ], c = f[[2]] /. x -> 1 },
Table[ Exp[ 2 Pi I n / (deg + 1) ]/c, { n, deg }]
];



There are a few problems with my approach, though.

• PowerSumReduce does not work for the 2nd example above: PowerSumQ doesn't recognize power sums of powers of a variable, and
• PowerSumReduce uses numerics to achieve its result. While I could theoretically construct a function that returns the required accuracy to guarantee correctness, I have the feeling there must be a better way.

My question is the following: What would be a good function to recognize and replace Root expressions of power sums with their simpler exact algebraic form? In particular the function should recognize power sums of powers of variables as being a power sum as well.

• Try: ToRadicals ? Commented Apr 6, 2023 at 14:59
• That one gives horrible expressions. E.g. for Root[1 + 2*#1^2 + 4*#1^4 + 8*#1^6 + 16*#1^8 & , 6 ], ToRadicals returns Sqrt[(-1 - Sqrt[5] + I*Sqrt[2*(5 - Sqrt[5])])/2]/2, while this is actually just equal to Exp[2 Pi I /5]/Sqrt[2]. In some cases the built-in functions can recognize these solutions but often it takes a lot of guesswork in which order to apply them.
– Gert
Commented Apr 6, 2023 at 15:05
• Adding to @MariuszIwaniuk's comment, why not follow up with ComplexExpand and possibly TrigToExp, e.g., TrigToExp @ ComplexExpand @ ToRadicals @ expr Commented Apr 6, 2023 at 15:54
• For the case in my previous comment this would result in: ((10-2 Sqrt[5]+(-1-Sqrt[5])^2)^(1/4) E^(1/2 I ([Pi]+1/2 I (Log[1-(I Sqrt[10-2 Sqrt[5]])/(-1-Sqrt[5])]-Log[1+(I Sqrt[10-2 Sqrt[5]])/(-1-Sqrt[5])]))))/(2 Sqrt[2]). The point is that, if I use the built-in functions, it takes a lot of trial and error to reduce these expressions to the form above. In most cases I don't even get there at all.
– Gert
Commented Apr 6, 2023 at 16:04
• A partial idea: FactorList[Root[1 + 2*#1^2 + 4*#1^4 + 8*#1^6 + 16*#1^8 &, 6][[1]][x], Extension -> (-1)^(1/5)/Sqrt[2]][[All, 1]] // Map[SolveValues[# == 0, x] &] // Flatten // Select[FullSimplify[# == Root[1 + 2*#1^2 + 4*#1^4 + 8*#1^6 + 16*#1^8 &, 6]] &] Commented Apr 6, 2023 at 16:06

$Version (* "13.2.1 for Mac OS X ARM (64-bit) (January 27, 2023)" *) Clear["Global*"]  Using a replacement Rule (or RuleDelayed) root = r_Root :> With[{z = r // ToRadicals}, Simplify[Abs[z]*Exp[I*Arg[z]]]]; expr1 = Root[1 - # + #^2 - #^3 + #^4 - #^5 + #^6 &, 3]; expr1 /. root (* -(-1)^(4/7) *)  The Root expression for your second example auto-simplifies expr2 = Root[1 + 2 #^2 + 4 #^4 + 8 #^6 &, 2] (* -(1/2) + I/2 *) expr3 = Root[1 + 2*#1^2 + 4*#1^4 + 8*#1^6 + 16*#1^8 &, 6]; expr3 /. root (* (-1)^(2/5)/Sqrt[2] *)  EDIT: For an earlier version $Version

(* "12.3.1 for Mac OS X x86 (64-bit) (June 19, 2021)" *)

Clear["Global*"]


With this version of Mathematica, FullSimplify is needed with the third expression. Changing the rule,

root = r_Root :>
With[{z = r // ToRadicals}, FullSimplify[Abs[z]*Exp[I*Arg[z]]]];

expr1 = Root[1 - # + #^2 - #^3 + #^4 - #^5 + #^6 &, 3];

expr1 /. root

(* -(-1)^(4/7) *)


The second expression still auto-simplifies

expr2 = Root[1 + 2 #^2 + 4 #^4 + 8 #^6 &, 2]

(* -(1/2) + I/2 *)

expr3 = Root[1 + 2*#1^2 + 4*#1^4 + 8*#1^6 + 16*#1^8 &, 6];

expr3 /. root

(* (-1)^(2/5)/Sqrt[2] *)

• Interesting. The second example doesn't simplify in version 12.3, not even with the root replacement you provided... The other example does though
– Gert
Commented Apr 6, 2023 at 16:37