Message Boards Message Boards

0
|
4012 Views
|
1 Reply
|
0 Total Likes
View groups...
Share
Share this post:

Forms for high precision estimates of the value of the MRB constant

A definition of the MRB constant is found at http://mathworld.wolfram.com/MRBConstant.html .

Here we will let the MRB constant be m.

   m = 
   NSum[(-1)^n (n^(1/n) - 1), {n, 1, Infinity}, 
    Method -> "AlternatingSigns", WorkingPrecision -> 200];

Someone going by the name of Simon tweaked a code found in Wolfram's Mathematica documentation:

TranscendentalRecognize[num_?NumericQ, basis_?VectorQ] := 
 Module[{lr, ans}, 
  lr = FindIntegerNullVector[Prepend[N[basis, Precision[num]], num]];
  ans = Rest[lr].basis/First[lr];
  Sign[N[ans]] Sign[num] ans]

Using that code you find good approximations to m using Pi and E with relatively small coefficients:

 In[156]:= TranscendentalRecognize[N[(m), 10], {I, E, Pi}]

 Out[156]= (-5548 + 35205 E - 27175 Pi)/25425

To keep our coefficients relatively small we can run that result through the above code:

In[182]:= 
TranscendentalRecognize[
  N[10^17 N[m - (-5548 + 35205 E - 27175 Pi )/25425, 64], 20], {I, 
   E, Pi}]/10^17

Out[182]= (83217440 + 62719493 E - 
 65650167 Pi)/4361274800000000000000000

In[185]:= N[
 m - (-5548 + 35205 E - 27175 Pi
   25425 - (83217440 + 62719493 E - 
     65650167 \[Pi])/(43612748*10^17), 64]

Out[185]= 
3.770287000025812564513172454976176785864299849883119689155880147*10^-\
48

A side trip, running that last value through Wolfram alpha:

 In[227]:= N[
  m - (-5548 + 35205*E - 27175*Pi)/
    25425 - (83217440 + 62719493*E - 65650167*Pi)/
        (43612748*10^17) - 302/(801*10^47), 64]

 Out[227]= \
 -1.410478453630773394051986047372318299878197517215806991288757998*10^ -55

By the time you get past 80 digits or so, the coefficients get a little large, but better than the rational form of the convergent:

 In[225]:= 
 TranscendentalRecognize[
   N[10^(17 + 48)*N[m - (-5548 + 35205*E - 27175*Pi)/25425 - 
              (83217440 + 62719493*E - 65650167*Pi)/(43612748*10^17), 
      64], 20], {I, E, Pi}]/10^17

 Out[225]= (20649347459808815 + 56130646955877675 E + 
  64871693238168280 Pi)/100000000000000000

In[221]:= N[
 m - (-5548 + 35205*E - 27175*Pi)/
   25425 - (83217440 + 62719493*E - 65650167*Pi)/(43612748*10^17) - 
    (20649347459808815 + 56130646955877675*E + 64871693238168280*Pi)/
   10^65, 64]

Out[221]= \
1.738167350918853680937805925004854303831216939233355245531899429*10^-84

Or you can do it in one step if you allow larger coefficients, like 2.55552*10^22 :

In[228]:= TranscendentalRecognize[N[(m), 84], {I, E, Pi}]

Out[228]= (-25555197951240980193440 + 2247402860761626622683*E + 
   6534351448601282991480*Pi)/
   5760401218225175485204

In[230]:= N[
 m - (-25555197951240980193440 + 2247402860761626622683*E + 
     6534351448601282991480*Pi)/
       5760401218225175485204, 64]

Out[230]= \
1.127135515952212157932433266846921292365695339155308184983872105*10^- 86

Here is the equivalent convergent which denominator is 1.53883*10^42 :

289084420985999192505554593563212870303037/1538831955588180787869960129133737165092839  

giving, -1.625778100170999300628156702843916024278152430063768505704512297*10^-85

Here is a different form from the partial sums of the m'ths eta derivatives of m, (equation below, where B is the MRB constant), that gives slightly better results: MRB eta m

Those partial sums are found by the following quick way of computing the derivatives:

  Sum[(-1)^x ((Log[x]/x)^n/ n!), {x, 1, Infinity}, {n, 1, 1}]

(* 1/2 (2 EulerGamma Log[2] - Log[2]^2)*)

 Sum[(-1)^x ((Log[x]/x)^n/ n!), {x, 1, Infinity}, {n, 1, 2}]

(*1/24 (24 EulerGamma Log[2] - 2 EulerGamma \[Pi]^2 Log[2] - 
   12 Log[2]^2 - \[Pi]^2 Log[2]^2 + 24 \[Pi]^2 Log[2] Log[Glaisher] - 
   2 \[Pi]^2 Log[2] Log[\[Pi]] - 6 (Zeta^\[Prime]\[Prime])[2])*)




In[268]:= TranscendentalRecognize[
 N[(m), 84], {I, EulerGamma, Log[2]^2, Log[10]}]

Out[268]= (1/80826370493862052)(-190630587665207436 + 
  296310396381052324 EulerGamma + 294295421192450123 Log[2]^2 - 
  46302533684973279 Log[10])

In[269]:= m - 
 180826370493862052 (-190630587665207436 + 
    296310396381052324 EulerGamma + 294295421192450123 Log[2]^2 - 
    46302533684973279 Log[10])

Out[269]= \
 4.6709499622950929960393748064891883820605815200687245990818570879155\
     4254274220886835459705552633375788972488105172091231069283533175407762\
     1600260442284538388995500754827855591851095428968237992948792405049624\
     3707148380355989607564404491848371522575049351086340160092697183712756\
     09265449500499110582896291389443*10^-89

We get a better approximations with smaller coefficients by adding another key constant used in the above partial sums.

In[284]:= TranscendentalRecognize[
N[(m), 84], {I, EulerGamma, Log[2]^2, Log[10], Log[Glaisher]}]

Out[284]= (1/4097097378182412)(652730968473024 + 
2152917726747234 EulerGamma + 659252006825566 Log[2]^2 - 
540463472034230 Log[10] - 796070241454805 Log[Glaisher])

In[289]:= m - 
1/4097097378182412 (652730968473024 + 2152917726747234 EulerGamma + 
659252006825566 Log[2]^2 - 540463472034230 Log[10] - 
796070241454805 Log[Glaisher])

Out[289]= \
2.81225911160374287036510677080399638982124718803392868013275247561834\
8510140832070196358837221684604238983146984428670706087250087379689862\
7649664417909973724805474244916837556757167172245880857233927905276643\
9006711613215239138565417497911042523076855461951615123674295243222438\
5513556746872215576738874215*10^-92

With these last results, from constants found in the partial sums, we may ask, "if there is a closed form to the MRB constant, are they a key part of it?" Results being, getting 92 digits of accuracy from " N[(m), 84]" and relatively few coefficients of sizes near 2.15292*10^15.

EDIT:

I think this is a better approximation. (But I'm not sure. )

m = NSum[(-1)^n (n^(1/n) - 1), {n, 1, Infinity}, 
   Method -> "AlternatingSigns", WorkingPrecision -> 500];


In[793]:= TranscendentalRecognize[
 N[(m), 404], {I, GoldenRatio, \[Pi]^2 Log[2] Log[Glaisher], 
  Log[Glaisher], Gamma[E], EulerGamma, Log[2]^2, Log[10]}]

Out[793]= (23032446309805841432137685387508016350378296453 + 
   7824293098994122772115735767479678222980851440 EulerGamma - 
   26909430871184596325270800972547751934164966909 GoldenRatio - 
   14618552253017658721065360606780154916821962854 Gamma[E] + 
   1741966619938669588413478500331118558183055348 Log[2]^2 + 
   846645278684823911654916909850191069007016966 Log[10] + 
   11901460472101385255568508941925561890599458476 Log[Glaisher] + 
   20388733882366045706951071844505934826180774691 \[Pi]^2 Log[2] Log[
     Glaisher])/8185707346175752730920207408444168533548510847


In[794]:= m - Out[793]

Out[794]= \
-1.8932201324226291091246230874499558942091760187697891348927870444078\
703286521127947*10^-416

Here is some data on the integer term, 7 coefficients and denominator, in that order:

In[795]:= N[{23032446309805841432137685387508016350378296453, 
  7824293098994122772115735767479678222980851440 , 
  26909430871184596325270800972547751934164966909, 
  14618552253017658721065360606780154916821962854 , 
  1741966619938669588413478500331118558183055348 , 
  846645278684823911654916909850191069007016966 , 
  11901460472101385255568508941925561890599458476 , 
  20388733882366045706951071844505934826180774691 , 
  8185707346175752730920207408444168533548510847}]

Out[795]= {2.30324*10^46, 7.82429*10^45, 2.69094*10^46, 1.46186*10^46,
  1.74197*10^45, 8.46645*10^44, 1.19015*10^46, 2.03887*10^46, 
 8.18571*10^45}

In[797]:= PrimeOmega[{23032446309805841432137685387508016350378296453,
   7824293098994122772115735767479678222980851440 , 
  26909430871184596325270800972547751934164966909, 
  14618552253017658721065360606780154916821962854 , 
  1741966619938669588413478500331118558183055348 , 
  846645278684823911654916909850191069007016966 , 
  11901460472101385255568508941925561890599458476 , 
  20388733882366045706951071844505934826180774691 , 
  8185707346175752730920207408444168533548510847}]

Out[797]= {4, 9, 3, 6, 10, 6, 11, 7, 5}

EDIT:

This might be my most efficient approximation using other constants as of Feb 10, 2016, 1:30PM EST.It has 97 terms from a sequence of partial sums of the MRB constant (each term with of only 4 to 6 digits), a denominator of 6 digits (3 repeating), no integer term, and is accurate to 406 digits!

TranscendentalRecognize[num_?NumericQ, basis_?VectorQ] := 
 Module[{lr, ans}, 
  lr = FindIntegerNullVector[Prepend[N[basis, Precision[num]], num]];
  ans = Rest[lr].basis/First[lr];
  Sign[N[ans]] Sign[num] ans]


m = NSum[(-1)^n (n^(1/n) - 1), {n, 1, Infinity}, 
   Method -> "AlternatingSigns", WorkingPrecision -> 500];




  l = Join[ {Sqrt[2], 3^(1/3)}, Table[x^(1/x), {x, 5, 2^6 + 2^5}]];

     mm = TranscendentalRecognize[N[(m), 402], Join[{Log[10]}, l - 1]]  (* That's lower case L minus numeral one.*)



 (*{{(1/
  182182)(-90057 (-1 + 2^(3/32)) - 289697 (-1 + 2^(5/32)) + 
    426142 (-1 + 2^(1/4)) - 109930 (-1 + 2^(3/8)) - 
    434115 (-1 + Sqrt[2]) - 697014 (-1 + 2^(5/96) 3^(1/96)) - 
    54534 (-1 + 2^(1/12) 3^(1/48)) - 
    340769 (-1 + 2^(1/24) 3^(1/36)) + 
    313299 (-1 + 2^(1/8) 3^(1/24)) + 509568 (-1 + 3^(4/81)) + 
    752270 (-1 + 2^(1/54) 3^(1/18)) - 
    639844 (-1 + 2^(1/6) 3^(1/12)) - 752498 (-1 + 3^(1/9)) + 
    512966 (-1 + 2^(1/18) 3^(1/9)) - 244693 (-1 + 3^(2/9)) + 
    60425 (-1 + 3^(1/3)) + 682016 (-1 + 2^(1/20) 5^(1/80)) - 
    258322 (-1 + 3^(2/45) 5^(1/45)) + 
    660729 (-1 + 2^(3/40) 5^(1/40)) + 
    575682 (-1 + 3^(1/75) 5^(2/75)) + 
    146365 (-1 + 2^(1/50) 5^(1/25)) - 
    620252 (-1 + 2^(1/10) 5^(1/20)) - 140116 (-1 + 5^(2/25)) + 
    331276 (-1 + 5^(1/5)) - 156356 (-1 + 6^(1/18)) - 
    422896 (-1 + 6^(1/6)) - 416210 (-1 + 3^(2/63) 7^(1/63)) + 
    65342 (-1 + 2^(3/56) 7^(1/56)) - 
    418851 (-1 + 2^(1/14) 7^(1/28)) - 1010667 (-1 + 7^(2/49)) - 
    544745 (-1 + 7^(1/7)) + 134313 (-1 + 3^(1/45) 10^(1/90)) - 
    30859 (-1 + 10^(1/10)) + 862587 (-1 + 2^(3/88) 11^(1/88)) + 
    606904 (-1 + 2^(1/22) 11^(1/44)) + 1220649 (-1 + 11^(1/11)) + 
    168107 (-1 + 2^(1/26) 13^(1/52)) - 382809 (-1 + 13^(1/13)) - 
    754890 (-1 + 14^(1/14)) + 526610 (-1 + 2^(1/30) 15^(1/60)) + 
    135166 (-1 + 15^(1/15)) - 525703 (-1 + 2^(1/34) 17^(1/68)) - 
    316058 (-1 + 17^(1/17)) - 91163 (-1 + 2^(1/38) 19^(1/76)) + 
    680347 (-1 + 19^(1/19)) + 28957 (-1 + 2^(1/42) 21^(1/84)) + 
    344972 (-1 + 21^(1/21)) + 308319 (-1 + 22^(1/22)) + 
    685465 (-1 + 2^(1/46) 23^(1/92)) - 145563 (-1 + 23^(1/23)) - 
    726919 (-1 + 26^(1/26)) + 500104 (-1 + 29^(1/29)) + 
    18768 (-1 + 30^(1/30)) + 1111914 (-1 + 31^(1/31)) + 
    616209 (-1 + 33^(1/33)) - 836481 (-1 + 34^(1/34)) - 
    187644 (-1 + 35^(1/35)) + 163900 (-1 + 37^(1/37)) + 
    1106729 (-1 + 38^(1/38)) + 113034 (-1 + 39^(1/39)) + 
    969779 (-1 + 41^(1/41)) + 97006 (-1 + 42^(1/42)) - 
    415345 (-1 + 43^(1/43)) + 555883 (-1 + 46^(1/46)) + 
    99354 (-1 + 47^(1/47)) + 404049 (-1 + 51^(1/51)) + 
    405966 (-1 + 53^(1/53)) + 118736 (-1 + 55^(1/55)) - 
    26070 (-1 + 57^(1/57)) - 730861 (-1 + 58^(1/58)) + 
    166307 (-1 + 59^(1/59)) - 1600847 (-1 + 61^(1/61)) - 
    1027939 (-1 + 62^(1/62)) - 523994 (-1 + 65^(1/65)) - 
    723482 (-1 + 66^(1/66)) + 68835 (-1 + 67^(1/67)) - 
    395772 (-1 + 69^(1/69)) + 544685 (-1 + 70^(1/70)) + 
    667630 (-1 + 71^(1/71)) - 293069 (-1 + 73^(1/73)) - 
    8259 (-1 + 74^(1/74)) - 475790 (-1 + 77^(1/77)) - 
    398014 (-1 + 78^(1/78)) - 159020 (-1 + 79^(1/79)) - 
    964851 (-1 + 82^(1/82)) + 453338 (-1 + 83^(1/83)) - 
    165251 (-1 + 85^(1/85)) + 29846 (-1 + 86^(1/86)) + 
    140967 (-1 + 87^(1/87)) - 1008552 (-1 + 89^(1/89)) + 
    4673 (-1 + 91^(1/91)) - 712613 (-1 + 93^(1/93)) + 
    503000 (-1 + 94^(1/94)) + 268656 (-1 + 95^(1/95)) + 
    153387 Log[10])} *)

 c=  m - mm

 (*
-3.2121688257218250428865111218318816861494821939577062791103110149799\
7423668520845797420006586*10^-406 *)

Just for fun:

812812

In input form,

  Denominator[mm] == 
   2^{2, 2, 0, 0, 2 + 1} . (2 + {2*(2 + 1), 2 + (2 + 1), 2*2, 1, 0})! == 
     {4, 4, 1, 1, 8} . {8, 7, 6, 3, 2}! == {4, 4, 1, 1, 8} . {40320, 
     5040, 720, 6, 2} == 
     4*40320 + 4*5040 + 1*720 + 1*6 + 8*2 == 
   161280 + 20160 + 720 + 6 + 16 == 182182
POSTED BY: Marvin Ray Burns

I added a few approximations to the original post, and here is one more. It might not be optimal, but I thought the constants used makes for an interesting approximation!

Because we will need a good approximation of Liouville's number, we will use an extreme precision of 5040 digits.

Using coefficients of Liouville's number, the infinite power tower of the imaginary unit, and Log[10]; with a denominator, all of 100 to 106 digits we can get 411 digits of the MRB constant.

 m = NSum[(-1)^n (n^(1/n) - 1), {n, 1, Infinity}, Method -> "AlternatingSigns", WorkingPrecision -> 7!];

Let s be Liouville's number:

s = Sum[10^-n!, {n, 1, 7}];

and i be the real part of the infinite power tower of the imaginary unit.:

i = Re[-ProductLog[-Log[I]]/Log[I]];

then

m - (33632464898228920493908040679860318275821000332361971866504158299\
22432147058530583904168769339076287360 s - 
    367664018143723468308999811773586617078635085306488941501543783965\
9081693517931807454716941654680888746 Log[10] + 
    214647509850054994109049795818859063286420526274263941174030524682\
02682013114817083964220724260952993449 i)/
  69829670900936451657645732474050453539539548274661133399190212016044\
48912544923083492387370792698580611

gives

7.60660800383126188275072366481893018323616572188984378959844287516887\
5873129176340137894595084720613230022879983169974211215438488765977459\
6772659066745798733405953212046775203216731319343025893776533219479847\
3609257986096545748997493934241161129798475993787442652094248378951550\
3826743603794056305783845071892784007249866157926926827841434282047708\
3479843922638592933061865235201399247071050382893392927537874663904245\
5606102443932715725083127396427477637244810743351947337856226755782214\
042504828467381296685152627361365641805736726247833693114651034*10^-\
411
POSTED BY: Marvin Ray Burns
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract