Message Boards Message Boards

Try to beat these MRB constant records!

POSTED BY: Marvin Ray Burns
40 Replies
POSTED BY: Marvin Ray Burns

If this reply is the first one displayed, refresh the page to see the main post above.

I forgot about the following trigonometric MRB constant sums and integrals:

POSTED BY: Marvin Ray Burns

If this reply appears first, try refreshing the page to find out what the MRB constant is.

 Compare the results of these two sets of code. The first one is based on the [MRB constant][1] (0.18785...), and the second one, 1/e (0.367879...). Can you change these 3 trig formulas so that 1/e (or any other constant) gives the same appearance as the MRB constant does? Or are these graphs from these 3 families of trig formulas unique to the MRB constant?

m = 0.1878596424620671202485179340542732300559030949001387861720046840\
89477231564660213703296654433107496903
ListPlot[Table[Sin[Pi/m*(5060936308 + 78389363/24*n)], {n, -100, 100}]]
ListPlot[Table[Cos[Pi/m*(5060936308 + 78389363/24*n)], {n, -100, 100}]]
ListPlot[Table[
  Tan[Pi/m*(5060936308 + 78389363/24*n)], {n, -100, 100}], 
 Joined -> True]

![enter image description here][2]![enter image description here][3]![enter image description here][4]

d = 1/E
ListPlot[Table[Sin[Pi/d*(5060936308 + 78389363/24*n)], {n, -100, 100}]]
ListPlot[Table[Cos[Pi/d*(5060936308 + 78389363/24*n)], {n, -100, 100}]]
ListPlot[Table[
  Tan[Pi/d*(5060936308 + 78389363/24*n)], {n, -100, 100}], 
 Joined -> True]

![enter image description here][5]enter image description hereenter image description here

P.S. It doesn't take much to simply get "geometric" shapes out of this family of trig formulas. Try the following code:

d = 1/E - 10^-2
ListPlot[Table[Sin[Pi/d*(5060936308 + 78389363/24*n)], {n, -100, 100}]]
ListPlot[Table[Cos[Pi/d*(5060936308 + 78389363/24*n)], {n, -100, 100}]]
ListPlot[Table[
  Tan[Pi/d*(5060936308 + 78389363/24*n)], {n, -100, 100}], 
 Joined -> True]

enter image description here

Plus, it don't take much error in the MRB constant's approximate value to really disfigure it's graphs. Try this code where you only use 12 digits of precision :for the MRB constant

m = 0.187859642462
ListPlot[Table[Sin[Pi/m*(5060936308 + 78389363/24*n)], {n, -100, 100}]]
ListPlot[Table[Cos[Pi/m*(5060936308 + 78389363/24*n)], {n, -100, 100}]]
ListPlot[Table[
  Tan[Pi/m*(5060936308 + 78389363/24*n)], {n, -100, 100}], 
 Joined -> True]

enter image description here

POSTED BY: Marvin Ray Burns

POSTED BY: Marvin Ray Burns

"I compare 300 years of summation methods for the MRB constant."

In the first post I mentioned summing the MRB constant by Euler's method and Crandall's method. Here I compare them:

Here are faster methods where m is the known value of the MRB constant found in the above replies:

POSTED BY: Marvin Ray Burns

7,000,000 digits on hold

With my two souped-up I9-14900 K's

it would take 90 days and $500.00 of electricity to compute, and at least 120 days and $1000.00 to check. 

I'm getting a I9-14900KS to add to my cluster and will see how it speeds the process up. It also should be very good at breaking speed records!

POSTED BY: Marvin Ray Burns

7,000,000-digit computation is back on!

Using 3X24 physical processing cores at up to 6.2 GHz and 6666MHz RAM and 3X16 Kernels on 1X i9-14900KS and 2X i9-14900K

Here is the notebook.

Beginning:

In[1]:= Needs["SubKernels`LocalKernels`"]; \
Needs["SubKernels`RemoteKernels`"];
Block[{$mathkernel = $mathkernel <> " -threadpriority=2"}, 
 LaunchKernels[]]

Out[2]= {"KernelObject"[1, "local"], "KernelObject"[2, "local"], 
 "KernelObject"[3, "local"], "KernelObject"[4, "local"], 
 "KernelObject"[5, "local"], "KernelObject"[6, "local"], 
 "KernelObject"[7, "local"], "KernelObject"[8, "local"], 
 "KernelObject"[9, "local"], "KernelObject"[10, "local"], 
 "KernelObject"[11, "local"], "KernelObject"[12, "local"], 
 "KernelObject"[13, "local"], "KernelObject"[15, "local"], 
 "KernelObject"[16, "local"], "KernelObject"[18, "local"], 
 "KernelObject"[25, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[26, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[27, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[28, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[29, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[30, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[31, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[32, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[33, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[34, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[35, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[36, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[37, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[38, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[39, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[40, "2600:1700:71d0:fd50:3177:67bd:cdce:588a"], 
 "KernelObject"[41, "second"], "KernelObject"[44, "second"], 
 "KernelObject"[45, "second"], "KernelObject"[46, "second"], 
 "KernelObject"[47, "second"], "KernelObject"[49, "second"], 
 "KernelObject"[50, "second"], "KernelObject"[51, "second"], 
 "KernelObject"[53, "second"], "KernelObject"[54, "second"], 
 "KernelObject"[55, "second"], 
 "KernelObject"[56, "second"], $Failed, $Failed}

Present line:

As of  Tue 7 May 2024 11:31:40 there were 686080 iterations done in 4.6818*10^5 seconds. That is 1.4654 iterations/s. 7.386990% complete. It should take 73.3434 days or 6.337*10^6s, and finish Sun 14 Jul 2024 09:43:06.

A lot could go wrong: long-term power outage, hardware issues, unwanted software or operating system updates. But it will never get done if we don't start sometime!

POSTED BY: Marvin Ray Burns

If above this you see the title "Try to beat these MRB constant records!" in order to see the first 9 sections, the basic theory of the MRB constant (CMRB), you'll need to refresh the page.

§B "Rational results" while summing (CMRB).

This is just an observation about the MRB constant sum enter image description here If the following Mathematica computations are correct, you get near rational results, by a factor of log10, when starting the sum from large integer powers of 10.

It looks like for p(x)= approximation (in blue) of x, limit as x-> infinity of p(x)/p(x+1) is 1/10.

POSTED BY: Marvin Ray Burns
POSTED BY: Marvin Ray Burns
POSTED BY: Marvin Ray Burns

Along the lines of how normal the MRB constant is, I noticed the following about its original sum,

$\displaystyle{\sum_{n=1}^{\infty}(-1)^n(n^{1/n}-1)}.$

I wondered, (what would happen to the sum if you added smaller and smaller steps?)

 ReImPlot[ NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/n},  WorkingPrecision -> 30, Method ->"AlternatingSigns"], {n, 1,  Infinity}]

enter image description here

`

  In[35]:= Re[
   NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/10^20}, 
    WorkingPrecision -> 70, Method -> "AlternatingSigns", 
    NSumTerms -> 2000]]

  Out[35]= -1.\
  999999749999999973333339999999998228052447182132376098872359604490555*\
  10^-14

  In[36]:= Re[
   NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/10^30}, 
    WorkingPrecision -> 70, Method -> "AlternatingSigns", 
    NSumTerms -> 2000]]

  Out[36]= -1.\
  999999749999999999999999997333333999999999999999999982280524444387501*\
  10^-24

  In[37]:= Re[
   NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/10^40}, 
    WorkingPrecision -> 70, Method -> "AlternatingSigns", 
    NSumTerms -> 2000]]

  Out[37]= -1.\
  999999749999999999999999999999999999733333399999999999999990562538808*\
  10^-34

  In[38]:= Re[
   NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/10^50}, 
    WorkingPrecision -> 70, Method -> "AlternatingSigns", 
    NSumTerms -> 2000]]

  Out[38]= -1.\
  999999749999999999999999999999999999999999999973243568040505517332039*\
  10^-44

In this case, finding exactly where the error starts is difficult for me. But let's assume the following is true.

In[5]:= Re[ NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/10^30}, WorkingPrecision -> 40, Method -> "AlternatingSigns"]]

Out[5]= -1.12250000000000000000000000002637761741*10^-28

In[6]:= Re[NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 2/10^40},  WorkingPrecision -> 50, Method -> "AlternatingSigns"]]

Out[6]= -2.244999999999999999999999999999999999982964553611*10^-38

  In[39]:= p =  Re[NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/10^200}, WorkingPrecision -> 1000, Method -> "AlternatingSigns"]]

Out[39]= \ -1.1224999999999999999999999999999999999999999999999999999999999999999\ 9999999999999999999999999999999999999999999999999999999999999999999999\ 9999999999999999999999999999999999999999999999999999999999999887999999\ 9999999999999999999999999999999999999999999999999999999999999999999999\ 9999999999999999999999999999999999999999999999999999999999999999999999\ 9999999999999999999999999999999999999999999999999951865743238994910613\ ...*10^-198

In[41]:= Rationalize[N[Q100 = 10^98 p + 1, 200], 0]]

$$\frac{8908685968819599109131403118040089086859688195991091314031180400890868596881959910913140311804008907}{8908685968819599109131403118040089086859688195991091314031180400890868596881959910913140311804008908}$$

I think it's worth pointing out that the rational approximation consists, entirely, of repeating $$89086859688195991091314031180400's$$ except for the last digit of the numerator.

Some steps of multiples of powers of 10 also give solutions with many repeating 9s.

In[59]:= N[ Re[NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/10^40}, WorkingPrecision -> 1000, Method -> "AlternatingSigns"]], 100]

Out[59]=-1.122499999999999999999999999999999999998879999999999999999999999999999999999995186574323899491061367*10^-38

In[54]:= N[Re[NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/20^40}, WorkingPrecision -> 1000, Method ->"AlternatingSigns"]], 55]

Out[54]= \ -1.020907802740111947059631347656249999999999999999999074*10^-50

In[69]:= N[Re[NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/50^40}, WorkingPrecision -> 1000, Method -> "AlternatingSigns"]], 150]

Out[69]= \ -1.2342018021785599999999999999999999999999999999999999999999999999998\ 6460030820316153243290828799999999999999999999999999999999999999993601\ 859835697267*10^-66

In[84]:= N[ Re[NSum[(-1)^x (x^(1/x) - 1), {x, 1, Infinity, 1/200^40}, WorkingPrecision -> 1000, Method -> "AlternatingSigns"]], 200]

Out[84]= \ -1.0209078027401119470596313476562499999999999999999999999999999999999\ 9999999999999999999999990735577139406090041440222648816416040062904357\ 91015624999999999999999999999999999999999999637878099817017722*10^-90

I posted it at https://math.stackexchange.com/questions/4575530/sum-infty-textstylex-11-k-atopk-in-1-ldots-infty-1x-x1 to see if anyone can explain it.

I found the following that shows a little bit of what happens for smaller and smaller steps of powers 2 and 5, which are related to powers 10.

By a factor of pi, the imaginary part has at least as many repetitions of decimals.

In

680380635051101*10^-79, \
-1.0S4e9t9A9t9t9r9i9b9u9t9e9s9[9S9ep9a9r9a9t9e9,9 9H9o99d9R9e9s9t9]99999988
9999999999S9e9p9a9r9a9t9e9[9d9a9t\a_
 pat9t9_9]9 9:9=9 9M9o9d9u9l9e9[85
0680 3 8{0r6e3s5}0,5
1*10 ^ -r8e1s,  =\ G
her-B1y.[0d1a4t9a9,9 9p9a9t9t9]9;99
9999 9 9I9f9[9p9a9t9t9@9r9e9s9[9[919,9 919]9]9,9 8r8e9s7,4 9R9e9v9e9r9s9e9@9r9e9s9]9
9999 9 9]\


999e9p9a9r9a9t9e9[9d9a9t9a9,9 8E5v3e8n0Q6]8
806{3{520,5 *41,0 ^6-,8 38,,  \1
1, 3-,1 .50,1 479,9 999}9}9
999999999999999999999999999999998897499999999999999999999\
99999999999999999985380680380635*10^-85, \
-1.0149999999999999999999999999999999999999999889749999999999999999999\
99999999999999999999853806803806*10^-87, \
-1.0149999999999999999999999999999999999999999988974999999999999999999\
99999999999999999999998538068038*10^-89, \
-1.0149999999999999999999999999999999999999999998897499999999999999999\
99999999999999999999999985380680*10^-91, \
-1.0149999999999999999999999999999999999999999999889749999999999999999\
99999999999999999999999999853807*10^-93, \
-1.0149999999999999999999999999999999999999999999988974999999999999999\
99999999999999999999999999998538*10^-95, \
-1.0149999999999999999999999999999999999999999999998897499999999999999\
99999999999999999999999999999985*10^-97}

Here is an answer to the previous question.

While mathematicians try to crack this nut, here's a physicist's point of view. I will focus on how to calculate this integral, keeping things as simple as possible, probably approximately.

his answer

This is an example of that how we can use diverging series to compute values. It is only important to guess where to truncate the series.

POSTED BY: Marvin Ray Burns
Attachments:
POSTED BY: Marvin Ray Burns

Time for a quick memorial:

This discussion began on 1/20/2014.

"This MRB records posting reached a milestone of over 120,000 views on 3/31/2020, around 4:00 am."

"As of 04:00 am 1/2/2021, this discussion had 300,000 views!"

"And as of 08:30 pm 2/3/2021, this discussion had 330,000 views!"

"7:00 pm 10/8/2021 it had 520,000 views!"

1:40 am 3/2/2022 600,000 views

8:25 pm 5/4/2022 650,000 views

In the last seven months, this discussion has had as many visitors as it did in its first seven years!

1/20/2023 695,000 views in nine years. That's an average of 8.8 views/hour, or one view every 6.8 minutes.

1/15/2024 810,223 views in ten years. That's an average of 9.24 views/hour, or one view every 6.49 minutes.

POSTED BY: Marvin Ray Burns
POSTED BY: Marvin Ray Burns

WOW!!!!

I discovered a non-trivial infinitude of proper integrals that all equal the MRB constant (CMRB): enter image description here

Maybe a few more restrictions, like a≠b.

See cloud notebook.

enter image description here

g[x_] = x^(1/x); CMRB = NSum[(-1)^k (g[k] - 1), {k, 1, Infinity}, 
     WorkingPrecision -> 100, Method -> "AlternatingSigns"];

In[239]:= g[x_] = x^(1/x); Table[w = (I (t - b))/(t - a);
 CMRB - NIntegrate[
   Re[g[(1 + w)] Csc[\[Pi] w]] (t - a)^-2*(b - a), {t, a, b}, 
      WorkingPrecision -> 100], {a, 0, 5}, {b, a + 1, 6}]

Out[239]= {{-9.3472*10^-94, -9.3472*10^-94, -9.3472*10^-94, \
-9.3472*10^-94, -9.3472*10^-94, -9.3472*10^-94}, {-9.3472*10^-94, \
-9.3472*10^-94, -9.3472*10^-94, -9.3472*10^-94, -9.3472*10^-94}, \
{-9.3472*10^-94, -9.3472*10^-94, -9.3472*10^-94, -9.3472*10^-94}, \
{-9.3472*10^-94, -9.3472*10^-94, -9.3472*10^-94}, {-9.3472*10^-94, \
-9.3472*10^-94}, {-9.3472*10^-94}}

In[240]:= g[x_] = x^(1/x); Table[w = (I (t - b))/(t - a);
 CMRB - NIntegrate[
   Re[g[(1 + w)] Csc[\[Pi] w]] (t - a)^-2*(b - a), {t, a, b}, 
      WorkingPrecision -> 100], {a, 4/10, 5}, {b, a + 1, 6}]

Out[240]= {{-9.3472*10^-94, -9.3472*10^-94, -9.3472*10^-94, \
-9.3472*10^-94, -9.3472*10^-94}, {-9.3472*10^-94, -9.3472*10^-94, \
-9.3472*10^-94, -9.3472*10^-94}, {-9.3472*10^-94, -9.3472*10^-94, \
-9.3472*10^-94}, {-9.3472*10^-94, -9.3472*10^-94}, {-9.3472*10^-94}}

In[234]:= a = E; b = Pi;

In[254]:= a = E; b = Pi; g[x_] = x^(1/x); (w = (I (t - b))/(t - a);
 Print[CMRB - 
   NIntegrate[
    Re[g[(1 + w)] Csc[\[Pi] w]] (t - a)^-2*(b - a), {t, a, b}, 
    WorkingPrecision -> 100]]); Clear[a, b]

During evaluation of In[254]:= -9.3472*10^-94

In[260]:= a = 1; b = I; g[x_] = x^(1/x); (w = (I (t - b))/(t - a);
 Print[CMRB - 
   NIntegrate[
    Re[g[(1 + w)] Csc[\[Pi] w]] (t - a)^-2*(b - a), {t, a, b}, 
    WorkingPrecision -> 100]]); Clear[a, b]

During evaluation of In[260]:= -9.3472*10^-94+0.*10^-189 I
POSTED BY: Marvin Ray Burns

Beyond any shadow of a doubt, I verified 5,609,880 digits of the MRB constant on Thu 4 Mar 2021 08:03:45. The 5,500,000+ digit computation using a totally different method showed about that many decimals in common with the 6,000,000+ digit computation. The method for the 6,000,000 run is found in a few messages above in the attached notebook titled "MRBSC2 6 million...nb."

Print["Start time is ", ds = DateString[], "."];
prec = 6000000;
(**Number of required decimals.*.*)ClearSystemCache[];
T0 = SessionTime[];
expM[pre_] := 
  Module[{a, d, s, k, bb, c, end, iprec, xvals, x, pc, cores = 16(*=4*
    number of physical cores*), tsize = 2^7, chunksize, start = 1, ll,
     ctab, pr = Floor[1.005 pre]}, chunksize = cores*tsize;
   n = Floor[1.32 pr];
   end = Ceiling[n/chunksize];
   Print["Iterations required: ", n];
   Print["Will give ", end, 
    " time estimates, each more accurate than the previous."];
   Print["Will stop at ", end*chunksize, 
    " iterations to ensure precsion of around ", pr, 
    " decimal places."]; d = ChebyshevT[n, 3];
   {b, c, s} = {SetPrecision[-1, 1.1*n], -d, 0};
   iprec = Ceiling[pr/396288];
   Do[xvals = Flatten[Parallelize[Table[Table[ll = start + j*tsize + l;
         x = N[E^(Log[ll]/(ll)), iprec];

       (**N[Exp[Log[ll]/ll],pr/396288]**)


         pc = iprec;
         While[pc < pr/65536, pc = Min[3 pc, pr/65536];
          x = SetPrecision[x, pc];
          y = x^ll - ll;
          x = x (1 - 2 y/((ll + 1) y + 2 ll ll));];

         (**N[Exp[Log[ll]/ll],pr/65536]**)

         x = SetPrecision[x, pr/16384];
         xll = x^ll; z = (ll - xll)/xll;
         t = 2 ll - 1; t2 = t^2;
         x = 
          x*(1 + SetPrecision[4.5, pr/16384] (ll - 1)/
               t2 + (ll + 1) z/(2 ll t) - 
             SetPrecision[13.5, 
               pr/16384] ll (ll - 1) 1/(3 ll t2 + t^3 z));

             (*N[Exp[Log[ll]/ll],pr/16384]*)


          x = SetPrecision[x, pr/4096];
         xll = x^ll; z = (ll - xll)/xll;
         t = 2 ll - 1; t2 = t^2;
         x = 
          x*(1 + SetPrecision[4.5, pr/4096] (ll - 1)/
               t2 + (ll + 1) z/(2 ll t) - 
             SetPrecision[13.5, 
               pr/4096] ll (ll - 1) 1/(3 ll t2 + t^3 z));

         (*N[Exp[Log[ll]/ll],pr/4096]*)

         x = SetPrecision[x, pr/1024];
         xll = x^ll; z = (ll - xll)/xll;
         t = 2 ll - 1; t2 = t^2;
         x = 
          x*(1 + SetPrecision[4.5, pr/1024] (ll - 1)/
               t2 + (ll + 1) z/(2 ll t) -SetPrecision[13.5, 
               pr/1024] ll (ll - 1) 1/(3 ll t2 + t^3 z));

               (*N[Exp[Log[ ll]/ll],pr/1024]*)

          x = SetPrecision[x, pr/256];
         xll = x^ll; z = (ll - xll)/xll;
         t = 2 ll - 1; t2 = t^2;
         x = 
          x*(1 + SetPrecision[4.5, pr/256] (ll - 1)/
               t2 + (ll + 1) z/(2 ll t) - 
             SetPrecision[13.5, 
               pr/256] ll (ll - 1) 1/(3 ll t2 + t^3 z));

         (*N[Exp[Log[ ll]/ll],pr/256]*)

         x = SetPrecision[x, pr/64];
         xll = x^ll; z = (ll - xll)/xll;
         t = 2 ll - 1; t2 = t^2;
         x = 
          x*(1 + SetPrecision[4.5, pr/64] (ll - 1)/
               t2 + (ll + 1) z/(2 ll t) - 
             SetPrecision[13.5, 
               pr/64] ll (ll - 1) 1/(3 ll t2 + t^3 z));

        (**N[Exp[Log[ ll]/ll],pr/64]**)

        x = SetPrecision[x, pr/16];
         xll = x^ll; z = (ll - xll)/xll;
         t = 2 ll - 1; t2 = t^2;
         x = 
          x*(1 + SetPrecision[4.5, pr/16] (ll - 1)/
               t2 + (ll + 1) z/(2 ll t) - 
             SetPrecision[13.5, 
               pr/16] ll (ll - 1) 1/(3 ll t2 + t^3 z));

          (**N[Exp[Log[ ll]/ll],pr/16]**)

         x = SetPrecision[x, pr/4];
         xll = x^ll; z = (ll - xll)/xll;
         t = 2 ll - 1; t2 = t^2;
         x = 
          x*(1 + SetPrecision[4.5, pr/4] (ll - 1)/
               t2 + (ll + 1) z/(2 ll t) - 
             SetPrecision[13.5, 
               pr/4] ll (ll - 1) 1/(3 ll t2 + t^3 z));

         (**N[Exp[Log[ll]/ll],pr/4]**)

          x = SetPrecision[x, pr];
         xll = x^ll; z = (ll - xll)/xll;
         t = 2 ll - 1; t2 = t^2;
         x = 
          x*(1 + SetPrecision[4.5, pr] (ll - 1)/
               t2 + (ll + 1) z/(2 ll t) - 
             SetPrecision[13.5, 
               pr] ll (ll - 1) 1/(3 ll t2 + t^3 z));

       (*N[Exp[Log[ll]/ll],pr]*)

      x, {l, 0, tsize - 1}], {j, 0, cores - 1}]]];
    ctab = ParallelTable[Table[c = b - c;
       ll = start + l - 2;
       b *= 2 (ll + n) (ll - n)/((ll + 1) (2 ll + 1));
       c, {l, chunksize}], Method -> "Automatic"];
    s += ctab.(xvals - 1);
    start += chunksize;
    st = SessionTime[] - T0; kc = k*chunksize;
    ti = (st)/(kc + 10^-4)*(n)/(3600)/(24);
    If[kc > 1, 
     Print["As of  ", DateString[], " there were ", kc, 
      " iterations done in ", N[st, 5], " seconds. That is ", 
      N[kc/st, 5], " iterations/s. ", N[kc/(end*chunksize)*100, 7], 
      "% complete.", " It should take ", N[ti, 6], " days or ", 
      N[ti*24*3600, 4], "s, and finish ", DatePlus[ds, ti], "."]];
    Print[];, {k, 0, end - 1}];
   N[-s/d, pr]];
t2 = Timing[MRB1 = expM[prec];]; Print["Finished on ", 
 DateString[], ". Proccessor and actual time were ", t2[[1]], " and ",
  SessionTime[] - T0, " s. respectively"];
Print["Enter MRB1 to print ", 
 Floor[Precision[
   MRB1]], " digits. The error from a 5,000,000 or more digit \
calculation that used a different method is  "]; N[MRB - MRB1, 20]

The 5,500,000+digit run is found below in the attached "5p5million.nb," including the verified 5,609,880 digits.

(*Fastest (at RC's end) as of 30 Nov 2012.*)prec = 5500000;(*Number \
of required decimals.*)ClearSystemCache[];
T0 = SessionTime[];
expM[pre_] := 
  Module[{a, d, s, k, bb, c, n, end, iprec, xvals, x, pc, cores = 4, 
    tsize = 2^7, chunksize, start = 1, ll, ctab, 
    pr = Floor[1.02 pre]}, chunksize = cores*tsize;
   n = Floor[1.32 pr];
   end = Ceiling[n/chunksize];
   Print["Iterations required: ", n];
   Print["end ", end];
   Print[end*chunksize];
   d = N[(3 + Sqrt[8])^n, pr + 10];
   d = Round[1/2 (d + 1/d)];
   {b, c, s} = {SetPrecision[-1, 1.1*n], -d, 0};
   iprec = Ceiling[pr/27];
   Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l;
        x = N[E^(Log[ll]/(ll)), iprec];

      (*N[Exp[Log[ll]/ll], pr/27]*)

        pc = iprec;
        While[pc < pr, pc = Min[3 pc, pr];
         x = SetPrecision[x, pc];
         y = x^ll - ll;
         x = x (1 - 2 y/((ll + 1) y + 2 ll ll));];

      (*N[Exp[Log[ll]/ll], pr]*)

       x, {l, 0, tsize - 1}], {j, 0, cores - 1}, 
       Method -> "EvaluationsPerKernel" -> 1]];
    ctab = Table[c = b - c;
      ll = start + l - 2;
      b *= 2 (ll + n) (ll - n)/((ll + 1) (2 ll + 1));
      c, {l, chunksize}];
    s += ctab.(xvals - 1);
    start += chunksize;
    Print["done iter ", k*chunksize, " ", SessionTime[] - T0];, {k, 0,
      end - 1}];
   N[-s/d, pr]];

t2 = Timing[MRBtest2 = expM[prec];];
N[MRBtest2 - MRB, 20]
Attachments:
POSTED BY: Marvin Ray Burns
Attachments:
POSTED BY: Marvin Ray Burns

I DECLARE VICTORY!

I computed 6,000,000 digits of the MRB constant, finishing on Tue 30 Mar 2021 22:02:49. The MRB constant supercomputer 2 said the following:

  Finished on Tue 30 Mar 2021 22:02:49. Processor and actual time were 5.28815859375*10^6 and 1.38935720536301*10^7 s. respectively

  Enter MRB1 to print 6029991 digits. The error from a 5,000,000 or more digit calculation that used a different method is  

  0.*10^-5024993

That means that the 5,000,000 digit computation was actually accurate to 5024993 decimals!!!

For the complete blow-by-blow see MRBSC2 6 million 1st fourth.nb.

Attachments:
POSTED BY: Marvin Ray Burns
POSTED BY: Marvin Ray Burns
Attachments:
POSTED BY: Marvin Ray Burns

Finished on Wed 16 Jan 2019 19:55:20, I computed over 4 million digits of the MRB constant!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!..... It took 65.13 days with a processor time of 25.17 days.On a 3.7 GH overclocked up to 4.7 GH on all cores Intel 6 core computer with 3000 MHz RAM.

See attached notebook.

Watch my reaction here.

Attachments:
POSTED BY: Marvin Ray Burns

nice system!

POSTED BY: l van Veen

The new sum is this.

Sum[(-1)^(k + 1)*(-1 + (1 + k)^(1/(1 + k)) - Log[1 + k]/(1 + k) - 
         Log[1 + k]^2/(2*(1 + k)^2)), {k, 0, Infinity}] 

That appears to be the same as for MRB except now we subtract two terms from the series expansion at the origin of k^(1/k). For each k these terms are Log[k]/k + 1/2*(Log[k]/k)^2. Accounting for the signs (-1)^k and summing, as I did earlier for just that first term, we get something recognizable.

Sum[(-1)^(k)*(Log[k]/(k) + Log[k]^2/(2*k^2)), {k, 1, Infinity}]

(* Out[21]= 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]) *)

So what does this buy us? For one thing, we get even better convergence from brute force summation, because now our largest terms are O((logk/k)^3) and alternating (which means if we sum in pairs it's actually O~(1/k^4) with O~ denoting the "soft-oh" wherein one drops polylogarithmic factors).

How helpful is this? Certainly it cannot hurt. But even with 1/k^4 size terms, it takes a long time to get even 40 digits, let alone thousands. So there is more going on in that Crandall approach.

POSTED BY: Daniel Lichtblau

Daniel Lichtblau and others, I just deciphered an Identity Crandall used for checking computations of the MRB constant just before he died. It is used in a previous post about checking, where I said it was hard to follow. The MRB constant is B here. B=`enter image description here In input form that is

   B= Sum[(-1)^(k + 1)*(-1 + (1 + k)^(1/(1 + k)) - Log[1 + k]/(1 + k) - 
         Log[1 + k]^2/(2*(1 + k)^2)), {k, 0, Infinity}] + 
     1/24 (\[Pi]^2 Log[2]^2 - 
        2 \[Pi]^2 Log[
          2] (EulerGamma + Log[2] - 12 Log[Glaisher] + Log[\[Pi]]) - 
        6 (Zeta^\[Prime]\[Prime])[2]) + 
     1/2 (2 EulerGamma Log[2] - Log[2]^2)

For 3000 digit numeric approximation, it is

B=NSum[((-1)^(
    k + 1) (-1 + (1 + k)^(1/(1 + k)) - Log[1 + k]/(1 + k) - 
      Log[1 + k]^2/(2 (1 + k)^2))), {k, 0, Infinity}, 
  Method -> "AlternatingSigns", WorkingPrecision -> 3000] + 
 1/24 (\[Pi]^2 Log[2]^2 - 
    2 \[Pi]^2 Log[
      2] (EulerGamma + Log[2] - 12 Log[Glaisher] + Log[\[Pi]]) - 
    6 (Zeta^\[Prime]\[Prime])[2]) + 
 1/2 (2 EulerGamma Log[2] - Log[2]^2)

It is anylitaclly straight forward too because

Sum[(-1)^(k + 1)*Log[1 + k]^2/(2 (1 + k)^2), {k, 0, Infinity}]

gives

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

That is enter image description here I wonder why he chose it?

POSTED BY: Marvin Ray Burns

The identity in question is straightforward. Write n^(1/n) as Exp[Log[n]/n], take a series expansion at 0, and subtract the first term from all summands. That means subtracting off Log[n]/n in each summand. This gives your left hand side. We know it must be M - the sum of the terms we subtracted off. Now add all of them up, accounting for signs.

Expand[Sum[(-1)^n*Log[n]/n, {n, 1, Infinity}]]

(* Out[74]= EulerGamma Log[2] - Log[2]^2/2 *)

So we recover the right hand side.

I have not understood whether this identity helps with Crandall's iteration. One advantage it confers, a good one in general, is that it converts a conditionally convergent alternating series into one that is absolutely convergent. From a numerical computation point of view this is always good.

POSTED BY: Daniel Lichtblau
POSTED BY: Marvin Ray Burns
POSTED BY: Marvin Ray Burns
POSTED BY: Marvin Ray Burns

Richard Crandall might of had some help in developing his method. He wrote one time:

"Marvin I am working on a highly efficient method for your constant, and I've been in touch with other mathematics scholars.

Please be patient...

rec

Sent from my iPhone."

POSTED BY: Marvin Ray Burns

Crandall is not using his eta formulas directly!!!!!!! He computes Sum[(-1)^k*(k^(1/k) - 1), {k, 1, Infinity}] directly!

Going back to Crandall's code:

(*Fastest (at RC's end) as of 30 Nov 2012.*)prec = 500000;(*Number of \
required decimals.*)ClearSystemCache[];
T0 = SessionTime[];
expM[pre_] := 
  Module[{a, d, s, k, bb, c, n, end, iprec, xvals, x, pc, cores = 4, 
    tsize = 2^7, chunksize, start = 1, ll, ctab, 
    pr = Floor[1.02 pre]}, chunksize = cores*tsize;
   n = Floor[1.32 pr];
   end = Ceiling[n/chunksize];
   Print["Iterations required: ", n];
   Print["end ", end];
   Print[end*chunksize];
   d = N[(3 + Sqrt[8])^n, pr + 10];
   d = Round[1/2 (d + 1/d)];
   {b, c, s} = {SetPrecision[-1, 1.1*n], -d, 0};
   iprec = Ceiling[pr/27];
   Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l;
        x = N[E^(Log[ll]/(ll)), iprec];
        pc = iprec;
        While[pc < pr, pc = Min[3 pc, pr];
         x = SetPrecision[x, pc];
         y = x^ll - ll;
         x = x (1 - 2 y/((ll + 1) y + 2 ll ll));];(*N[Exp[Log[ll]/ll],
        pr]*)x, {l, 0, tsize - 1}], {j, 0, cores - 1}, 
       Method -> "EvaluationsPerKernel" -> 1]];
    ctab = Table[c = b - c;
      ll = start + l - 2;
      b *= 2 (ll + n) (ll - n)/((ll + 1) (2 ll + 1));
      c, {l, chunksize}];
    s += ctab.(xvals - 1);
    start += chunksize;
    Print["done iter ", k*chunksize, " ", SessionTime[] - T0];, {k, 0,
      end - 1}];
   N[-s/d, pr]];

t2 = Timing[MRBtest2 = expM[prec];];
MRBtest2 - MRBtest3

x = N[E^(Log[ll]/(ll)), iprec]; Gives k^(1/k) to only 1 decimal place; they are either 1.0, 1.1, 1.2, 1.3 or 1.4 (usually 1.1 or 1.0).. On the other hand,

While[pc < pr, pc = Min[3 pc, pr];
 x = SetPrecision[x, pc];
 y = x^ll - ll;
 x = x (1 - 2 y/((ll + 1) y + 2 ll ll));],

takes the short precision x and gives it the necessary precision and accuracy for k^(1/k) (k Is ll there.) It actually computes k^(1/k). Then he remarks, "(N[Exp[Log[ll]/ll], pr])."

After finding a fast way to compute k^(1/k) to necessary precision he uses Cohen's algorithm 1 (See a screenshot in a previous post.) to accelerate convergence of Sum[(-1)^k*(k^(1/k) - 1), {k, 1, Infinity}]. That is his secret!!

As I mentioned in a previous post the "MRBtest2 - MRBtest3" is for checking with a known-to-be accurate approximation to the MRB constant, MRBtest3

I'm just excited that I figured it out! as you can tell.

POSTED BY: Marvin Ray Burns

Nice work. Worth a bit of excitement, I' d say.

POSTED BY: Daniel Lichtblau

Daniel Lichtblau and others, Richard Crandall did intend to explian his work on the MRB constant and his program to compute it. When I wrote him with a possible small improvement to his program he said, "It's worth observing when we write it up." See screenshot: enter image description here

POSTED BY: Marvin Ray Burns

I can't say I understand either. My guess is the Eta stuff comes from summing (-1)^k*(Log[k]/k)^n over k, as those are the terms that appear in the double sum you get from expanding k^(1/k)-1 in powers of Log[k]/k (use k^(1/k)=Exp[Log[k]/k] and the power series for Exp). Even if it does come from this the details remain elusive..

POSTED BY: Daniel Lichtblau
POSTED BY: Daniel Lichtblau

It is hard to be certain that c1 and c2 are correct to 77 digits even though they agree to that extent. I'm not saying that they are incorrect and presumably you have verified this. Just claiming that whatever methods NSum may be using to accelerate convergence, there is really no guarantee that they apply to this particular computation. So c1 aand c2 could agree to that many places because they are computed in a similar manner without all digits actually being correct.

POSTED BY: Daniel Lichtblau
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