Message Boards Message Boards

1
|
7697 Views
|
8 Replies
|
9 Total Likes
View groups...
Share
Share this post:

Record breaking direct summation of MRB constant

POSTED BY: Marvin Ray Burns
8 Replies
POSTED BY: Henrik Schachner

Dear Henrik,

that's a beautiful piece of mathemagic.

Thanks for sharing,

Marco

POSTED BY: Marco Thiel

Dear Marco,

thank you for your nice and encouraging comments! Yes, it is almost magical - and it shows a sort of "beauty of simplicity"! I learned about Shanks transformation when reading - or trying to read - Benders book (which for me is somewhat challenging) and watching his lectures (which I find excellent!). Bender shows lots of most interesting methods I had never heard of before, particularly not in my math courses (about 30 years ago ...).

Best wishes -- Henrik

POSTED BY: Henrik Schachner
POSTED BY: Marvin Ray Burns
POSTED BY: Henrik Schachner

Thank you Henrik! I think the Shanks transformation will help me. It seems, however, Mathematica has an issue with 10's and 100's of iterations of Shanks.

POSTED BY: Marvin Ray Burns

Let g[n] be the error in using f, as you use 10^n terms, as shown in the original post; using the following piece of code:

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

N::meprec: Internal precision limit $MaxExtraPrecision = 50.` reached while evaluating -E^(2 I Interval[{0,\[Pi]}])+E^(2 I Interval[{0,\[Pi]}]). >>

f[k_] := Log[(k - Log[k])/k];

ClearAll[g]; 
g[n_] := Module[{}, 
  m - (NSum[(-1)^k (k^(1/k) - 1 + f[k]), {k, 1, 10^n}, 
      WorkingPrecision -> Floor[3 n + 100], 
      Method -> "AlternatingSigns"] - 
     NSum[(-1)^k*f[k], {k, 1, Infinity}, 
      WorkingPrecision -> Floor[3 n + 100], 
      Method -> "AlternatingSigns"])]

. You find there is a pattern to g[n]

For[n = 2, n < 20, 
 Print[RootApproximant[
   MantissaExponent[g[10 n]/g[10 (n + 1)]][[1]]]]; n++]

8/27

27/64

64/125

125/216

216/343

343/512

512/729

729/1000

1000/1331

1331/1728

1728/2197

2197/2744

2744/3375

3375/4096

4096/4913

4913/5832

5832/6859

6859/8000

, and find g[10 n]/g[10 (n + 1)] ->n^3/(n+1)^3 *10 to a factor:

For[n = 2, n < 20, Print[
  RootApproximant[
    MantissaExponent[
      g[10 n]/g[10 (n + 1)]
      ][[1]]
    ] - n^3/(n + 1)^3
  ]; n++]

0

0

0

0

0

0

0

0

0

0

0

0

0

0

0

0

0

0
POSTED BY: Marvin Ray Burns

Again. let g[n] be the error in using f, as you use 10^n terms, as shown in the original post; using the following piece of code, and then it appears to be the case that the g[10 n]'s are rational factors of Log[10]^3, to better and better precision as n gets large:

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



 f[k_] := Log[(k - Log[k])/k];

ClearAll[g];
g[n_] := Module[{}, 
  m - (NSum[(-1)^k (k^(1/k) - 1 + f[k]), {k, 1, 10^n}, 
      WorkingPrecision -> Floor[3 n + 100], 
      Method -> "AlternatingSigns"] - 
     NSum[(-1)^k*f[k], {k, 1, Infinity}, 
      WorkingPrecision -> Floor[3 n + 100], 
      Method -> "AlternatingSigns"])]



 Table[
 RootApproximant[MantissaExponent[Log[10]^3/g[10 n]][[1]]], {n, 2, 20}]

(* {3/20, 4/9, 3/16, 24/25, 5/9, 120/343, 15/64, 40/243, 3/25, \ 1200/1331, 25/36, 1200/2197, 150/343, 16/45, 75/256, 1200/4913, \ 50/243, 1200/6859, 3/20} *)

POSTED BY: Marvin Ray Burns
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract