Reducing roots of power sums

Question

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.

Answer 1

$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] *)