Message Boards Message Boards

0
|
6377 Views
|
4 Replies
|
5 Total Likes
View groups...
Share
Share this post:

Phenomenon in finding "simplest" algebraic numbers

I noticed an interesting occurrence with RootApproximant[: Find the RootApproximant[ for a given number; then find the RootApproximant[ for 1/that number and you get the exact same coefficients in reverse order. I tried it with different numbers that RootApproximant[:gives a polynomial type solution to, and it seemed to be true in all those cases.

Can anyone point me to a reference for that matter? I can't be the first one to notice that!

Here I tried it with an approximation to E:

In[195]:= N[E, 30]

Out[195]= 2.71828182845904523536028747135

In[196]:= RootApproximant[2.71828182845904523536028747135]

Out[196]= Root[
 1 - 3 #1 - 7 #1^2 + 3 #1^3 - 5 #1^4 - 4 #1^5 - 2 #1^6 + 7 #1^7 + 
   2 #1^8 - 8 #1^9 - 2 #1^10 - 5 #1^11 - 4 #1^12 + #1^14 - 2 #1^15 - 
   2 #1^16 + #1^17 &, 3]

In[197]:= 1/%%

Out[197]= 0.367879441171442321595523770161

In[198]:= RootApproximant[0.367879441171442321595523770161]

Out[198]= Root[
 1 - 2 #1 - 2 #1^2 + #1^3 - 4 #1^5 - 5 #1^6 - 2 #1^7 - 8 #1^8 + 
   2 #1^9 + 7 #1^10 - 2 #1^11 - 4 #1^12 - 5 #1^13 + 3 #1^14 - 
   7 #1^15 - 3 #1^16 + #1^17 &, 2]

Here I tried it with an approximation to the MRB constant:

In[192]:= RootApproximant[0.18785964246206712024857897184]

Out[192]= Root[-1 - #1 + 33 #1^2 - 3 #1^3 + 27 #1^4 + 40 #1^5 + 
   5 #1^6 - 2 #1^7 - 27 #1^8 - 36 #1^9 + 2 #1^10 + 21 #1^11 + 
   21 #1^12 + #1^13 &, 3]

In[193]:= 1/m

Out[193]= 5.323123087503594008916986345

In[194]:= RootApproximant[5.323123087503594008916986345]

Out[194]= Root[-1 - 21 #1 - 21 #1^2 - 2 #1^3 + 36 #1^4 + 27 #1^5 + 
   2 #1^6 - 5 #1^7 - 40 #1^8 - 27 #1^9 + 3 #1^10 - 
   33 #1^11 + #1^12 + #1^13 &, 3]
POSTED BY: Marvin Ray Burns
4 Replies
Sort By:

If p(x) ~~0 and is a polynomial of degree n, then q(x)= x^n*p(1/x) also is approximately 0 and now you have reversed the coeffs.
POSTED BY: Daniel Lichtblau

I don't see it. First there are slight difficulties with

In[59]:= RootApproximant[113.018]
Out[59]= 1/358 (20235 + 3 Sqrt[45452065])

In[58]:= RootApproximant[1/113.018]
Out[58]= 1/360 (6745 - Sqrt[45452065])

because they do not come out as Root objects. Then you observe for some numbers an inversion of sign in the coefficient list

In[82]:= RootApproximant[38.75996570032703, 100]
Out[82]= Root[-7 - 11 #1 - 11 #1^2 - 43 #1^3 + 55 #1^4 - 18 #1^5 + 
   2 #1^6 + 46 #1^7 - 24 #1^8 - 47 #1^9 + 13 #1^10 + 9 #1^11 - 
   39 #1^12 + #1^13 &, 3]

In[83]:= RootApproximant[1/38.75996570032703, 100]
Out[83]= Root[-1 + 39 #1 - 9 #1^2 - 13 #1^3 + 47 #1^4 + 24 #1^5 - 
   46 #1^6 - 2 #1^7 + 18 #1^8 - 55 #1^9 + 43 #1^10 + 11 #1^11 + 
   11 #1^12 + 7 #1^13 &, 3]

even if one defines modest and humble

Clear[mrbQ]
mrbQ[x_?NumericQ, d_Integer:100] := 
 Block[{a1 = CoefficientList[First[RootApproximant[x, d]][y], y], 
   a2 = CoefficientList[First[RootApproximant[1/x, d]][y], y]},
  (a1 == Reverse[a2]) || (a1 == -Reverse[a2])
  ]

the first few tests fail

In[88]:= l0 = RandomReal[{-19, 53}, 10]
Out[88]= {-5.56205, 18.565, 9.93291, 36.6722, 7.11272, -15.8707, \
48.0537, 2.31938, -17.7694, 20.6123}

In[90]:= mrbQ /@ l0
Out[90]= {True, True, True, True, True, False, True, True, True, True}

In[91]:= RootApproximant[-15.870657952807605, 100]
Out[91]= Root[-18 + 15 #1 - 2 #1^2 + 4 #1^3 - 15 #1^4 - 5 #1^5 + 
   8 #1^6 + 8 #1^7 + 21 #1^8 - 18 #1^9 + 18 #1^11 + 
   17 #1^12 + #1^13 &, 1]

In[92]:= RootApproximant[1/-15.870657952807605, 100]
Out[92]= Root[-2 - 33 #1 - 20 #1^2 - #1^3 - 9 #1^4 + 13 #1^5 - 
   10 #1^6 + 14 #1^7 + 19 #1^8 + 20 #1^9 &, 2]

this might be devoted to the statement in the RootApproximant manual page

Results from RootApproximant may not be unique.

Possibly the assumption (if proper stated) holds for numbers where RootApproximant gives for the number and it's reciprocal number polynoms of the same degree.
POSTED BY: Udo Krause

Forget about it. Change the test a bit more (a PolynomialQ test is missing yet) and drop the degree condition 

In[112]:= Clear[mrbQHumble]
mrbQHumble[x_?NumericQ] := 
 Block[{a1 = CoefficientList[First[RootApproximant[x]][y], y], 
   a2 = CoefficientList[First[RootApproximant[1/x]][y], y]},
  If[Length[a1] == Length[a2] && FreeQ[a1, y] && 
    FreeQ[a2, y], (a1 == Reverse[a2]) || (a1 == -Reverse[a2]), 
   Missing[]]
  ]

In[114]:= l0 = RandomReal[{-19, 53}, 100]
Out[114]= {-1.38507, 49.4481, 24.7934, 11.0104, 3.86794, 7.93207, \
48.0579, -9.44529, 48.7661, -14.129, -14.7824, -6.62547, 40.7146, \
-9.87912, -11.0193, 23.8705, -13.5526, 2.14101, 4.57075, -10.0782, \
-3.5094, -5.45227, 30.0554, 39.6618, 3.95229, 13.3368, 43.1726, \
25.5232, 4.30698, -9.89652, 25.0371, 44.8908, 31.7411, -10.7786, \
42.8577, 39.8379, -12.9649, -10.6592, -0.0523882, 24.5372, 52.9216, \
-12.2468, 27.3211, 25.072, -10.8939, 21.1145, -14.224, 52.6378, \
-12.6092, -4.91945, 52.327, 24.0178, 9.16044, 52.1168, 31.1463, \
16.357, 13.9551, 31.295, -8.99637, 43.5836, -14.6001, 34.3883, \
30.7991, 17.0297, -18.3356, -4.35444, 4.17391, 38.1627, 6.66596, \
28.9392, 51.549, -6.69014, 14.7294, -3.10411, 21.2488, 13.6281, \
5.75214, 1.00631, 44.6239, 22.1666, 39.5046, 47.7347, 26.2585, \
52.7089, 50.2851, 13.368, -5.99931, 31.8238, 5.17775, 24.6661, \
9.58021, 19.6149, 7.77517, -6.62582, 16.2579, 46.4658, 15.8527, \
52.8861, -8.88976, 10.9706}

In[115]:= And @@ DeleteMissing[mrbQHumble /@ l0]
During evaluation of In[115]:= First::normal: Nonatomic expression expected at position 1 in First[7335/7289]. >>
During evaluation of In[115]:= First::normal: Nonatomic expression expected at position 1 in First[7289/7335]. >>
Out[115]= False

and the wrong-doer is

In[118]:= RootApproximant[1/l0[[61]]]
Out[118]= Root[-7 - 102 #1 - 2 #1^2 - 72 #1^3 + 4 #1^4 + 65 #1^5 + 44 #1^6 &, 1]

In[119]:= RootApproximant[l0[[61]]]
Out[119]= Root[57 + 118 #1 - #1^2 + 139 #1^3 - 43 #1^4 + 11 #1^5 + #1^6 &, 1]

In[120]:= l0[[61]]
Out[120]= -14.6001
POSTED BY: Udo Krause

For an algebraic number $x$ the property is obvious: Let $a_0+a_1 x+a_2x^2+...+a_nx^n=0$ be the $\mathit{definition}$ of $x$. Divide by $x^n \neq 0$ to get $a_0\left(\frac{1}{x}\right)^n+a_1 \left(\frac{1}{x}\right)^{n-1}+a_2 \left(\frac{1}{x}\right)^{n-2}+...+ a_n =0$ wich has reversed coefficients for $y=\frac{1}{x}$. The accidential minus is possible because $0=-0$. Only RootApproximant is the worst vehicle to show this.

Possibly one could stabilize RootApproximant by forcing it to hold this property because it is going to represent the input as algebraic number.

In[31]:= RootApproximant[SetPrecision[14.6001, #]] & /@ Range[18]
Out[31]= {15, 1/4 (29 + Sqrt[865]), 1/4 (29 + Sqrt[865]), 
 1/2 (15 + Sqrt[201]), 
 1/2 (15 + Sqrt[201]), 73/5, 73/5, 73/5, 73/5, 73/5, 
 Root[63 - 89 #1 - 38 #1^2 + 3 #1^3 &, 3], 
 Root[63 - 89 #1 - 38 #1^2 + 3 #1^3 &, 3], 
 Root[-23 + 37 #1 + 14 #1^2 - 3 #1^4 - 29 #1^5 + 2 #1^6 &, 4], 29171/1998, 
 Root[62 - 8 #1 - 82 #1^2 - 23 #1^3 + 37 #1^4 - 17 #1^5 + #1^6 &, 2], 
 Root[-71 + 44 #1 - 62 #1^2 - 3 #1^3 + 91 #1^4 - 50 #1^5 + 3 #1^6 &, 2], 146001/10000, 146001/10000}

In[32]:= RootApproximant[SetPrecision[1/14.6001, #]] & /@ Range[18]
Out[32]= {1/15, 1/6 (-29 + Sqrt[865]), 1/6 (-29 + Sqrt[865]), 
 1/12 (15 - Sqrt[201]), 
 1/12 (15 - Sqrt[201]), 5/73, 5/73, 5/73, 5/73, 5/73, 
 Root[3 - 38 #1 - 89 #1^2 + 63 #1^3 &, 2], 
 Root[3 - 38 #1 - 89 #1^2 + 63 #1^3 &, 2], 
 Root[-2 + 29 #1 + 3 #1^2 - 14 #1^4 - 37 #1^5 + 23 #1^6 &, 2], 1998/29171, 
 Root[1 - 17 #1 + 37 #1^2 - 23 #1^3 - 82 #1^4 - 8 #1^5 + 62 #1^6 &, 1], 
 Root[2 - 26 #1 - 47 #1^2 - 4 #1^3 + 115 #1^4 + 31 #1^5 + 58 #1^6 &, 1], 10000/146001, 10000/146001}
POSTED BY: Udo Krause
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract