Find the n-th root of Unity based decomposition of a expression from scratch.

Questions
, ,
1

See my following testing:

In[52]:= E12 = Exp[2 Pi I/12];  (*12th root of unity*)
(2 + Sqrt[3])/648 == -1/324*E12^4 - 1/648*E12^7 - 1/324*E12^8 + 
   1/648*E12^11 // FullSimplify

Out[53]= True

In[65]:= 
eq = (2 + Sqrt[3])/648 == -1/324*x^4 - 1/648*x^7 - 1/324*x^8 + 
    1/648*x^11;
sol = Solve[eq, x];
Select[sol, (# // Values // RootOfUnityQ // First ) == True &]

Out[67]= {{x -> 1/2 (-I + Sqrt[3])}, {x -> 1/2 (I + Sqrt[3])}}

Then, I aim to determine the n-th root of the unity-based decomposition of the aforementioned expression. However, despite my efforts as described below, I am still unable to find any feasible solution:

In[68]:= eq = (2 + Sqrt[3])/648 == Sum[a[i] x^i, {i, 0, 11}] ;
solutions = Solve[eq, Array[a, 12, 0]]

During evaluation of In[68]:= Solve::svars: Equations may not give solutions for all "solve" variables.

Out[69]= {{a[11] -> -((-2 - Sqrt[3])/(648 x^11)) - a[0]/x^11 - a[1]/
    x^10 - a[2]/x^9 - a[3]/x^8 - a[4]/x^7 - a[5]/x^6 - a[6]/x^5 - 
    a[7]/x^4 - a[8]/x^3 - a[9]/x^2 - a[10]/x}}
2

No condition on x? You have a linear equation in 12 unknowns. What do you mean by feasible? The coefficients must be all rational? There are other combinations, for example

1/648 (2 + Sqrt[3]) ==
 -(E12^5)/324 - (E12^6)/324 - (E12^9)/648
3
  1. x must be a specific n-th root of unity.
  2. The coefficients must be all rational.
  3. I want to find the possible minimal n for such a given expression, or fail if it doesn’t exist.
4

It seems that you can do it for n=6:

eq0 = (2 + Sqrt[3])/648 - Sum[a[i] x^i, {i, 0, 6}]
eq1 = eq0 /. x -> ComplexExpand[Exp[Pi I/6]]
eq1 = Expand[eq1]
eq2 = ReIm[%] // ComplexExpand
eq1 - eq2 . {1, I} // Expand(*check, must vanish*)
eq3 = eq2 // Together // Numerator
eq4 = ReIm[eq3 /. Sqrt[3] -> I] // ComplexExpand
Map[# . {1, Sqrt[3]} &, eq4] - eq3 // Expand(*check, must vanish*)
Solve[Flatten[eq4] == 0]
5

Thank you for your nice trick, but you made a mistake here, as shown below:

In[236]:= n = 6;
eq0 = (2 + Sqrt[3])/648 - Sum[a[i] x^i, {i, 0, n}];

#You should use ComplexExpand[Exp[2 Pi I/n]] here:
eq1 = eq0 /. x -> ComplexExpand[Exp[2 Pi I/n]];
eq1 = Expand[eq1];
eq2 = ReIm[%] // ComplexExpand;
eq1 - eq2 . {1, I} // Expand;(*check,must vanish*)
eq3 = eq2 // Together // Numerator;
eq4 = ReIm[eq3 /. Sqrt[3] -> I] // ComplexExpand;
Map[# . {1, Sqrt[3]} &, eq4] - eq3 // Expand;(*check,must vanish*)
sol = Solve[Flatten[eq4] == 0]

Out[245]= {}

So, my original question can be solved as follows:

In[266]:= n = 12;
eq0 = (2 + Sqrt[3])/648 - Sum[a[i] x^i, {i, 0, n}];
eq1 = eq0 /. x -> ComplexExpand[Exp[2 Pi I/n]];
eq1 = Expand[eq1];
eq2 = ReIm[%] // ComplexExpand;
eq1 - eq2 . {1, I} // Expand;(*check,must vanish*)
eq3 = eq2 // Together // Numerator;
eq4 = ReIm[eq3 /. Sqrt[3] -> I] // ComplexExpand;
Map[# . {1, Sqrt[3]} &, eq4] - eq3 // Expand;(*check,must vanish*)
sol = Solve[Flatten[eq4] == 0]

Out[275]= {{a[9] -> -(1/648) + a[1] + a[3] - a[7], 
  a[10] -> a[2] + a[4] - a[8], a[11] -> 1/324 - a[1] + a[5] + a[7], 
  a[12] -> 1/324 - a[0] - a[2] + a[6] + a[8]}}

In[288]:= 
sol /. {a[0] -> 0, a[1] -> 0, a[2] -> 0, a[3] -> 0, a[4] -> 0, 
   a[5] -> 0, a[6] -> 0, a[7] -> 0, a[8] -> 0 };
eq0 /. % /. {a[0] -> 0, a[1] -> 0, a[2] -> 0, a[3] -> 0, a[4] -> 0, 
  a[5] -> 0, a[6] -> 0, a[7] -> 0, a[8] -> 0, 
  x -> ComplexExpand[Exp[2 Pi I/n]]} 
% // FullSimplify

Out[289]= {1/648 (I/2 + Sqrt[3]/2)^9 - 1/324 (I/2 + Sqrt[3]/2)^11 - 
  1/324 (I/2 + Sqrt[3]/2)^12 + 1/648 (2 + Sqrt[3])}

Out[290]= {0}

But if I change my initial expression into the following one:

(2 + Sqrt[3] + Sqrt[7])/648

Then, how to solve this problem?

6

I wrote

eq1 = eq0 /. x -> ComplexExpand[Exp[Pi I/6]]

because it coincides with your original E12 = Exp[2 Pi I/12]. As for (2 + Sqrt[3] + Sqrt[7])/648, I have no idea.

7

I wrote

eq1 = eq0 /. x → ComplexExpand[Exp[Pi I/6]]

because it coincides with your original E12 = Exp[2 Pi I/12].

Thank you for pointing out these subtle clues. You confirmed that in the following form:

eq0 = (2 + Sqrt[3])/648 - Sum[a[i] x^i, {i, 0, n1}];
eq1 = eq0 /. x -> ComplexExpand[Exp[2 Pi I/n2]];

The possible restriction should be n1 ≤ n2.

8

I just discovered the built-in function ToNumberField:

ToNumberField[1/648 (2 + Sqrt[3] + Sqrt[7]), E^((2 I \[Pi])/84)]
9

In fact, I have already noticed this function, but failed to figure out the single algebraic number which can generate my number by field extension.

Say, based on your example, I tried as follows:

In[24]:= ToNumberField[1/648 (2 + Sqrt[3] + Sqrt[7])]

Out[24]= AlgebraicNumber[
Root[16 - 20 #^2 + #^4& , 4, 0], {
Rational[1, 324], 
Rational[1, 648], 0, 0}]

But how can I know this number can be generated by E^((2 I [Pi])/84) via field extension?

10

I knew by looking at this table:

Table[{n, ToNumberField[1/648 (2 + Sqrt[3] + Sqrt[7]),
    Exp[2 Pi I/n]]}, {n, 100}] //
 MatrixForm
11

Although your method works, it is very time-consuming. I don’t know if there are more efficient ways.

As a comparison, I noticed that the GAP implementation below is very fast:

gap> Conductor((2 + Sqrt(3))/648); time;
12
1
gap> Conductor((2 + Sqrt(3) + Sqrt(7))/648); time;
84
1