The following might help anyone serious about breaking my record.

Richard Crandall wrote about couple of new formulae for computing the MRB constant faster on pp 28 and 29 here.

By the way, I wrote Crandall about formula (44) -- it seems it should have a minus sign in front of it -- and he wrote back:

Perhaps some of these speed records will be easier to beat.

The ultimate speed record to beat, though, is Ricahrd Crandall's (Chief cryptographer for Apple, 2012) 1,048,576 digits in a blistering fast 76.4 hours, while the Apple computation group(also in 2012) computed 1,000,000 digits of the MRB constant in a long 18 days 9 hours 11 minutes 34.253417 seconds, so progress vs time is not as linear as my results plotted above.

A missing post, that is commented on bellow, follows.

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

c2 = NSum[(2 k)^(1/(2 k)) - (2 k - 1)^(1/(2 k - 1)), {k, 1, Infinity},
WorkingPrecision -> 600, PrecisionGoal -> 600, NSumTerms -> 2^22];
c1 - c2

gives -6.6444030376101061743388604*10^-173 While, if you try it naively,

NSum[(-1)^n*(n^(1/n) - 1), {n, 1, \[Infinity]}, 
  Method -> "AlternatingSigns", WorkingPrecision -> 100, 
  PrecisionGoal -> 100] - 
 N[Sum[(2 k)^(1/(2 k)) - (2 k - 1)^(1/(2 k - 1)), {k, 
    1, \[Infinity]}], 100]

you get 8.65025879128817600921262272409653679780852599347660397129681915033728\ 91*10^-28, with only 28 digits of accuracy!

Attachments:

5 million digits.nb

For c1 I used a method for alternating series to get a very precise sum approximation: That is from the "AlternatingSigns" option.

Above where Cohen said,

the coefficients of the numerators are furthered below. I know the pattern for the first and last coefficient of each line, but can you figure out a simple pattern for the rest of them? My hat's off to you if you can!

2
16, 8
98, 80, 32
576, 544, 384, 128
3362, 3312, 2912, 1792, 512
19600, 19528, 18688, 15104, 8192, 2048
114242, 114144, 112576, 103168, 76288, 36864, 8192
665856, 665728, 663040, 641536, 557056, 376832, 163840, 32768
3880898, 3880736, 3876416, 3832064, 3603968, 2945024, 1826816, 720896, 131072 

Tue 24 Apr 2018

Here are some timings from version 11.3 and my first custom built computer with it's two separate processors:

[41]

Sat 28 Apr 2018

Chapter 3 in the paper at https://www.sciencedirect.com/science/article/pii/0898122189900242 , gives a 4th degree convergence rate algorithm for the nth root of x, which I used to add a new interior to my version of Crandall's MRB constant computation program, making it a hybrid. As the paper describes the algorithm, it is best used for getting many digits from a sufficiently precise initial term. (I used Crandall's 3rd degree convergence interior to get the sufficiently precise term.) This algorithm better optimizes my program for large calculations a little according to the following:

Here is a table of the results so far, which also show that RAM speed is the most important factor in a computer for computing the MRB constant!:

Here are a timing table with All MRB method, Crandall's method and a hybrid of the two on this 4 core ASUS Intel Core i7 7700 Desktop computer K31CD-DS71, 32 GB ram DDR4, 2TB SATA in Windows 10 Pro:

Here are the 3 programs referenced in the above table:

All MRB:

 Print["Start time is " "Start time is ", ds = DateString[], "."];
 prec = 10000;
 (**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.0002 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 = pr/2^6;
    Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l;
         x = N[E^(Log[ll]/(ll)), iprec];
         pc = iprec;


         While[pc < pr, pc = Min[4 pc, pr];
          x = SetPrecision[x, pc];
          xll = x^ll; z = (ll - xll)/xll;
          t = 2 ll - 1; t2 = t^2;
          x =    x*(1 + SetPrecision[4.5, pc] (ll - 1)/
                t2 + (ll + 1) z/(2 ll t) - 
              SetPrecision[13.5, 
                2 pc] ll (ll - 1)/ (3 ll t2 + t^3 z))];(**N[Exp[Log[
         ll]/ll],pr]**)


         x, {l, 0, tsize - 1}], {j, 0, cores - 1}, 
        Method -> 
         "EvaluationsPerKernel" -> 
          16(*a power of 2 commensurate with available RAM*)]];
     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 -> 
        "EvaluationsPerKernel" -> 
         16(*a power of 2 commensurate with processor strength*)];
     s += ctab.(xvals - 1);
     start += chunksize;
     st = SessionTime[] - T0; kc = k*chunksize;
     ti = (st)/(kc + 10^-10)*(n)/(3600)/(24);
     If[kc > 1, 
      Print[kc, " iterations done in ", N[st - stt, 4], " seconds.", 
       " Should take ", N[ti, 4], " days or ", ti*3600*24, 
       "s, finish ", DatePlus[ds, ti], "."], 
      Print["Denominator computed in  " , stt = st, "s."]];, {k, 0, 
      end - 1}];
    N[-s/d, pr]];
 t2 = Timing[MRBtest2 = expM[prec];]; Print["Finished on ", 
  DateString[], ". Processor and total time were ", 
  t2[[1]], " and ", st, " s respectively."];
 (*Print[*)MRBtest2(*]*)(*Remove (**) or enter MRBtest2 to print \
 output*); Print["Enter MRBtest2 to print ", 
  Floor[Precision[
    MRBtest2]], " digits"]; Print["If you saved m3M, the difference \
 between this and 3,014,991 known digits is ", N[MRBtest2 - m3M, 10]]

Crandall

Print["Start time is ", ds = DateString[], "."];
prec = 100000;
(**Number of required decimals.*.*)ClearSystemCache[];
T0 = SessionTime[];
expM[pre_] := 
  Module[{a, d, s, k, bb, c, end, iprec, xvals, x, pc, cores = 32(*=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/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" -> 
         64(*a power of 2 commensurate with processor strength*)]];
    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 -> 
       "EvaluationsPerKernel" -> 
        16(*a power of 2 commensurate with processor strength*)];
    s += ctab.(xvals - 1);
    start += chunksize;
    st = SessionTime[] - T0; kc = k*chunksize;
    ti = (st)/(kc + 10^-4)*(n)/(3600)/(24);
    If[kc > 1, 
     Print[kc, " iterations done in ", N[st, 3], " seconds.", 
      " Should take ", N[ti, 2], " days or ", N[ti*24*3600, 2], 
      "s, finish ", DatePlus[ds, ti], "."]];, {k, 0, end - 1}];
   N[-s/d, pr]];
t2 = Timing[MRBtest2 = expM[prec];]; Print["Finished on ", 
 DateString[], ". Processor time was ", 
 t2[[1]], " s. Actual time was ", SessionTime[] - T0, "."];
(*Print[*)MRBtest2(*]*)(*Remove (**) or enter MRBtest2 to print \
output*); Print["Enter MRBtest2 to print ", 
 Floor[Precision[
   MRBtest2]], " digits"]; Print["If you saved m3M, the difference \
between this and 3,014,991 known digits is ", N[MRBtest2 - m3M, 10]]

Hybrid

Print["Start time is ", ds = DateString[], "."];
prec = 300000;
(**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/27];
   Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l;
        x = N[E^(Log[ll]/(ll)), iprec];
        pc = iprec;
        While[pc < pr/4, pc = Min[3 pc, pr/4];
         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/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}, 
       Method -> 
        "EvaluationsPerKernel" -> 
         32(*a power of 2 commensurate with available RAM*)]];
    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 -> 
       "EvaluationsPerKernel" -> 
        16(*a power of 2 commensurate with processor strength*)];
    s += ctab.(xvals - 1);
    start += chunksize;
    st = SessionTime[] - T0; kc = k*chunksize;
    ti = (st)/(kc + 10^-4)*(n)/(3600)/(24);
    If[kc > 1, 
     Print[kc, " iterations done in ", N[st, 4], " seconds.", 
      " Should take ", N[ti, 4], " days or ", N[ti*24*3600, 4], 
      "s, finish ", DatePlus[ds, ti], "."]];, {k, 0, end - 1}];
   N[-s/d, pr]];
t2 = Timing[MRBtest2 = expM[prec];]; Print["Finished on ", 
 DateString[], ". Proccessor time was ", t2[[1]], " s."];
(*Print[*)MRBtest2(*]*)(*Remove (**) or enter MRBtest2 to print \
output*); Print["Enter MRBtest2 to print ", 
 Floor[Precision[
   MRBtest2]], " digits"]; Print["If you saved m3M, the difference \
between this and 3,014,991 known digits is ", N[MRBtest2 - m3M, 10]]

Aug 8 2018

I've been having great success with the Wolfram Lightweight Grid and "threadpriority," like in the following:

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

 Out[24]= {"KernelObject"[43, "burns"], "KernelObject"[44, "burns"], 
  "KernelObject"[45, "burns"], "KernelObject"[46, "burns"], 
  "KernelObject"[47, "burns"], "KernelObject"[48, "burns"], 
  "KernelObject"[49, "burns"], "KernelObject"[50, "burns"], 
  "KernelObject"[51, "local"], "KernelObject"[52, "local"], 
  "KernelObject"[53, "local"], "KernelObject"[54, "local"], 
  "KernelObject"[55, "local"], "KernelObject"[56, "local"]}

.

I just now computed 1,004,754 digits of the MRB constant in 58 hours of absolute time!

I think that worked because my computer with the local kernels is the faster one.

See attached "58 hour million."

Aug 9, 2018, I just now computed 1,004,993 digits of the MRB constant in 53.5 hours of absolute time! Summarized below.

Print["Start time is ", ds = DateString[], "."];
prec = 1000000;
(**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/6912];
   Do[xvals = Flatten[Parallelize[Table[Table[ll = start + j*tsize + l;
         x = N[E^(Log[ll]/(ll)), iprec];


         pc = iprec;
         While[pc < pr/1024, pc = Min[3 pc, pr/1024];
          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/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);
    Print[kc, " iterations done in ", N[st, 4], " seconds.", 
     " Should take ", N[ti, 4], " days or ", N[ti*24*3600, 4], 
     "s, finish ", DatePlus[ds, ti], "."], {k, 0, end - 1}];
   N[-s/d, pr]];
t2 = Timing[MRBtest2 = expM[prec];]; Print["Finished on ", 
 DateString[], ". Proccessor time was ", 
 t2[[1]], " s."]; Print["Actual time was ", st];
(*Print[*)MRBtest2(*]*)(*Remove (**) or enter MRBtest2 to print \
output*); Print["Enter MRBtest2 to print ", 
 Floor[Precision[
   MRBtest2]], " digits"]; Print["If you saved m3M, the difference \
between this and 3,014,991 known digits is ", N[MRBtest2 - m3M, 10]]

Start time is Wed 8 Aug 2018 14:09:15.

Iterations required: 1326598

Will give 648 time estimates, each more accurate than the previous.

Will stop at 1327104 iterations to ensure precsion of around 1004999 decimal places.

0 iterations done in 259.9 seconds. Should take 3.991*10^7 days or 3.448*10^12s, finish Fri 24 Dec 111294 02:34:55.

2048 iterations done in 523.6 seconds. Should take 3.926 days or 3.392*10^5s, finish Sun 12 Aug 2018 12:22:00.

4096 iterations done in 790.2 seconds. Should take 2.962 days or 2.559*10^5s, finish Sat 11 Aug 2018 13:14:46.

6144 iterations done in 1058. seconds. Should take 2.645 days or 2.285*10^5s, finish Sat 11 Aug 2018 05:38:01.

8192 iterations done in 1329. seconds. Should take 2.490 days or 2.152*10^5s, finish Sat 11 Aug 2018 01:55:27.

10240 iterations done in 1602. seconds. Should take 2.402 days or 2.075*10^5s, finish Fri 10 Aug 2018 23:47:32.

12288 iterations done in 1875. seconds. Should take 2.343 days or 2.024*10^5s, finish Fri 10 Aug 2018 22:22:49.

14336 iterations done in 2151. seconds. Should take 2.304 days or 1.990*10^5s, finish Fri 10 Aug 2018 21:26:34.

16384 iterations done in 2424. seconds. Should take 2.272 days or 1.963*10^5s, finish Fri 10 Aug 2018 20:41:04.

18432 iterations done in 2700. seconds. Should take 2.250 days or 1.944*10^5s, finish Fri 10 Aug 2018 20:08:36.

20480 iterations done in 2977. seconds. Should take 2.232 days or 1.928*10^5s, finish Fri 10 Aug 2018 19:42:40.

22528 iterations done in 3256. seconds. Should take 2.219 days or 1.917*10^5s, finish Fri 10 Aug 2018 19:24:31.

24576 iterations done in 3533. seconds. Should take 2.207 days or 1.907*10^5s, finish Fri 10 Aug 2018 19:07:43.

26624 iterations done in 3811. seconds. Should take 2.198 days or 1.899*10^5s, finish Fri 10 Aug 2018 18:53:53.
 ...


1320960 iterations done in 1.921*10^5 seconds. Should take 2.232 days or 1.929*10^5s, finish Fri 10 Aug 2018 19:43:46.

1323008 iterations done in 1.923*10^5 seconds. Should take 2.232 days or 1.929*10^5s, finish Fri 10 Aug 2018 19:43:28.

1325056 iterations done in 1.926*10^5 seconds. Should take 2.232 days or 1.928*10^5s, finish Fri 10 Aug 2018 19:43:08.

Finished on Fri 10 Aug 2018 19:39:26. Proccessor time was 122579. s.

Actual time was 192609.7247443

Enter MRBtest2 to print 1004992 digits

If you saved m3M, the difference between this and 3,014,991 known digits is 0.*10^-1004993

Sept 21, 2018, I just now computed 1,004,993 digits of the MRB constant in 50.37 hours of absolute time (35.4 hours processor time)! See attached "50 hour million."

Here is a table of my speed progress in computing the MRB constant since 2012:

See attached "kernel priority 2 computers.nb" and "3 fastest computers together.nb" for some documentation of the timings in the last 2 columns, respectively. See "3million 2 computers" for the estimated time of 24 days for computing 3,000,000 digits.

01/08/2019

Here is an update of 100k digits (in seconds): Notice, I broke the 1,000 second mark!!!!!

Attachments:

3 fastest comput...nb

3million 2 computers.nb

50 hour million.nb

58 hour million.nb

kernel priority ...nb

Daniel Lichtblau,
Which one do you not understand? how he derived the eta' formula: from ?

Or is it how and why he added the extra loop to Cohen's method:`

ll = start + l - 2; b *= 2 (ll + n) (ll - n)/((ll + 1) (2 ll + 1)); ?`

I've been asking for a proof of the eta formula derivation. I think it could become the foundation to a great paper.

If the extra loop changes Cohen's method for to a method for I think the code in that loop could help prove the derivation.

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:

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

The result of k^(1/k) from the iteration in Crandall's code grows like the following example of 123^(1/123)..

Timing[ll = 123; x = 1 + 1/10; 
 Table[Block[{$MaxExtraPrecision = Infinity}, 
   x = SetPrecision[x, 20 + a^6]; y = x^ll - ll; 
   x = x (1 - 2 y/((ll + 1) y + 2 ll ll)); 
   N[ll^(1/ll) - x, a + 20]], {a, 1, 13}]]

That gives the following timing and accuracies per iteration.

  {8.829657, {-0.04239426367665370783, -0.02519017014329854597401, \
  -0.0097174389047505410455275, -0.000933400633967433388167272, \
  -9.456045144810702667437515*10^-7, \
  -9.8570302819631224677862339*10^-16, \
  -1.11649387558952636447488240*10^-42, \
  -1.622508976729293063326569833*10^-123, \
  -4.9794273187141078980478269830*10^-366, \
  -1.43931637321260733551982880202*10^-1093, \
  -3.476056847637409626605825363818*10^-3276, \
  -4.8964202322309104109089811118496*10^-9824, \
  -1.36852937628135955635109182098985*10^-29467}}

Here is a more extreme example from my big computer where we get about 64,000,000 digits of accuracy of 123^(1/123) in only 20 iterations!

In[47]:= Timing[ll = 123; x = 1 + 1/10;
 Table[Block[{$MaxExtraPrecision = Infinity}, 
   x = SetPrecision[x, 20 + a^6]; y = x^ll - ll;
   x = x (1 - 2 y/((ll + 1) y + 2 ll ll));
   N[ll^(1/ll) - x, a + 20]], {a, 1, 20}]]

Out[47]= {210.180147, {-0.04239426367665370783, \
-0.02519017014329854597401, -0.0097174389047505410455275, \
-0.000933400633967433388167272, -9.456045144810702667437515*10^-7, \
-9.8570302819631224677862339*10^-16, \
-1.11649387558952636447488240*10^-42, \
-1.622508976729293063326569833*10^-123, \
-4.9794273187141078980478269830*10^-366, \
-1.43931637321260733551982880202*10^-1093, \
-3.476056847637409626605825363818*10^-3276, \
-4.8964202322309104109089811118496*10^-9824, \
-1.36852937628135955635109182098985*10^-29467, \
-2.987998984519890677800153644718129*10^-88398, \
-3.1099929855547029560727524646233719*10^-265190, \
-3.50668133180579791324881778853196092*10^-795566, \
-5.026977910888395698424738167604170974*10^-2386694, \
-1.4809452514436132712292881458571004047*10^-7160077, \
-3.78647491015226246115034702337662410645*10^-21480228, 
  0.*10^-64000020}}

Furthermore this process can compute 6,379,358,787 digits of the Sqrt[2], from an initial guess of machine precision, in 18 iterations:

In[90]:= Timing[ll = 2; x = 2.^(1/2);
 Table[Block[{$MaxExtraPrecision = Infinity}, 
   x = SetPrecision[x, 20 + a^7.5]; y = x^ll - ll;
   x = x (1 - 2 y/((ll + 1) y + 2 ll ll));
   N[ll^(1/ll) - x, a + 20]], {a, 1, 18}]]

Out[90]= {1913.882668, {0.*10^-21, -1.800462644283455490473*10^-148, \
-7.2956225729359623776786*10^-445, \
-4.85397000370369097837099*10^-1334, \
-1.429556345255675471801415*10^-4001, \
-3.6518576944392011682818847*10^-12004, \
-6.08767627470915271802076570*10^-36012, \
-2.820100999650988078782491560*10^-108035, \
-2.8035222068968058313783728204*10^-324105, \
-2.75436831997714080172674040062*10^-972315, \
-2.612017346393607427831858236332*10^-2916945, \
-2.2276049962448401256762035120120*10^-8750835, \
-1.38173437723345455709717486529180*10^-26252505, \
-3.297491628267321222864512567028780*10^-78757516, \
-4.4818892212256882776648121052875660*10^-236272548, \
-1.12536490316593766234907240580868063*10^-708817643, 
  0.*10^-1073741813, 0.*10^-1073741813}}

The above pattern is 3 times the previous number of accurate digits per iteration.. `708817643 * 3^2= 6379358787`

I believe it will only take 191+16 = 207 iterations to compute a google digits of the Sqrt[2]:

In[55]:= Log[10.^100/708817643]/Log[3]

Out[55]= 191.04

Talking about the eta formula for the MRB constant

Here is another great improvement in calculating digits of MRB though this first Crandall eta formula found in the psu.edu paper Unified algorithms for polylogarithm, L-series, and zeta variants

From an even earlier message that starts with "How about computing the MRB constant from Crandall's eta derivative formulas?" here are my first two sets of records to compare with the just mentioned ones. You can see that I increased time efficiency by 10 to 29 to even 72 fold for select computations! In the tests used in that "previous message," 4000 or more digit computations produced a seemingly indefinitely long hang-on.

Until mentioned otherwise, the following tables are results from my 3.4 GHz Xeon with 64 GB 1666 MHz RAM.

Digits      Seconds

500        36.831836
1000       717.308198
1500       2989.759165
2000       3752.354453


Digits        Seconds
 500          9.874863
 1000        62.587601
 1500        219.41540
 2000       1008.842867
 2500       2659.208646
 3000       5552.902395
 3500       10233.821601

Comparing first of the just mentioned 2000 digit computations with the "significant improvement" one, we get the following.

3752/127 ~=29.

And from the slowest to the fastest 1500 digit run we get

2989/42 ~=72,

Here is an example calculating 1500 digits in less than 23 seconds. First calculate known accurate digits:

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

Then use this program:

prec = 1500;
to = SessionTime[];
etaMM[m_, pr_] := 
  Module[{a, s, k, b, c}, a[j_] := (Log[j + 1]/(j + 1))^m;
   {b, c, s} = {-1, -d, 0};
   Do[c = b - c;
    s = s + c a[k];
    b = (k + n) (k - n) b/((k + 1) (k + 1/2)), {k, 0, n - 1}];
   Return[N[s/d, pr] (-1)^m]];
eta1 = N[EulerGamma Log[2] - Log[2]^2/2, prec]; n = 
 Floor[132/100 prec]; d = N[ChebyshevT[n, 3], prec];
MRBtest = 
  eta1 - ParallelSum[(Cos[Pi m]) etaMM[m, prec]/
      N[Gamma[m + 1], prec], {m, 2, Floor[.365 prec]}];
Print[mTrue - MRBtest]; SessionTime[] - to

The larger prec (precission) you want to choose, the smaller number you can replace .365 with in
ParallelSum[(Cos[Pi m]) etaMM[m, prec]/N[Gamma[m + 1], prec], {m, 2, Floor[.365 prec]}. For prec=5000, change .365 to .31 (approximately). This advantage for smaller upper limits being needed in the sum is due to the Gamma (!) in the denominator. On my big computer 4000 digits now gives a timing of around 1800 seconds (1/2 an hour). See message above the previous occurrence of 8/13/2017 for previous records and records before those.

V 11 has a significant improvement in my new most recently mentioned fastest program for calculating digits of the MRB constant via the eta formula, Here are some timings:

Digits           seconds

1500                42.6386632

2000             127.3101969

3000             530.4442911

4000           1860.1966540

5000           3875.6978162

6000           8596.9347275

10,000        53667.6315476

UPDATE 5/30/2018

I made some programming improvements to my code for the eta formula computation of the MRB constant.

Here is the new code:

In[88]:= mTrue = 
  NSum[(-1)^n (n^(1/n) - 1), {n, 1, Infinity}, 
   Method -> "AlternatingSigns", WorkingPrecision -> 5000];

In[82]:= prec = 1500;
to = SessionTime[];
etaMM[m_, pr_] := 
  Block[{a, s, k, b, c}, 
   a[j_] := (SetPrecision[Log[j + 1], prec]/(j + 1))^m;
   {b, c, s} = {-1, -d, 0};
   Do[c = b - c;
    s = s + c a[k];
    b = (k + n) (k - n) b/((k + 1) (k + 1/2)), {k, 0, n - 1}];
   Return[N[s/d, pr] (-1)^m]];
eta1 = N[EulerGamma Log[2] - Log[2]^2/2, prec]; n = 
 Floor[132/100 prec]; d = N[ChebyshevT[n, 3], prec];
MRBtest = 
  eta1 - ParallelSum[(Cos[Pi m]) etaMM[m, prec]/
      N[Gamma[m + 1], prec], {m, 2, Floor[.365 prec]}];
Print[mTrue - MRBtest]; SessionTime[] - to

During evaluation of In[82]:= 0.*10^-1500

Out[87]= 15.4875433

Here is a comparison of my eta formula speed records:

Here is the code for 10,000 digits:

prec = 10000;
to = SessionTime[];
etaMM[m_, pr_] := 
  Block[{a, s, k, b, c}, 
   a[j_] := (SetPrecision[Log[j + 1], prec]/(j + 1))^m;
   {b, c, s} = {-1, -d, 0};
   Do[c = b - c;
    s = s + c a[k];
    b = (k + n) (k - n) b/((k + 1) (k + 1/2)), {k, 0, n - 1}];
   Return[N[s/d, pr] (-1)^m]];
eta1 = N[EulerGamma Log[2] - Log[2]^2/2, prec]; n = 
 Floor[132/100 prec]; d = N[ChebyshevT[n, 3], prec];
MRBtest = 
  eta1 - ParallelSum[(Cos[Pi m]) etaMM[m, prec]/
      N[Gamma[m + 1], prec], {m, 2, Floor[.295 prec]}];
Print[mTrue - MRBtest]; SessionTime[] - to

0.*10^-9999

20621.99102

I tried a little something I got from the Mathematica documentation center. It speed the calculations up just a little more. My newest sample code as of 5/31/2018:

prec = 1500;
to = SessionTime[];
etaMM[m_, pr_] := 
  Block[{a, s, k, b, c}, 
   a[j_] := (SetPrecision[Log[j + 1], prec]/(j + 1))^m;
   {b, c, s} = {-1, -d, 0};
   Do[c = b - c;
    s = s + c a[k];
    b = (k + n) (k - n) b/((k + 1) (k + 1/2)), {k, 0, n - 1}];
   Return[N[s/d, pr] (-1)^m]];
eta1 = N[EulerGamma Log[2] - Log[2]^2/2, prec]; n = 
 Floor[132/100 prec]; d = N[ChebyshevT[n, 3], prec];
MRBtest = 
  eta1 - ParallelSum[(Cos[Pi m]) etaMM[m, prec]/
      N[Gamma[m + 1], prec], {m, 2, Floor[.365 prec]}, 
    Method -> "CoarsestGrained"];
Print[mTrue - MRBtest]; SessionTime[] - to

That leads to the following table.

See attached "eta may 31 2018.nb" for the work.

May 31 2018 | 9:00PM EST

I tried this form using the ParallelCombine command:

prec = 1500;
to = SessionTime[];
etaMM[m_, pr_] := 
  Block[{a, s, k, b, c}, 
   a[j_] := (SetPrecision[Log[j + 1], prec]/(j + 1))^m;
   {b, c, s} = {-1, -d, 0};
   Do[c = b - c;
    s = s + c a[k];
    b = (k + n) (k - n) b/((k + 1) (k + 1/2)), {k, 0, n - 1}];
   Return[N[s/d, pr] (-1)^m]];
eta1 = N[EulerGamma Log[2] - Log[2]^2/2, prec]; n = 
 Floor[132/100 prec]; d = N[ChebyshevT[n, 3], prec];
MRBtest = eta1 -
   Total[ParallelCombine[((Cos[Pi #]) etaMM[#, prec]/
         N[Gamma[# + 1], prec]) &, Range[2, Floor[.365 prec]], 
     Method -> "CoarsestGrained"]];
Print[mTrue - MRBtest];

SessionTime[] - to

, which lead to this remarkable set of results from my fast 4 core machine with 2400 MHz DDR4 RAM:

The code and computations from Crandall's original code and my first improvement of it can be found by searching for the post above that begins with

"How about computing the MRB constant from Crandall's eta derivative formulas?"

See eta may 31 2018.nb attachment for more work.

UPDATE 2:51PM, June 1, 2018

**Last night at about 9:30PM EST, I started a 20,000 digit calculation of the digits of the MRB constant via eta derivatives using the "Combine" method.

UPDATE

The 20,000 digits finished at Fri 1 Jun 2018 21:11:49 -- it took 83728.3439962 sec -- see attached 20 k eta style.nb .

That timing of 83728.3439962 sec for 20,000 digits fits perfectly with a pattern compared of previous timings. approx 5000 digits took 548sec. 10000 digits took 6806sec.

6806sec(6806sec/548sec) = 84528.532* sec.

That surprises me because my choice in the multiple of prec, as in Floor[.365 prec] for prec=20000 was only a guess. (I used 0.285.) which means the program took 5700 iterations. (It got 3.5 digits per iteration.) My plan was to always use the minimum number of iterations to get a desired number of digits.

As I wrote above:

The larger prec (precission) you want to choose, the smaller number you can replace .365 with in ParallelSum[(Cos[Pi m]) etaMM[m, prec]/N[Gamma[m + 1], prec], {m, 2, Floor[.365 prec]}. For prec=5000, change .365 to .31 (approximately). This advantage for smaller upper limits being needed in the sum is due to the Gamma (!) in the denominator. On my big computer 4000 digits now gives a timing of around 1800 seconds (1/2 an hour). See message above the previous occurrence of 8/13/2017 for previous records and records before those.

I posted some about 12 kernels:

I hoped to produce some extra success by lying to Kernel Configuration as follows:

Which did lead to the following, great results:

Here is a sample:

prec = 10000;
to = SessionTime[];
etaMM[m_, pr_] := 
  Block[{a, s, k, b, c}, 
   a[j_] := (SetPrecision[Log[j + 1], prec]/(j + 1))^m;
   {b, c, s} = {-1, -d, 0};
   Do[c = b - c;
    s = s + c a[k];
    b = (k + n) (k - n) b/((k + 1) (k + 1/2)), {k, 0, n - 1}];
   Return[N[s/d, pr] (-1)^m]];
eta1 = N[EulerGamma Log[2] - Log[2]^2/2, prec]; n = 
 Floor[132/100 prec]; d = N[ChebyshevT[n, 3], prec];
MRBtest = 
  eta1 - Total[
    ParallelCombine[((Cos[Pi #]) etaMM[#, prec]/
         N[Gamma[# + 1], prec]) &, Range[2, Floor[.295 prec]], 
     Method -> "CoarsestGrained"]];
Print[mTrue - MRBtest];

SessionTime[] - to

During evaluation of In[52]:= 0.*10^-10000

Out[58]= 3413.3092082

See attached 16 socalled cores.nb.

There is an example of the results for using more and more kernels on my 8 duel core Zeon: -- in attached "more and more kernels effect.nb ."

I would be absolutely delighted if anyone with a larger kernel limit license could run it and show us what your results are!!!

Here is a sample of using more and more kernels on my 8 duel core Zeon:

 Quit[];
mTrue =  0.18785964246206712024851793405427323005590309490013878617200468408947\
7231564660213703296654433107496903842345856258019061231370094759226630\
4389293488961841208373366260816136027381263793734352832125527639621714\
8932170207628206217151671540841268044836354167199851976802527598938993\
9144579835055613509648521071207844423095868129497688526949564204255586\
4836704410425279524710606660926339748341031157816786416689154600342222\
5883800254553968929471142122189105098328712277308020036445215390536395\
0553322034706275511598128280395102192649146731762935161906598160186642\
4582495069720338199295842093551516251439935760076459329128145170908242\
4915883204169066409334435914806705564692806787007028115009380606938139\
3859533606579874055620623487043293607378195646031047639506648930613606\
4552806751519350828083737671929686639810309494963749627738304984632456\
3479311575300289212523291816195626973697074865765476071178017195787368\
3009659022606687536563055165673612881502014387561366865522106743053705\
9103973575619148909369077798320355119336240463725349410542836369971702\
4418551654837279358822008134480961058802030647819619596953756287834812\
3349763858630101407272529230147233333625091858402480370404888196767676\
0119858111679169352796852044160027086137228688945101510291998853690572\
8659287086875425492533794395347589703563313440382638887986656195980733\
5147399025657781331722610761279758527227427773089857749223059709625725\
6271883675575297887925361687673940354321451362772549229313126276435732\
1446216187786377154205423128223446295396532903322171479820280759842210\
6556489004853685870708326887487737763504768916098318553628166715910841\
2193420164386000258508426556435006954832830120546193205155935040023508\
3512613359217408970073297842771289673651619602250771173880842623256978\
8546537869046222708567487474709306935732666859085616282375386551243297\
5647464914619179575869342996208149878536663170197264534260468378010759\
0551486787190395783150604524441907570445113820585333984692194828794764\
8657593178595816527492977822095977440911371434216929624593175324537340\
1299593995004917912983680848547143925846704238528608320053664510586678\
1511964596760791964317343076715344983004971288694016566004270621110790\
5316472150455632994388400521115239016877311545696102836920503689610880\
6031603660382896533239383524154510137534165673472607464891120088099838\
1520466954150263770355732835929966306427173051589721163519991611359546\
7031540872528724399819787250274679738863889705686743537785798105855619\
2492185716949135673462704077491448799682065482817465880642236348160780\
9507770579393134958298066028252721284916888092303252902700599177550596\
1583591999319086939303973661164651485821997292533710676873868623504791\
5879737968269847878082223410618789674667450680064404065553875213281494\
9807002098581322206201090112659034497174108010632475647128346095492843\
7006514745021822612041564393030885982642625682812609249113673396723593\
3714534216902560140050169469983875907342920361729301531400405936246406\
78140077947561307736973240992352946479458077816460769624086460;
Quiet[Table[LaunchKernels[1]; prec = 3000;
  to = SessionTime[];
  etaMM[m_, pr_] := 
   Block[{a, s, k, b, c}, 
    a[j_] := (SetPrecision[Log[j + 1], prec]/(j + 1))^m;
    {b, c, s} = {-1, -d, 0};
    Do[c = b - c;
     s = s + c a[k];
     b = (k + n) (k - n) b/((k + 1) (k + 1/2)), {k, 0, n - 1}];
    Return[N[s/d, pr] (-1)^m]];
  eta1 = N[EulerGamma Log[2] - Log[2]^2/2, prec]; 
  n = Floor[132/100 prec]; d = N[ChebyshevT[n, 3], prec];
  MRBtest = 
   eta1 - Total[
     ParallelCombine[((Cos[Pi #]) etaMM[#, prec]/
          N[Gamma[# + 1], prec]) &, Range[2, Floor[.365 prec]], 
      Method -> "CoarsestGrained"]];
  Print["Error was ", mTrue - MRBtest, ", using"];

  Print[xx, "  kernels, and gave a time of ", SessionTime[] - to, 
   " s."], {xx, 1, 16}]]

  Error was 0.*10^-3000, using

1  kernels, and gave a time of 477.9303673 s.

Error was 0.*10^-3000, using

2  kernels, and gave a time of 257.3167709 s.

Error was 0.*10^-3000, using

3  kernels, and gave a time of 181.8228406 s.

Error was 0.*10^-3000, using

4  kernels, and gave a time of 147.4913411 s.

Error was 0.*10^-3000, using

5  kernels, and gave a time of 118.8902094 s.

Error was 0.*10^-3000, using

6  kernels, and gave a time of 103.5240060 s.

Error was 0.*10^-3000, using

7  kernels, and gave a time of 92.3546592 s.

Error was 0.*10^-3000, using

8  kernels, and gave a time of 85.5143638 s.

Error was 0.*10^-3000, using

9  kernels, and gave a time of 75.6869920 s.

Error was 0.*10^-3000, using

10  kernels, and gave a time of 72.1320176 s.

Error was 0.*10^-3000, using

11  kernels, and gave a time of 68.4291460 s.

Error was 0.*10^-3000, using

12  kernels, and gave a time of 62.7524163 s.

Error was 0.*10^-3000, using

13  kernels, and gave a time of 63.8671114 s.

Error was 0.*10^-3000, using

14  kernels, and gave a time of 61.3992399 s.

Error was 0.*10^-3000, using

15  kernels, and gave a time of 61.0743278 s.

Error was 0.*10^-3000, using

16  kernels, and gave a time of 60.1936369 s.

I just updated the attachment, "more and more kernels effect.nb ."

UPDATE July 29, 2018

Here are some new stats:

12/31/2018

Ending this year, I subscribed to a cloud service and used a 48 core Xeon Platinum server to compare with my old 8 core Xeon that I sold, and got the following results for MRB constant computations using only Crandall's eta formula.

Here is the code used on that Intel Xeon Platinum 48 core computer, for 10,000 digits in less than 1426 seconds:

prec = 10000;
to = SessionTime[];
etaMM[m_, pr_] := 
  Block[{a, s, k, b, c}, 
   a[j_] := (SetPrecision[Log[j + 1], prec]/(j + 1))^m;
   {b, c, s} = {-1, -d, 0};
   Do[c = b - c;
    s = s + c a[k];
    b = (k + n) (k - n) b/((k + 1) (k + 1/2)), {k, 0, n - 1}];
   Return[N[s/d, pr] (-1)^m]];
eta1 = N[EulerGamma Log[2] - Log[2]^2/2, prec]; n = 
 Floor[132/100 prec]; d = N[ChebyshevT[n, 3], prec];
MRBtest = 
  eta1 - Total[
    ParallelCombine[((Cos[Pi #]) etaMM[#, prec]/
         N[Gamma[# + 1], prec]) &, Range[2, Floor[.298 prec]], 
     Method -> "CoarsestGrained"]];
Export["accuracy.dat",mTrue - MRBtest];

Export["time.dat",SessionTime[] - to]

3/27/2019

I ran an improved version of the above code (Cradall first eta formula) for 10,000 digits of MRB using 48 Mma kernels on 1 node (24 cores) of IU's Carbonate supercomputer.

configuration:

code:

Iprec = 10000;
to = SessionTime[];
etaMM[m_, pr_] := 
  Module[{a, s, k, b, c}, 
   a[j_] := (SetPrecision[Log[j + 1], prec]/(j + 1))^m;
   {b, c, s} = {-1, -d, 0};
   Do[c = b - c;
    s = s + c a[k];
    b = (k + n) (k - n) b/((k + 1) (k + 1/2)), {k, 0, n - 1}];
   Return[N[s/d, pr] (-1)^m]];
eta1 = N[EulerGamma Log[2] - Log[2]^2/2, prec]; n = 
 Floor[132/100 prec]; d = N[ChebyshevT[n, 3], prec];
MRBtest = 
  eta1 - Total[
    ParallelCombine[((Cos[Pi #]) etaMM[#, prec]/
         N[Gamma[# + 1], prec]) &, Range[2, Floor[.295 prec]], 
     Method -> "CoarsestGrained"]];
Print[N[MRBtest2 - MRBtest, 10]];

SessionTime[] - to

output:

 0.*10^-10000

 1333.552401

That 1333 seconds is a new speed record for 10,000 digits via eta derivatives!

Attachments:

16 socalled cores.nb

20 k eta style.nb

eta all cores as...nb

eta may 31 2018.nb

more and more ke...nb

4/22/2019

Let $$M=\sum _{n=1}^{\infty } \frac{(-1)^{n+1} \eta ^n(n)}{n!}=\sum _{n=1}^{\infty } (-1)^n \left(n^{1/n}-1\right).$$ Then using what I learned about the absolute convergence of $\sum _{n=1}^{\infty } \frac{(-1)^{n+1} \eta ^n(n)}{n!}$ from https://math.stackexchange.com/questions/1673886/is-there-a-more-rigorous-way-to-show-these-two-sums-are-exactly-equal, combined with an identity from Richard Crandall: , Also using what Mathematica says:

$$\sum _{n=1}^1 \frac{\underset{m\to 1}{\text{lim}} \eta ^n(m)}{n!}=\gamma (2 \log )-\frac{2 \log ^2}{2},$$

I figured out that

$$\sum _{n=2}^{\infty } \frac{(-1)^{n+1} \eta ^n(n)}{n!}=\sum _{n=1}^{\infty } (-1)^n \left(n^{1/n}-\frac{\log (n)}{n}-1\right).$$

So I made the following major breakthrough in computing MRB from Candall's first eta formula. See attached 100 k eta 4 22 2019. Also shown below.

The time grows 10,000 times slower than the previous method!

I broke a new record, 100,000 digits: Processor and total time were 806.5 and 2606.7281972 s respectively.. See attached 2nd 100 k eta 4 22 2019.

Here is the work from 100,000 digits.

Print["Start time is ", ds = DateString[], "."];
prec = 100000;
(**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/27];
   Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l;
        x = N[E^(Log[ll]/(ll)), iprec];
        pc = iprec;
        While[pc < pr/4, pc = Min[3 pc, pr/4];
         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/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}, Method -> "EvaluationsPerKernel" -> 32]];
    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 -> "EvaluationsPerKernel" -> 16];
    s += ctab.(xvals - 1);
    start += chunksize;
    st = SessionTime[] - T0; kc = k*chunksize;
    ti = (st)/(kc + 10^-4)*(n)/(3600)/(24);
    If[kc > 1, 
     Print[kc, " iterations done in ", N[st, 4], " seconds.", 
      " Should take ", N[ti, 4], " days or ", N[ti*24*3600, 4], 
      "s, finish ", DatePlus[ds, ti], "."]];, {k, 0, end - 1}];
   N[-s/d, pr]];
t2 = Timing[MRB = expM[prec];]; Print["Finished on ", 
 DateString[], ". Proccessor time was ", t2[[1]], " s."];
Print["Enter MRBtest2 to print ", Floor[Precision[MRBtest2]], 
  " digits"];


 (Start time is )^2Tue 23 Apr 2019 06:49:31.

 Iterations required: 132026

 Will give 65 time estimates, each more accurate than the previous.

 Will stop at 133120 iterations to ensure precsion of around 100020 decimal places.

 Denominator computed in  17.2324041s.

...

129024 iterations done in 1011. seconds. Should take 0.01203 days or 1040.s, finish Mon 22 Apr 
2019 12:59:16.

131072 iterations done in 1026. seconds. Should take 0.01202 days or 1038.s, finish Mon 22 Apr 
2019 12:59:15.

Finished on Mon 22 Apr 2019 12:59:03. Processor time was 786.797 s.

 Print["Start time is " "Start time is ", ds = DateString[], "."];
 prec = 100000;
 (**Number of required decimals.*.*)ClearSystemCache[];
 T0 = SessionTime[];
 expM[pre_] := 
   Module[{lg, 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.0002 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 = pr/2^6;
    Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l;
         lg = Log[ll]/(ll); x = N[E^(lg), iprec];
         pc = iprec;
         While[pc < pr, pc = Min[4 pc, pr];
          x = SetPrecision[x, pc];
          xll = x^ll; z = (ll - xll)/xll;
          t = 2 ll - 1; t2 = t^2;
          x = 
           x*(1 + SetPrecision[4.5, pc] (ll - 1)/
                t2 + (ll + 1) z/(2 ll t) - 
              SetPrecision[13.5, 2 pc] ll (ll - 1)/(3 ll t2 + t^3 z))];
          x - lg, {l, 0, tsize - 1}], {j, 0, cores - 1}, 
        Method -> "EvaluationsPerKernel" -> 16]];
     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 -> "EvaluationsPerKernel" -> 16];
     s += ctab.(xvals - 1);
     start += chunksize;
     st = SessionTime[] - T0; kc = k*chunksize;
     ti = (st)/(kc + 10^-10)*(n)/(3600)/(24);
     If[kc > 1, 
      Print[kc, " iterations done in ", N[st - stt, 4], " seconds.", 
       " Should take ", N[ti, 4], " days or ", ti*3600*24, 
       "s, finish ", DatePlus[ds, ti], "."], 
      Print["Denominator computed in  ", stt = st, "s."]];, {k, 0, 
      end - 1}];
    N[-s/d, pr]];
 t2 = Timing[MRBeta2toinf = expM[prec];]; Print["Finished on ", 
  DateString[], ". Processor and total time were ", 
  t2[[1]], " and ", st, " s respectively."];

Start time is  Tue 23 Apr 2019 06:49:31.

Iterations required: 132026

Will give 65 time estimates, each more accurate than the previous.

Will stop at 133120 iterations to ensure precision of around 100020 decimal places.

Denominator computed in  17.2324041s.

...

131072 iterations done in 2589. seconds. Should take 0.03039 days or 2625.7011182s, finish Tue 23 Apr 2019 07:33:16.

Finished on Tue 23 Apr 2019 07:32:58. Processor and total time were 806.5 and 2606.7281972 s respectively.

 MRBeta1 = EulerGamma Log[2] - 1/2 Log[2]^2

 EulerGamma Log[2] - Log[2]^2/2

   N[MRBeta2toinf + MRBeta1 - MRB, 10]

   1.307089967*10^-99742

Attachments:

2nd 100 k eta 4 ...nb

50 k eta 4 22 2019.nb

I figured out how to rapidly compute AND CHECK a computation of the MRB constant! (The timing given is in processor time [for computing and checking] only. T0 can be used with another SessionTime[] call at the end to figure out all time expired during running of the program.) I used both of Crandall's methods for computing it and used for a check, the nontrivial identity ,where gamma is the Euler constant and M is the MRB constant.

Below is my first version of the code with results. If nothing else, I thought, the code pits Crandall's 2 methods against each other to show if one is wrong they both are wrong. (So it is not a real proof.) But these are two totally different methods! (the first of which has been proven by Henry Cohen to be theoretically correct here). For a second check mm is a known approximation to the constant; over 3 million non checked (as of now) digits are found in the attached file 3M.nb. (You will have to change the Format/Style to Input to use the digits.)

In[15]:= (*MRB constant computation with verification! The constant's \
decimal approximation is saved as MRBtest*)prec = 5000;(*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];
  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;, {k, 0, end - 1}];
  etaMs = N[-s/d - (EulerGamma Log[2] - Log[2]^2/2), pr]]; t2 = 
 Timing[MRBtest2 = expM[prec];];
Print["The MRB constant was computed and checked to ", prec, " digits \
in ", t1 = t2[[1]] + Timing[eta[s_] := (1 - 2^(1 - s)) Zeta[s];
     eta1 = Limit[D[eta[s], s], s -> 1];
     MRBtrue = mm;
     MRBtest = eta1 + etaMs;
     check = MRBtest - MRBtrue][[1]], " seconds"]; check

During evaluation of In[15]:= The MRB constant was computed and checked to 5000 digits in 2.12161 seconds

Out[18]= 0.*10^-5000

In[19]:= MRBtest - mm

Out[19]= 0.*10^-5000

Attachments:

3M.nb

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=` 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 I wonder why he chose it?

If you copy and paste the code for Zeta''[2] you get a non evaluable input!

I get the following results comparing two methods:

In[655]:= 
Timing[MRBtrue = 
   NSum[(-1)^n*(n^(1/n) - 1), {n, 1, Infinity}, 
    WorkingPrecision -> prec, Method -> "AlternatingSigns"]][[1]]

Out[655]= 8.049652

In[656]:= 
Timing[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''[2])) + 1/2 (2 EulerGamma Log[2] - Log[2]^2)][[1]]

Out[656]= 12.277279

I could really use your opinions here! If your getting tired of my posts let me know.

Power towers are defined below. See http://mathworld.wolfram.com/PowerTower.html .

;;;

How about breaking my record for computing the infinite power tower of the MRB constant. Here's how I have to go about computing n digits of it: I compute a decimal expansion of the MRB constant, which I save as m. Then I compute l = Log[m]; N[-ProductLog[-l]/l, n]. My record is 3 million digits, in which I used my 3,014,991 digit computation of the MRB constant (mentioned in the first post of this thread) for m.

It would be EXTREMELY helpful if anyone could find a way to compute the exact power tower without first computing the MRB constant! Such a revelation would be synonymous with finding a closed for solution to the MRB constant! I've been trying to find the exact power tower, lately, with no success. Even a high precision approximation to the power tower would generate a nearly equally precise approximation to the MRB constant. (Let ll be the infinite power tower of m, then ll^(1/ll)=m)

Attached are 3 million digits of the power tower.

The MRB constant is now a Scholar subject:

https://scholar.google.com/scholar?q=%22MRB+constant%22

Try to beat these MRB constant records!

NEW RECORD ATTEMPTS OF 4,000,000 DIGITS!

.

.

First effort, Sep 04, 2015

At 10:00 PM Friday Sept 04, 2015 I started the 4,000,000 run of the MRB constant proper. Does anyone want to work on it with me?

Here is the code I am using:

(*Fastest (at MRB's end) as of 24 dEC 2014.*)
Block[{$MaxExtraPrecision = 50}, 
 prec = 4000000;(*Number of required decimals.*)ClearSystemCache[];
 T0 = SessionTime[];
 expM[pre_] := 
  Module[{a, d, s, k, bb, c, n, end, iprec, xvals, x, pc, cores = 16, 
    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["end ", end];
   Print[end*chunksize]; d = Cos[n ArcCos[3]];
   {b, c, s} = {SetPrecision[-1, 1.1*n], -d, 0};
   iprec = Ceiling[pr/27];
   Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l;
        h = Log[ll]/ll; x = N[Exp[h], 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" -> 4]];
    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 -> "EvaluationsPerKernel" -> 2];
    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];]; 
 Print["Difference from 3014991 known digits is ", MRBtest2 - m3M];
 MRBtest2]

3014991 digits are saved as m3M.

I will post several updates as edits here as I go.

EDIT: As of Sat, Sept 5, 2015, the program is indicating that the run will take 3.3 months.

EDIT: Having to run the program for over 3 months, there is a chance that I would suffer a power outage longer than the 15 minutes or so that my battery backup will run my computer! Of course I'll keep you posted if that happens. (I've tried calculations that took longer than that before!)

...Updates were installed closing Mathematica..

Second effort, Sept 10, 2015

EDIT I didn't know that upgrading to Windows 10 caused my Windows update option to read, automatically install updates, so my computer restarted. I started the 4,000,000 digit run again at 8:34 PM, Thursday Sept 10, 2015. This time I made sure the deffer updates option was chosen!!

EDIT As of Sept 19,2015, the program says it will take 94 more days to complete the 4 million digit run.

EDIT As of Sept 23,2015, 9:20 PM, the program says it will take 90.9563 more days to complete the 4 million digit run.

EDIT As of Sept 27,2015, 9:20 PM, the program says it will take 86.9283 more days to complete the 4 million digit run

...Updates were installed closing Mathematica..

Third effort, Sept 28,2015

Well I started the 4 million digit search again. This time I installed the Windows 10 Fall Creators Update to try to avoid the automatic restarts! Per my habit above I will post updates in this message. The code I'm using is the same mentioned twice above that starts with

The Windows 10 Fall Creators Update restarted my machine on Thursday, Nov 16, 2017 at 5:33 pm!

Fourth effort, Dec 19, 2017

I applied some new update policies via LogMeIn, for windows to download but not apply updates. That should work!

The new run looks like

  1 : 15 : 58 pm EST | Sunday, December 17, 2017
   ...  done iter 96256 165140.1164436.

Then

  (165140.1164436) sec/(96256 iterations) (5306880 iterations)/(3600sec/hour)/(24 hour/day)

gives 105.378 day.

Entering "December 17, 2017+106 days" into Wolfram Alpha tells us the computation should be done around Monday, April 2, 2018.

My computer went to sleep sometime between 10:15:51 pm EST | Thursday, December 28, 2017 and 9:22:00 am EST | Sunday, December 31, 2017 .

Fifth effort, Jan 09, 2018

The output starts out with

"Sun 7 Jan 2018 15:14:50"

Iterations required: 5306398

 end 3455

 5306880

 done iter 0     2374.6810043.

The latest result is done iter 92160 153642.6180409.

Entering

 (153642.6180409) sec/(92160 iterations) (5306880iterations)/(3600 sec/hour)/(24 hour/day)

gives

102.399 day or 3.4 months for the computation to run.

Here is the latest output: done iter 3048960 5.1636602440434*10^6.

N[3048960/5306880*100] says the computation is 57.453% done.

... My computer failed on 3/11/2018 at 8:30 am. I will break the program up, where it does a little at a time and saves a file with what progress has been made!

Sixth effort, Sat 14 Apr 2018

I optimized my program to calculating 4019999 digits with my new system in Mathematica v. 11.3 (not kernel version).

Posted below. On my new Xeon system, this optimized version gives V11.3 (not kernel version) a slight advantage over 11.2 (not kernel version)!

Print["Start time is ", ds = DateString[], "."];
prec = 4000000;
(**Number of required decimals.*.*)ClearSystemCache[];
T0 = SessionTime[];
expM[pre_] := 
  Module[{a, d, s, k, bb, c, end, iprec, xvals, x, pc, cores = 32(*=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/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" -> 16(* a power of 2 commensurate with processor strength*)]];
    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 -> "EvaluationsPerKernel" -> 16(* a power of 2 commensurate with processor strength*)];
    s += ctab.(xvals - 1);
    start += chunksize;
    st = SessionTime[] - T0; kc = k*chunksize; 
    ti = (st)/(kc + 10^-4)*(n)/(3600)/(24);
    If[kc > 1, 
     Print[kc, " iterations done in ", N[st, 3], " seconds.", 
      " Should take ", N[ti, 2], " days or ", N[ti*24*3600, 2], 
      "s, finish ", DatePlus[ds, ti], "."]];, {k, 0, end - 1}];
   N[-s/d, pr]];
t2 = Timing[MRBtest2 = expM[prec];]; Print["Finished on ", 
 DateString[], ". Proccessor time was ", t2[[1]], " s."];
(*Print[*)MRBtest2(*]*)(*Remove (**) or enter MRBtest2 to print \
output*); Print["Enter MRBtest2 to print ", 
 Floor[Precision[
   MRBtest2]], " digits"]; Print["If you saved m3M, the difference \
between this and 3,014,991 known digits is ", N[MRBtest2 - m3M, 10]]

I'm going to play around with it an see what my patience and my computer's endurance amounts to.

Here is the result:

Start time is Sat 14 Apr 2018 14:00:33.

Iterations required: 5306398

Will give 1296 time estimates, each more accurate than the previous.

Will stop at 5308416 iterations to ensure precsion of around 4019999 decimal places.

4096 iterations done in 1.1810^4 seconds. Should take 1.810^2 days or 1.5*10^7s, finish Tue 9 Oct 2018 01:49:36.

...

2789376 iterations done in 4.21*10^6 seconds. Should take 93. days or 8.0*10^6s, finish Mon 16 Jul 2018 07:21:24.

That is 43.92 days from now (9:15:15 am EDT | Saturday, June 2, 2018).

...

My computer crashed!

Seventh! effort 27 Aug 2018

I started another 4 million digit run with my 3.7 GH overclocked up to 4.7 GH, Intel 6core and 6 kernels at 3000MH RAM, w/ 4 cores and 8 kernels of 3.6 GH at 2400MH RAM with optimized use of kernel priority.

It is ultra fast!!!!!! Instead of around 100 days it says it will be done in less than 50 days.

Here are the results thus far:

Print["Start time is ", ds = DateString[], "."];
prec = 4000000;
(**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/24768];
   Do[xvals = Flatten[Parallelize[Table[Table[ll = start + j*tsize + l;
         x = N[E^(Log[ll]/(ll)), iprec];



         pc = iprec;
         While[pc < pr/4096, pc = Min[3 pc, pr/4096];
          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/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);
    Print[kc, " iterations done in ", N[st, 4], " seconds.", 
     " Should take ", N[ti, 4], " days or ", N[ti*24*3600, 4], 
     "s, finish ", DatePlus[ds, ti], "."], {k, 0, end - 1}];
   N[-s/d, pr]];
t2 = Timing[MRBtest2 = expM[prec];]; Print["Finished on ", 
 DateString[], ". Proccessor time was ", 
 t2[[1]], " s."]; Print["Actual time was ", st];
(*Print[*)MRBtest2(*]*)(*Remove (**) or enter MRBtest2 to print \
output*); Print["Enter MRBtest2 to print ", 
 Floor[Precision[
   MRBtest2]], " digits"]; Print["If you saved m3M, the difference \
between this and 3,014,991 known digits is ", N[MRBtest2 - m3M, 10]]

Start time is Mon 27 Aug 2018 17:22:11.

Iterations required: 5306398

Will give 2592 time estimates, each more accurate than the previous.

Will stop at 5308416 iterations to ensure precsion of around 4019999 decimal places.

0 iterations done in 1408. seconds. Should take 8.646*10^8 days or 7.470*10^13s, finish Sun 25 Jul 2369306 03:19:20.

2048 iterations done in 2831. seconds. Should take 84.90 days or 7.335*10^6s, finish Tue 20 Nov 2018 14:58:22.

4096 iterations done in 4261. seconds. Should take 63.90 days or 5.521*10^6s, finish Tue 30 Oct 2018 14:52:54.

6144 iterations done in 5752. seconds. Should take 57.49 days or 4.967*10^6s, finish Wed 24 Oct 2018 05:12:32.

8192 iterations done in 7237. seconds. Should take 54.26 days or 4.688*10^6s, finish Sat 20 Oct 2018 23:35:31.
...

210944 iterations done in 1.513*10^5 seconds. Should take 44.06 days or 3.807*10^6s, finish Wed 10 Oct 2018 18:53:41.

212992 iterations done in 1.528*10^5 seconds. Should take 44.06 days or 3.807*10^6s, finish Wed 10 Oct 2018 18:49:24.

215040 iterations done in 1.543*10^5 seconds. Should take 44.06 days or 3.807*10^6s, finish Wed 10 Oct 2018 18:48:16.

217088 iterations done in 1.558*10^5 seconds. Should take 44.07 days or 3.808*10^6s, finish Wed 10 Oct 2018 19:04:29.

219136 iterations done in 1.573*10^5 seconds. Should take 44.07 days or 3.808*10^6s, finish Wed 10 Oct 2018 19:07:25.


...



548864 iterations done in 3.954*10^5 seconds. Should take 44.24 days or 3.822*10^6s, finish Wed 10 Oct 2018 23:06:24.

550912 iterations done in 3.968*10^5 seconds. Should take 44.24 days or 3.822*10^6s, finish Wed 10 Oct 2018 23:08:05.

552960 iterations done in 3.983*10^5 seconds. Should take 44.24 days or 3.822*10^6s, finish Wed 10 Oct 2018 23:09:03.

...

782336 iterations done in 5.655*10^5 seconds. Should take 44.40 days or 3.836*10^6s, finish Thu 11 Oct 2018 02:52:31.

784384 iterations done in 5.671*10^5 seconds. Should take 44.40 days or 3.836*10^6s, finish Thu 11 Oct 2018 03:00:20.

786432 iterations done in 5.685*10^5 seconds. Should take 44.40 days or 3.836*10^6s, finish Thu 11 Oct 2018 02:58:41.

...
907264 iterations done in 6.568*10^5 seconds. Should take 44.46 days or 3.841*10^6s, finish Thu 11 Oct 2018 04:26:21.

909312 iterations done in 6.583*10^5 seconds. Should take 44.46 days or 3.842*10^6s, finish Thu 11 Oct 2018 04:29:41.

911360 iterations done in 6.598*10^5 seconds. Should take 44.47 days or 3.842*10^6s, finish Thu 11 Oct 2018 04:33:53.


...

1028096 iterations done in 7.454*10^5 seconds. Should take 44.53 days or 3.848*10^6s, finish Thu 11 Oct 2018 06:07:13.

1030144 iterations done in 7.470*10^5 seconds. Should take 44.53 days or 3.848*10^6s, finish Thu 11 Oct 2018 06:11:43.

1032192 iterations done in 7.485*10^5 seconds. Should take 44.54 days or 3.848*10^6s, finish Thu 11 Oct 2018 06:12:48.

A long-term power outage stopped this computation!

I so dearly want to see more digits of the MRB constant: Please, anyone, please help here!!

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:

4 million 11 2018.nb

See distribution method.nb for how I got the following distribution tables

Here is the distribution of digits within the first 5,000,000 decimal places (.187859,,,), "4" shows up a lot more than other digits, followed by "0," "8"and "6."

Here is a similar distribution over the first 4,000,000:

3,000,000 digits share a similar distribution:

Over the first 2 and 1 million digits "4" was not so well represented. So, the heavy representation of "4" is shown to be a growing phenomenon from 2 million to 5 million digits. However, "1,2,and 5" still made a very poor showing:

Attachments:

distribution method.nb

8/24/2019 It's time for more digits!

Using the 3 node MRB constant super computer, I started the 6 million digit computation of the MRB constant. Here is the code:

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, 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];
         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);
    Print[kc, " iter. done in ", N[st, 4], " s. Ave. ", N[kc/st, 5], 
     "iter./s.", " Should take ", N[ti, 5], " days or ", 
     N[ti*24*3600, 4], "s. Finish ", DatePlus[ds, ti], "."]; 
    Print[Text[
      Style[{IntegerPart[kc/(end*chunksize)*100], "% done."}, 
       FontSize -> Large]]], {k, 0, end - 1}];
   N[-s/d, pr]];
t2 = Timing[MRBtest2 = expM[prec];]; Print["Finished on ", 
 DateString[], ". Proccessor time was ", 
 t2[[1]], " s."]; Print["Actual time was ", st];
(*Print[*)MRBtest2(*]*)(*Remove (**) or enter MRBtest2 to print \
output*); Print["Enter MRBtest2 to print ", 
 Floor[Precision[
   MRBtest2]], " digits"]; Print["If you saved m5M, the difference \
between this and 5,000,000 known digits is ", N[MRBtest2 - m5M, 10]]

. Here are key results:

Start time is Fri 23 Aug 2019 08:11:15.

Iterations required: 7959598

Will give 3887 time estimates, each more accurate than the previous.

Will stop at 7960576 iterations to ensure precision of around 6029999 decimal places.

...

(Below, "iter." stands for iterations, "s" for seconds and "Ave," for average.)

{0,% done.}

79872 iter. done in 8.022*10^4 s. Ave. 0.99561iter./s. Should take 92.531 days or 7.995*10^6s. Finish Sat 23 Nov 2019 20:55:33.

{1,% done.}

...

{1,% done.}

159744 iter. done in 1.601*10^5 s. Ave. 0.99759iter./s. Should take 92.347 days or 7.979*10^6s. Finish Sat 23 Nov 2019 16:31:22.

{2,% done.}

,,,

{2,% done.}

239616 iter. done in 2.408*10^5 s. Ave. 0.99488iter./s. Should take 92.599 days or 8.001*10^6s. Finish Sat 23 Nov 2019 22:33:42.

{3,% done.}

...

{3,% done.}

319488 iter. done in 3.219*10^5 s. Ave. 0.99259iter./s. Should take 92.813 days or 8.019*10^6s. Finish Sun 24 Nov 2019 03:41:55.

{4,% done.}

...

{4,% done.}

399360 iter. done in 4.041*10^5 s. Ave. 0.98838iter./s. Should take 93.208 days or 8.053*10^6s. Finish Sun 24 Nov 2019 13:11:03.

{5,% done.}

...

{5,% done.}

479232 iter. done in 4.861*10^5 s. Ave. 0.98596iter./s. Should take 93.437 days or 8.073*10^6s. Finish Sun 24 Nov 2019 18:40:42.

{6,% done.}

...

{6,% done.}

559104 iter. done in 5.684*10^5 s. Ave. 0.98372iter./s. Should take 93.650 days or 8.091*10^6s. Finish Sun 24 Nov 2019 23:46:39.

{7,% done.}

...

{7,% done.}

636928 iter. done in 6.486*10^5 s. Ave. 0.98203iter./s. Should take 93.811 days or 8.105*10^6s. Finish Mon 25 Nov 2019 03:38:48.

{8,% done.}

...

{8,% done.}

716800 iter. done in 7.316*10^5 s. Ave. 0.97983iter./s. Should take 94.022 days or 8.123*10^6s. Finish Mon 25 Nov 2019 08:42:28.

{9,% done.}

For some unknown reason, the kernel closed at 9:09:35 pm EDT | Saturday, August 31, 2019.

I can't stand not trying to make progress!!!! so I started the 6 million digit run again. More info coming soon!

Start time is Mon 16 Sep 2019 15:35:29.

Iterations required: 7959598

Will give 3887 time estimates, each more accurate than the previous.

Will stop at 7960576 iterations to ensure precision of around 6029999 decimal places. 

...

1:51:29 pm EDT | Tuesday, September 17, 2019:

{0,% done.}

79872 iter. done in 8.016*10^4 s. Ave. 0.99637iter./s. Should take 92.461 days or 7.989*10^6s. Finish Wed 18 Dec 2019 02:39:24.

{1,% done.}

...

11:45:29 am EDT | Wednesday, September 18, 2019:

{1,% done.}

159744 iter. done in 1.590*10^5 s. Ave. 1.0047iter./s. Should take 91.690 days or 7.922*10^6s. Finish Tue 17 Dec 2019 08:09:00.

{2,% done.}

...

9:47:09 am EDT | Thursday, September 19, 2019:

    {2,% done.}

239616 iter. done in 2.383*10^5 s. Ave. 1.0055iter./s. Should take 91.621 days or 7.916*10^6s. Finish Tue 17 Dec 2019 06:30:08.

{3,% done.}

...

7:58:49 am EDT | Friday, September 20, 2019:

{3,% done.}

319488 iter. done in 3.182*10^5 s. Ave. 1.0039iter./s. Should take 91.763 days or 7.928*10^6s. Finish Tue 17 Dec 2019 09:54:04.

{4,% done.}

...

6:25:29 am EDT | Saturday, September 21, 2019:

{4,% done.}

399360 iter. done in 3.990*10^5 s. Ave. 1.0008iter./s. Should take 92.048 days or 7.953*10^6s. Finish Tue 17 Dec 2019 16:45:14.

{5,% done.}

...

4:52:09 am EDT | Sunday, September 22, 2019:

{5,% done.}

479232 iter. done in 4.798*10^5 s. Ave. 0.99881iter./s. Should take 92.234 days or 7.969*10^6s. Finish Tue 17 Dec 2019 21:12:51.

{6,% done.}

...

3:15:29 am EDT | Monday, September 23, 2019:

{6,% done.}

559104 iter. done in 5.604*10^5 s. Ave. 0.99766iter./s. Should take 92.341 days or 7.978*10^6s. Finish Tue 17 Dec 2019 23:46:54.

{7,% done.}

...

1:12:09 am EDT | Tuesday, September 24, 2019:

{7,% done.}

636928 iter. done in 6.394*10^5 s. Ave. 0.99620iter./s. Should take 92.477 days or 7.990*10^6s. Finish Wed 18 Dec 2019 03:01:50.

{8,% done.}

...

11:50:29 pm EDT | Tuesday, September 24, 2019:

{8,% done.}

716800 iter. done in 7.209*10^5 s. Ave. 0.99437iter./s. Should take 92.646 days or 8.005*10^6s. Finish Wed 18 Dec 2019 07:06:09.

{9,% done.}

Well, my internet went out!!!!! To get it working, I had to reset my router. This killed the computation at 44% at 8:17:42 am EST | Thursday, November 28, 2019. I attached the notebook showing all of my progress.

Attachments:

6 million 3 at 4...nb

On 2/24/2020 at 4:35 pm, I started a 10,000 digit calculation of the MRB constant using the integral

Here is the code:

First, compute 10,000 digits using Mathematica's "AlternatingSigns" option.

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

Then compute the integral.

Timing[mi = 
NIntegrate[
Csch[\[Pi] t] E^((t ArcTan[t])/(1 + t^2)) (1 + 
t^2)^(1/(2 + 2 t^2)) Sin[(2 ArcTan[t] - t Log[1 + t^2])/(2 + 
2 t^2)], {t, 0, \[Infinity]}, WorkingPrecision -> 5000, 
Method -> "Trapezoidal", PrecisionGoal -> 10000, 
MaxRecursion -> 50]]

It is still working now on 2/26/2020 at 6:05 pm.

I messed up, but I'll let the computation complete anyway.

(My integral's result will only have around 5000 digits of precision -- so I should expect it to only be that accurate when I compare it to the sum.) But, this computation will give the approximate time required for a 10,000 digit calculation with that MaxRecursion (which might be way more than enough!)

It is still running at 7:52 am on 2/27/2020. The computer has been running at right around 12 GB of RAM committed and 9 GB of RAM in use, since early in the computation.

I started a second calculation on a similar computer. This one will be faster and give us a full 10,000 digits. But I reduced the MaxRecursion somewhat significantly. We'll see if all 10 k digits are right...

code

Timing[mi = 
  NIntegrate[
   Csch[\[Pi] t] E^((t ArcTan[t])/(1 + t^2)) (1 + 
       t^2)^(1/(2 + 2 t^2)) Sin[(2 ArcTan[t] - t Log[1 + t^2])/(2 + 
        2 t^2)], {t, 0, \[Infinity]}, WorkingPrecision -> 10000, 
   Method -> "Trapezoidal", PrecisionGoal -> 10000, 
   MaxRecursion -> 35]]

That lower threshold for MaxRecursion worked just fine!!!!!!!!!!!!!!! It took only 7497.63 seconds (roughly 2 hours) to calculate 10,000 accurate digits of the MRB constant from the integral.

2/27/2020 at 9:15 PM:

I just now started15,000 and a 20,000 digit computations of the integral form of the MRB constant. The 15,000 digit calculation of the MRB constant through the integral, finished in 15,581s (4.328 hours) and was correct to all 15,000 digits!!!!!!!

I also calculated 20,000 correct digits in 51,632s (14.34 hr) using the integral code

Timing[mi = 
  NIntegrate[
   Csch[\[Pi] t] E^((t ArcTan[t])/(1 + t^2)) (1 + 
       t^2)^(1/(2 + 2 t^2)) Sin[(2 ArcTan[t] - t Log[1 + t^2])/(2 + 
        2 t^2)], {t, 0, \[Infinity]}, WorkingPrecision -> 20000, 
   Method -> "Trapezoidal", PrecisionGoal -> 20000, 
   MaxRecursion -> 30]]

Furthermore, I calculated 25,000 correct digits in 77,212.9s (21.45 hr) using the integral code

Timing[mi = 
  NIntegrate[
   Csch[\[Pi] t] E^((t ArcTan[t])/(1 + t^2)) (1 + 
       t^2)^(1/(2 + 2 t^2)) Sin[(2 ArcTan[t] - t Log[1 + t^2])/(2 + 
        2 t^2)], {t, 0, \[Infinity]}, WorkingPrecision -> 25000, 
   Method -> "Trapezoidal", PrecisionGoal -> 25000, 
   MaxRecursion -> 30]]

I think that does wonders to confirm the true approximated value of the constant. As calculated by both

and to at least 25,000 decimals, the true value of the MRB constant is

ms=mi≈ [Attached "MRB to 25k confirmed digits.txt"].

Computation and check of 25k digit integral calculation found in "comp of 25k confirmed digits.nb".

As 0f March 2, 2020, I'm working on timed calculations of 30k,50k and 100k digits of the integral.

I finished a 30,000 accurate digit computation of the MRB constant via an integral in 78 hours. See "comp of 25k and 30k confirmed digits b.nb" for the digits and program.

Also, I finished a 50,000 accurate digit computation of the MRB constant via an integral in 6.48039 days. See "up to 50k digits of a MRB integral.nb" for the digits and program.

Attachments:

MRB to 25k confi...txt

comp of 25k and ...nb

comp of 25k conf...nb

up to 50k digits...nb

It's just too beautiful not to point out the symmetry between the sum and integral formulas we are using to calculate the same digits.

5th Try at 6,000,000 (6 million) Digits

The internet connection between my computers went out again!

I guess I'll have to use just one computer and calculate my 6,000,000 digits the slow way.

Well, at least this MRB records posting has reached a milestone of over 120,000 visits on 3.31.2020, around 4:00 am.

So I restarted the computation on a single computer.

I'm using basically the same code as before.

Here are the most recent results at 9:12:15 pm EDT | Friday, May 1, 2020:

1409024 iter.done in 2.71910^6 s.Ave.0.51820 iter./s.It should take 177.78 days or 1.53610^7 s. Finish Fri 25 Sep 2020. 04 : 37 : 56.

N[1409024/ 7960576  *100] "percent done"

17.7 "percent done"

In the same vein of a non-trivial approximation:

The MRB constant =m.

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

We know from previous posts,

To find how fast this integral converges to m, I entered

lsmall = Table[
  m - NIntegrate[Csch[\[Pi] t] Im[(1 + I t)^(1/(1 + I t))], {t, 0, x},
     WorkingPrecision -> 40], {x, 1, 20}]; N[Ratios[1/lsmall], 15]

followed by the slower

lbig = Table[
  m - NIntegrate[Csch[\[Pi] t] Im[(1 + I t)^(1/(1 + I t))], {t, 0, x},
     WorkingPrecision -> 240], {x, 101, 120}]; N[Ratios[1/lbig], 15]

and ended up with values that converged to

23.2958716448535.

Using those ratios, it looks like

Since that is a form of 0/0, we can use L'Hospital's Rule and see that it is true:

Limit[(Csch[\[Pi] t] Im[(1 + I t)^(1/(
     1 + I t))])/(Csch[\[Pi] (t + 1)] Im[(1 + I (t + 1))^(1/(
     1 + I ( t + 1)))]), t -> Infinity]

gives

Now for the part that is similar to the approximations mentioned in the immediate, previous post.

You may know that

N[20/(E^Pi - Pi), 9]

gives

1.00004500.

While

N[2 - 100/(E^Pi/m - E^Pi), 8]

gives

1.0004005.

Furthermore,

N[2 - 100/(E^Pi/m - E^Pi), 12]/N[20/(E^Pi - Pi), 12]

gives

1.00035544632.

While

N[3 - 100/(E^Pi/m - E^Pi), 12] - N[20/(E^Pi - Pi), 12]

gives

1.00035546231.

Holy double, double vision Batman!

There is a way to make the approximations of 20/(E^Pi - Pi) vs 2 - 100/(E^Pi/x - E^Pi), where x is a relation to m, equal to 11 digits, instead of just similar to 9,

using the parking constant. E^Pi is involved in a term again! (The term is a Cosmological constant, of sorts.)

(*parking constant,c*)
c = NIntegrate[
   E^(-2*(EulerGamma + Gamma[0, t] + Log[t])), {t, 0, Infinity}, 
   WorkingPrecision -> 50, MaxRecursion -> 20];

Let ma be the MRB constant with that term:

ma = m + (2/3 - E^Pi)/(1/3 - c)/10^6;

Calculating more digits of 20/(E^Pi - Pi):

N[20/(E^Pi - Pi), 12]

gives

1.00004500307.

Calculating the new sum with ma instead of m:

N[2 - 100/(E^Pi/ma - E^Pi), 12]

gives

1.00004500308.

What about the second of the similar-looking approximated sums,

N[2 - 100/(E^Pi/x - E^Pi), 15]/N[20/(E^Pi - Pi), 15] vs.N[3 - 100/(E^Pi/x - E^Pi), 16] - N[20/(E^Pi - Pi), 16]?

So we have the new x, ma. Then

N[2 - 100/(E^Pi/ma - E^Pi), 15]/N[20/(E^Pi - Pi), 15]

gives

1.00000000001744.

While

N[3 - 100/(E^Pi/ma - E^Pi), 16] - N[20/(E^Pi - Pi), 16]

gives the exactly the same value of

1.000000000017440.

Holy corrected vision Batman!

Well, I've tried 6,000,000 at least 5 times and am getting nowhere! I started a 5,555,555 digit computation on 19 Jun 2020 22 : 20 : 08, to break my bad luck spree: Here are my latest results:

I'll only post 1 update a week, so as not to abuse the message board.

(You guessed it!) my 5,555,555 digit computation died from another long term power outage. I need a household generator! If I get a generator, I could calculate up to10,000,000 digits!

P. S. Several times, I mentioned Crandall's first MRB constant Dirichlet's eta derivative formula: .

I concluded with what I think is the fastest way of computing it in the message that starts out with " 4/22/2019". But there is something else I would like to test out: At https://www.sciencedirect.com/science/article/pii/S0022314X15001882 , there is the Adell-Lekuona scheme to quickly calculate the mth derivatives of eta of m. Stay tuned for what I find out!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Edit:

I got some meager results of calculating the nth derivatives of eta of n from the Adell-Lekuona scheme:

...

First I define c and the nth derivative of eta sub 1 of n from the scheme:

c[t_, n_] := (-1.`30.)^(n + t)* Sum[Binomial[n, l]*Sum[Binomial[n - l, j]*(-1.`30.)^(n - l - j)*(Log[l + j + 1]/(l + j + 1))^t, {j, 0, n - l}], {l, 0,n}]; 

