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

As mentioned a few times above Richard Crandall made the following observations about the MRB constant:

His last comment is that we might find some algorithm advantages by focusing on the fixed argument of 0 for the eta derivatives. He gives Chapter 3 as a possible source to find the algorithm advantages. (Here is another link to his paper: http://marvinrayburns.com/UniversalTOC25.pdf .)

Here is what he was looking for.

c[0] = 0; 
c[1] = Log[2]; Table[
c[n] = -2*Derivative[n - 1][Zeta][0], {n, 2, 22}]; 
l = CoefficientList[Normal[Series[Exp[(-x)*E^x], {x, 0, 21}]], 
x]; N[-Sum[
l[[n + 1]]*((-1)^
n*(Sum[(-1)^x*(c[x + 1]*Binomial[n, x]*c[1]^(n - x)), {x, 1, 
n - 1}] + c[1]^n + 
c[0]) + 1/2 c[n + 1]), {n, 1, 17}]]

Mathematica still has trouble with higher zeta derivatives of 0, however. I'm going to look for a procedure for computing them better.

[Edit]

I computed the zeta derivatives of 0 by

   zeta0[p_] := (-1)^p Sum[StieltjesGamma[p + k]/k!, {k, 0, Infinity}] - 
     p!

and got the same results Mathematica got for the higher zeta derivatives of 0.

I also checked the CoefficientList of

CoefficientList[Normal[Series[Exp[(-x)*E^x], {x, 0, 21}]]

by the following, and haven't found where Mathematica is having trouble!

c[0] = 0; c[1] = Log[2]; Table[c[n] = -2*Derivative[n - 1][Zeta][0], 
{n, 2, 
18}]; N[-Sum[(Sum[(-1)^d*d^(n - d)*Binomial[n, d], {d, 1, n}]*
((-1)^
n*(Sum[(-1)^x*(c[x + 1]*Binomial[n, x]*c[1]^(n - x)), 
{x, 1, n - 1}] + c[1]^n + c[0]) + (1/2)*
c[n + 1]))/n!, {n, 1, 17}]]

I even checked the binomials by their formula. Also the StieltjesGamma and Derivative[n ][Zeta][0]] results appear smooth for discrete operations:

 Table[N[Derivative[n ][Zeta][0]], {n, 10, 25}]

and

 N[Table[StieltjesGamma[x], {x, 1, 30}]]

.

[Edit]

I found the problem as to why Mathematica doesn't increase its accuracy in the above formula after 17 iterations: Mathematica will give a numeric solution to many zeta derivatives of 0, only to machine precision!

For machine precision:

  Table[N[Derivative[n ][Zeta][0]], {n, 1, 30}]

gives the machine sized numeric to many derivatives:

 {-0.918939, -2.00636, -6.00471, -23.9971, -120., -720.001, \
-5040., -40320., -362880., -3.6288*10^6, -3.99168*10^7, \
-4.79002*10^8, -6.22702*10^9, -8.71783*10^10, -1.30767*10^12, \
-2.09228*10^13, -3.55687*10^14, -6.40237*10^15, -1.21645*10^17, \
-2.4329*10^18, -5.10909*10^19, -1.124*10^21, -2.5852*10^22, \
-6.20448*10^23, -1.55112*10^25, -4.03291*10^26, -1.08889*10^28, \
-3.04888*10^29, -8.84176*10^30, -2.65253*10^32}.

Then

   Table[N[Derivative[n][Zeta][0], 10], {n, 1, 30}]

gives the high precision numeric for only the first 3 derivatives:

{-0.91893853320467274178032973640561763986`10., \
-2.0063564559085848512101000267299604382`10., 
   -6.0047111668622544478`10., Derivative[4][Zeta][0], 
 Derivative[5][Zeta][0], Derivative[6][Zeta][0], 
   Derivative[7][Zeta][0], Derivative[8][Zeta][0], 
 Derivative[9][Zeta][0], Derivative[10][Zeta][0], 
   Derivative[11][Zeta][0], Derivative[12][Zeta][0], 
 Derivative[13][Zeta][0], Derivative[14][Zeta][0], 
   Derivative[15][Zeta][0], Derivative[16][Zeta][0], 
 Derivative[17][Zeta][0], Derivative[18][Zeta][0], 
   Derivative[19][Zeta][0], Derivative[20][Zeta][0], 
 Derivative[21][Zeta][0], Derivative[22][Zeta][0], 
   Derivative[23][Zeta][0], Derivative[24][Zeta][0], 
 Derivative[25][Zeta][0], Derivative[26][Zeta][0], 
   Derivative[27][Zeta][0], Derivative[28][Zeta][0], 
 Derivative[29][Zeta][0], Derivative[30][Zeta][0]}.

With some confidence I can say

I fixed it!!!

I forced Mathematica to give up the needed digits of the zeta derivatives.

My new program does not really compete with the previously mentioned record-breakers. But it is a fairly efficient use of Crandall's formula (44). First it calculates many digits on MRB the old fashion way to use as a check. So here is my new program:

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

Block[{$MaxExtraPrecision = 1000}, s = 100(*number of terms*);
 c[1] = Log[2];
 c[n_] := N[1 - 2*Derivative[n - 1][Zeta][0], Floor[3/2 s]] - 1;
 mtest = (-Sum[(Sum[(-1)^d*d^(n - d)*Binomial[n, d], {d, 1, 
          n}]*((-1)^
            n*(Sum[(-1)^x*(c[x + 1]*Binomial[n, x]*c[1]^(n - x)), {x, 
               1, n - 1}] + c[1]^n) + (1/2)*c[n + 1]))/n!, {n, 1, 
      s}])]; Print[s, " terms give ", mtest, ", and the error is ", 
 m - mtest]

100 terms give 0.18785964486341229249700337222, and the error is -2.40134517224848543816*10^-9

Changing s to 200 shows all correct digits:

200 terms give 0.187859642465, and the error is -3.*10^-12

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

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

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

So we recover the right hand side.

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

The new sum is this.

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

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

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

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

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

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

Daniel Lichtblau,

Notice Log[k]/(k) and Log[k]^2/(2k^2) are of the form Log[k]^n/(nk^n). We can take that summing of Log[k]/(k) + Log[k]^2/(2*k^2)+... to its end and write B= or compute

NSum[(-1)^(k)*(k^(1/k) - 1 + 
     Sum[Log[k]^n/(n*k^n), {n, 1, Infinity}]), {k, 1, Infinity}, 
  WorkingPrecision -> 1000, Method -> "AlternatingSigns"] - 
 NSum[(-1)^(1 + k) Log[(k - Log[k])/k], {k, 1, Infinity}, 
  WorkingPrecision -> 1000, Method -> "AlternatingSigns"]

Simplified,.B=,

What does that do to our "better convergence from brute force summation?"

P.S. I only used 2 terms in my sample data, so I might not have the correct pattern for Log[k]/(k) + Log[k]^2/(2*k^2)+... .

The reason that I suspect that I've got the wrong pattern is, in the following code the summands Log[k]/(k) and Log[k]^2/(2k^2) give 0 where the Log[k]^n/(nk^n).for n>2 does not. (etaMM[m, n] Gives a numeric approximation for the mth derivative of m.)

   etaMM[m_, pr_] := 
  Module[{a, d, s, k, b, c}, a[j_] := Log[j + 1]^m/(j + 1)^m;
   n = Floor[1.32 pr];
   d = Cos[n ArcCos[3]];
   {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]]; Table[-Sum[(-1)^m*etaMM[m, 30]/m!, {m, 
      1, a}] - 
   Sum[(-1)^(k)*(Sum[Log[k]^n/(n*k^n), {n, 1, a}]), {k, 1, 
     Infinity}], {a, 1, 15}]

The next active post starts out with

"NEW RECORD ATTEMPTS OF 4,000,000 DIGITS!"

MKB constant calculations have been moved to their own discussion at http://community.wolfram.com/groups/-/m/t/1323951?ppauth=W3TxvEwH .

Attachments are still here, though.

Attachments:

10000MKB.pdf

10KMKB.nb

faster10KMKB.nb

fastest10KMKB.nb

nice system!

Would anyone let me know how this comes out on your computer?

Here is a link to my Nov 16, 2018 update of calculating 4 million digits of MRB: HERE.

Here is a link to my Nov 18, 2018 update of calculating 4 million digits of MRB: HERE.

Here is a link to my Nov 19, 2018 update of calculating 4 million digits of MRB: HERE,

Here is a link to my Nov 20, 2018 update of calculating 4 million digits of MRB: HERE

Here is a link to my Nov 21, 2018 update of calculating 4 million digits of MRB: HERE

Here is a link to my Nov 22, 2018 update of calculating 4 million digits of MRB: HERE.

Here is a link to my Nov 24, 2018 update of calculating 4 million digits of MRB: HERE.

Here is a link to my Nov 27, 2018 update of calculating 4 million digits of MRB: HERE.

Here is a link to my Dec 05, 2018 update of calculating 4 million digits of MRB: HERE.

Here is a link to my Dec 10, 2018 update of calculating 4 million digits of MRB: HERE.

Last update of 2018

5:37:20 pm EST | Monday, December 31, 2018 (49.04 days from start time), 75.2315 percent completed . 3,024,300 digits computed.3993600 iterations done in 4.23810^6 seconds. Should take 65.18 days or 5.63110^6s, finish Wed 16 Jan 2019 20:57:47. (16.64 days from now).

Probably the last update

12:47:20 am EST | Monday, January 14, 2019 (62.3495 days from start time), 95.679 percent completed . 3,846,295 digits computed. 5079040 iterations done in 5.38710^6 seconds. Should take 65.15 days or 5.62910^6s, finish Wed 16 Jan 2019 20:13:07. (2.81 days from now).

Tue 22 May 2018

I started a 5,000,000 digits calculation on my 4 core ASUS Intel Core i7 7700 Desktop computer K31CD-DS71, 32 GB DDR4 ram running at 2400 MHz in Windows 10 Pro using a version of my Burns-Crandall hybrid code supercharged with 4 iterations of my 4th order convergence subroutine.

See april 2018 5 million digits try.nb for exact code and results of the incomplete computation.

Here are some of the results:

Start time is Tue 22 May 2018 01:02:37.
Iterations required: 6632998
Will give 3239 time estimates, each more accurate than the previous.
Will stop at 6633472 iterations to ensure precsion of around 5024999 decimal places.
0 iterations done in 3301. seconds. Should take 2.534*10^9 days or 2.189*10^14s, finish Mon 11 Nov 6939709 17:32:23.
2048 iterations done in 6503. seconds. Should take 243.8 days or 2.106*10^7s, finish Sun 20 Jan 2019 19:11:08.
4096 iterations done in 9721. seconds. Should take 182.2 days or 1.574*10^7s, finish Tue 20 Nov 2018 05:57:47.
6144 iterations done in 1.295*10^4 seconds. Should take 161.8 days or 1.398*10^7s, finish Tue 30 Oct 2018 21:15:01.
8192 iterations done in 1.623*10^4 seconds. Should take 152.1 days or 1.314*10^7s, finish Sun 21 Oct 2018 03:44:45.
10240 iterations done in 1.964*10^4 seconds. Should take 147.3 days or 1.272*10^7s, finish Tue 16 Oct 2018 07:34:30.
12288 iterations done in 2.312*10^4 seconds. Should take 144.4 days or 1.248*10^7s, finish Sat 13 Oct 2018 11:43:37.
14336 iterations done in 2.667*10^4 seconds. Should take 142.8 days or 1.234*10^7s, finish Thu 11 Oct 2018 20:49:04.
16384 iterations done in 2.998*10^4 seconds. Should take 140.5 days or 1.214*10^7s, finish Tue 9 Oct 2018 12:13:43.
18432 iterations done in 3.326*10^4 seconds. Should take 138.5 days or 1.197*10^7s, finish Sun 7 Oct 2018 13:48:39.

Sun 20 Jan 2019 21:06:58

I've made a lot better progress with the following!!!

6 kernels, 3.7 GH overclocked up to 4.7 GH, Intel 6core 3000MH RAM, w/ 8 kernels of 3.6 GH 4 core, 2400MH RAM (with optimized use of kernel priority)

Needs["SubKernels`LocalKernels`"]
Block[{$mathkernel = $mathkernel <> " -threadpriority=2"}, 
 LaunchKernels[]](*optimized use of kernel priority for master computer being the fastest one*)

Out[3]= {"KernelObject"[1, "burns"], "KernelObject"[2, "burns"], "KernelObject"[3, "burns"], "KernelObject"[4, "burns"], "KernelObject"[5, "burns"], "KernelObject"[6, "burns"], "KernelObject"[7, "burns"], "KernelObject"[8, "burns"], "KernelObject"[9, "local"], "KernelObject"[10, "local"], "KernelObject"[11, "local"], "KernelObject"[12, "local"], "KernelObject"[13, "local"], "KernelObject"[14, "local"]}

Print["Start time is ", ds = DateString[], "."];
prec = 5000000;
(**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], "."]; 
    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 m3M, the difference \
between this and 4,000,000 known digits is ", N[MRBtest2 - m4M, 10]]

  Start time is Sun 20 Jan 2019 21:06:58.

Iterations required: 6632998

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

Will stop at 6633472 iterations to ensure precsion of around 5024999 decimal places.

0 iterations done in 1893. seconds. Should take 1.454*10^9 days or 1.256*10^14s. Finish Sun 16 Apr 3981600 03:48:25.

{0,% done.}

2048 iterations done in 3801. seconds. Should take 142.5 days or 1.231*10^7s. Finish Wed 12 Jun 2019 08:24:54.

{0,% done.}

4096 iterations done in 5774. seconds. Should take 108.2 days or 9.351*10^6s. Finish Thu 9 May 2019 02:36:43.

{0,% done.}

6144 iterations done in 7744. seconds. Should take 96.76 days or 8.360*10^6s. Finish Sat 27 Apr 2019 15:27:12.

{0,% done.}

8192 iterations done in 9655. seconds. Should take 90.48 days or 7.818*10^6s. Finish Sun 21 Apr 2019 08:42:56.

{0,% done.}

10240 iterations done in 1.160*10^4 seconds. Should take 86.95 days or 7.512*10^6s. Finish Wed 17 Apr 2019 19:49:38.

{0,% done.}

12288 iterations done in 1.351*10^4 seconds. Should take 84.43 days or 7.295*10^6s. Finish Mon 15 Apr 2019 07:29:22.

{0,% done.}

14336 iterations done in 1.544*10^4 seconds. Should take 82.67 days or 7.143*10^6s. Finish Sat 13 Apr 2019 13:14:41.

{0,% done.}

16384 iterations done in 1.737*10^4 seconds. Should take 81.39 days or 7.032*10^6s. Finish Fri 12 Apr 2019 06:34:15.

{0,% done.}

18432 iterations done in 1.931*10^4 seconds. Should take 80.42 days or 6.948*10^6s. Finish Thu 11 Apr 2019 07:06:55.

{0,% done.}

See 5 million 01 2019.nb for full progress. The cluster is processing 1.024 5,000,000 digit iterations of n^(1/n) per second. It is completing 1% every 18 hours, 3 minutes and 36 seconds.

Well, the power went out here in INDY, again.

My 6 year old battery backup is becoming worthless on handling 2 computers for very long. I will try to build some better household infrastructure. Plus, there is still the possibility of breaking my program up so it does smaller portions of the computation at a time. But, I haven't figured how to do that yet!

I will let you know when I'm ready to try again. It took over 8 tries for 4 million digits, so I'm not heartbroken that this second try of 5 million digit didn't work out.

Search for 02/12/2019 for most recent post, (a MRB constant Crandall first eta formula record number of digits).

Attachments:

5 million 01 2019.nb

april 2018 5 mil...nb