Message Boards

WOLFRAM COMMUNITY

7422 Views

8 Replies

9 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Wolfram Language Numerical Computation

Record breaking direct summation of MRB constant

Marvin Ray Burns

Marvin Ray Burns, original investigator of the MRB constant

Posted 9 years ago

The MRB constant is approximated by m = NSum[(-1)^k (k^(1/k) - 1), {k, 1, Infinity}, WorkingPrecision -> 200, Method -> "AlternatingSigns"] . This method is pitifully inefficient in its direct summation of MRB constant ie. -1^(1/1)+2^(1/2)-3^(1/3)+... . Here is how much error there is after 10,000 terms: m - (NSum[(-1)^k (k^(1/k) - 1), {k, 1, 10^4}, WorkingPrecision -> 200, Method -> "AlternatingSigns"]) (* -0. 0004607086148833843903798558880939839952579916174598636084830590133354\ 3604452568023408196838217734393902621089862492299952504355243485749500\ 9513789757123430499002402147185148514618052628511533818725) . Due to the work of Daniel Lichtblau, me, and the late Richard Crandall, found in the middle of my most successful post, http://community.wolfram.com/groups/-/m/t/366628?ppauth=zGnyw9gs , in the second reply that starts with the phrase "Daniel Lichtblau and others," without the quotes; I think I found the optimum direct summation method of the m= -1^(1/1)+f1 +2^(1/2)+f2 -3^(1/3)+f3+ f(k)(x)+ ...- sum[f[k]]. That is f[k_]=Log[(k - Log[k])/k] . Then subtract `Sum[(-1)^k Log[(k - Log[k])/k]` . Here is an example showing the much smaller error in adding the first 10^4 terms: f[k_] := Log[(k - Log[k])/ k]; m - (NSum[(-1)^k (k^(1/k) - 1 + f[k]), {k, 1, 10^4}, WorkingPrecision -> 200, Method -> "AlternatingSigns"] - NSum[(-1)^k f[k], {k, 1, Infinity}, WorkingPrecision -> 200, Method -> "AlternatingSigns"]) (* 6. 5176019395153886286218356168146776861946664225985899368189404704176944\ 5768612992269488431506197821023123569647840336109019435539071457039552\ 2644545041477033072920767543506009868492826598810^-11) Why don't see if you can find a better algorithm!

The MRB constant is approximated by

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

This method is pitifully inefficient in its direct summation of MRB constant ie. -1^(1/1)+2^(1/2)-3^(1/3)+... . Here is how much error there is after 10,000 terms:

 m - (NSum[(-1)^k (k^(1/k) - 1), {k, 1, 10^4}, 
   WorkingPrecision -> 200, Method -> "AlternatingSigns"])

(* -0.
0004607086148833843903798558880939839952579916174598636084830590133354\
3604452568023408196838217734393902621089862492299952504355243485749500\
9513789757123430499002402147185148514618052628511533818725*)

Due to the work of Daniel Lichtblau, me, and the late Richard Crandall, found in the middle of my most successful post,

http://community.wolfram.com/groups/-/m/t/366628?ppauth=zGnyw9gs

, in the second reply that starts with the phrase "Daniel Lichtblau and others," without the quotes; I think I found the optimum direct summation method of the m= -1^(1/1)+f1 +2^(1/2)+f2 -3^(1/3)+f3+ f(k)(x)+ ...- sum[f[k]]. That is

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

. Then subtract Sum[(-1)^k Log[(k - Log[k])/k] . Here is an example showing the much smaller error in adding the first 10^4 terms:

     f[k_] := Log[(k - Log[k])/
        k]; m - (NSum[(-1)^k (k^(1/k) - 1 + f[k]), {k, 1, 10^4}, 
         WorkingPrecision -> 200, Method -> "AlternatingSigns"] - 
        NSum[(-1)^k *f[k], {k, 1, Infinity}, WorkingPrecision -> 200, 
         Method -> "AlternatingSigns"])

(* 6.
5176019395153886286218356168146776861946664225985899368189404704176944\
5768612992269488431506197821023123569647840336109019435539071457039552\
26445450414770330729207675435060098684928265988*10^-11*)

Why don't see if you can find a better algorithm!

POSTED BY: Marvin Ray Burns

8 Replies

Sort By:

Henrik Schachner

Henrik Schachner, Radiation Therapy Center, Weilheim, Germany

Posted 9 years ago

POSTED BY: Henrik Schachner

Marco Thiel

Marco Thiel, University of Aberdeen - Dept. of Physics/Mathematics

Posted 9 years ago

Dear Henrik, that's a beautiful piece of mathemagic. Thanks for sharing, Marco

POSTED BY: Marco Thiel

Henrik Schachner

Henrik Schachner, Radiation Therapy Center, Weilheim, Germany

Posted 9 years ago

POSTED BY: Henrik Schachner

Marvin Ray Burns

Marvin Ray Burns, original investigator of the MRB constant

Posted 9 years ago

POSTED BY: Marvin Ray Burns

Henrik Schachner

Henrik Schachner, Radiation Therapy Center, Weilheim, Germany

Posted 9 years ago

POSTED BY: Henrik Schachner

Marvin Ray Burns

Marvin Ray Burns, original investigator of the MRB constant

Posted 9 years ago

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

Marvin Ray Burns

Marvin Ray Burns, original investigator of the MRB constant

Posted 9 years ago

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)^kf[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

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

Marvin Ray Burns

Marvin Ray Burns, original investigator of the MRB constant

Posted 9 years ago

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)^kf[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} *)

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

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Group Abstract

Feedback