etad[t_] := (2/3)*
  NSum[c[t, n]/3^n, {n, 0, 20}, Method -> "AlternatingSigns", 
       WorkingPrecision -> 30]

Then I compare the results with the actual derivatives:

In[152]:= etad[2] - N[Derivative[n][DirichletEta][n] /. n -> 2, 30]

Out[152]= -5.6495702147568955843*10^-12

In[153]:= etad[3] - N[Derivative[n][DirichletEta][n] /. n -> 3, 30]

Out[153]= 3.4964879453028546174*10^-12

In[154]:= etad[4] - N[Derivative[n][DirichletEta][n] /. n -> 4, 30]

Out[154]= -1.19233015142032460531*10^-12

In[168]:= etad[10] - N[Derivative[n][DirichletEta][n] /. n -> 10, 30]

Out[168]= 3.859680615418530806797*10^-14

In[190]:= etad[100] - N[Derivative[n][DirichletEta][n] /. n -> 100, 30]

Out[190]= -1.8845740316090756479036*10^-51

I'm getting more digits as the value of n goes up..

EDIT (3 days later)

Here are more than 224 accurate digits of the MRB constant via only the Adell-Lekuona scheme in 44 min:

First, I calculated 240 digits that have been proven to be correct to well beyond 224 digits:

  In[132]:= m = 
   NSum[(-1)^n (n^(1/n) - 1), {n, 1, Infinity}, WorkingPrecision -> 240,
     Method -> "AlternatingSigns"]

  Out[132]= \
  0.18785964246206712024851793405427323005590309490013878617200468408947\
  7231564660213703296654433107496903842345856258019061231370094759226630\
  4389293488961841208373366260816136027381263793734352832125527639621714\
  893217020762820621715167151756

Then I entered a line that computes the nth derivatives of eta of n:

            c[t_, n_] := (-1`240)^(n + t)*Sum[Binomial[n, l]*Sum[Binomial[n - l, j]*(-1)^(n - l - j)* (N[Log[l + j + 1], 250]/(l + j + 1))^t, {j,  0, n - l}], {l, 0,  n}];
            etad[t_] := (2/3)*N[ Sum[c[t, n]/3^n, {n, 1, 500} ], 250]

Then I entered the program to compute the MRB constant from the derivatives:

        Timing[shot = -NSum[(-1)^x etad[x]/x!, {x, 1, 120}, Method -> "WynnEpsilon",WorkingPrecision -> 240, NSumTerms -> 90]]

Here are the time it took and the digits calculated:

    {2656.11, \
    0.18785964246206712024851793405427323005590309490013878617200468408947\
    7231564660213703296654433107496903842345856258019061231370094759226630\
    4389293488961841208373366260816136027381263793734352832125527639621714\
    893217020762821}

Here those digits are proven to be correct to 224 digits:

  In[138]:= m - shot

  Out[138]= 0.*10^-224

Compare with my fastest 224 digit computation, 62.5 milliseconds:

In[72]:= Print["Start time is ", ds = DateString[], "."];
prec = 225;
(**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/27];
      Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l;
                x = N[E^(Log[ll]/(ll)), iprec];
                pc = iprec;
                While[pc < pr/4, pc = Min[3 pc, pr/4];
                  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/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}, Method -> "EvaluationsPerKernel" -> 32]];
        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 -> "EvaluationsPerKernel" -> 16];
        s += ctab.(xvals - 1);
        start += chunksize;
        st = SessionTime[] - T0; kc = k*chunksize;
        ti = (st)/(kc + 10^-4)*(n)/(3600)/(24);
        If[kc > 1, 
          Print[kc, " iterations done in ", N[st, 4], " seconds.", 
            " Should take ", N[ti, 4], " days or ", N[ti*24*3600, 4], 
            "s, finish ", DatePlus[ds, ti], "."]];, {k, 0, end - 1}];
      N[-s/d, pr]];
t2 = Timing[MRB1 = expM[prec];]; Print["Finished on ", 
  DateString[], ". Proccessor time was ", t2[[1]], " s."];
Print["Enter MRBtest2 to print ", Floor[Precision[MRBtest2]], 
   " digits"]; m3M - MRB1


During evaluation of In[72]:= Start time is Mon 7 Sep 2020 03:19:21.

During evaluation of In[72]:= Iterations required: 298

During evaluation of In[72]:= Will give 1 time estimates, each more accurate than the previous.

During evaluation of In[72]:= Will stop at 2048 iterations to ensure precision of around 226 decimal places.

During evaluation of In[72]:= Finished on Mon 7 Sep 2020 03:19:21. Processor time was 0.0625 s.

During evaluation of In[72]:= Enter MRBtest2 to print \[Infinity] digits

Out[78]= 0.*10^-224

That is 40,615 times faster. My use of the Adell-Lekuona scheme has a way to go.

P.S. I did a lot of research and found out that my use of the Adell-Lekuona scheme is no faster, for up to around half a hundred digits than the following "brute force" one. And I show where it is a great deal slower! The scheme's main advantage seems to be being able to compute more of a maximum of digits (like the above 224, which to me seems impossible to match with a PC and general math software).

In[45]:= m = 
 NSum[(-1)^n (n^(1/n) - 1), {n, 1, Infinity}, WorkingPrecision -> 100,
   Method -> "AlternatingSigns"]; Timing[
 c1 = Limit[(-1)^n/n! Derivative[n][DirichletEta][x] /. n -> 1, 
   x -> 1];

 m + (c1 + 
    NSum[(-1)^n/n! Derivative[n][DirichletEta][n], {n, 2, 30}, 
     Method -> "WynnEpsilon", WorkingPrecision -> 100])]

Out[45]= {7.84375, -2.40588*10^-48}

vs scheme:

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

Out[1]=  0.\
1878596424620671202485179340542732300559030949001387861720046840894772\
3156466021370329665443217278

In[41]:=    c[t_, n_] := (-1`60)^(n + t)*

  Sum[Binomial[n, l]*Sum[Binomial[n - l, j]*(-1)^(n - l - j)*
                         (Log[l + j + 1]/(l + j + 1))^t, {j, 0, 
      n - l}], {l, 0, 
             n}]; etad[t_] := (2/3)*
            N[ Sum[c[t, n]/3^n, {n, 1, 90} ], 60]

In[42]:= Timing[
 shot = -NSum[(-1)^x etad[x]/x!, {x, 1, 30}, Method -> "WynnEpsilon", 
    WorkingPrecision -> 60, NSumTerms -> 60]]

Out[42]= {12.5781, \
0.187859642462067120248517934054273230055903094615556440737580}

In[43]:= m - shot

Out[43]= 2.84582345434425*10^-46

The Seventh attempt at Calculating 6,000,000 digits

Speaking of methods of computation, at Fri 11 Sep 2020 21:41:41, I started my seventh attempt at calculating 6,000,000 digits of the MRB constant with one node of the MRB constant supercomputer. Here are the MRB method program and recent output.

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 precision of around ", pr, 
        " decimal places."]; Print[]; d = ChebyshevT[n, 3];
      {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/4, pc = Min[3 pc, pr/4];
                  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/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}, Method -> "EvaluationsPerKernel" -> 32]];
        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 -> "EvaluationsPerKernel" -> 16];
        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]

 As of  Sat 19 Sep 2020 09:00:54 there were 356352 iterations done in
 6.4555*10^5 seconds. That is 0.55201 iterations/s. 4.476460% complete. 
    It should take 166.890 days or 1.442*10^7s, 
 and finish Thu 25 Feb 2021, 19:03:08.

See https://www.wolframcloud.com/obj/bmmmburns/Published/MRB%202020.nb for up-to-date notebook.

Due to a battery backup that surged, the MRB constant supercomputer suffered great damage, and of course, the computation failed.

I said, "would get back to you when I made some progress." Well here's what I did. 1 node of the MRB constant supercomputer is calculating 6 million digits using the same program used above. Another node is calculating 7,500,000 digits using an experimental, faster program, which digits I will round down to 7,000,000. The remaining node is calculating 5,500,000 digits using only Richard Crandall's original algorithm. If they all three agree to 5,500,000 digits, I will be certain that those digits are correct. And if the 6,000,000 are the same found in the rounded down 7,500,000, will be pretty-well satisfied that they are correct. And experience has taught me that the last one is probably correct to 7,000,000 or more.

The 5,500,000 digits computation using only Crandall's original method can be found here: https://www.wolframcloud.com/obj/bmmmburns/Published/5p5million.nb .

The 6,000,000 digits computation using my method found in the previous message, here: https://www.wolframcloud.com/obj/bmmmburns/Published/MRBSC2%206%20million%201st%20fourth.nb

The 7,500,000 digits computation using the experimental, faster method, here: https://www.wolframcloud.com/obj/bmmmburns/Published/first2%207%20million%2011p3.nb .

The node tasked with the 7,500,000 digits computation using the experimental, faster method crashed, so I reassigned it 6,500,000 digits using my proven method.

It is now found here:

.