Group Abstract Group Abstract

Message Boards Message Boards

0
|
7.1K Views
|
8 Replies
|
1 Total Like
View groups...
Share
Share this post:

The convergent Sum[n^(1/n)/n^x, {n, 1, Infinity}] and the like

POSTED BY: Marvin Ray Burns A.G.S. (cum laude)
8 Replies
Sort By:

This is a little hard to put in words, but I found out concerning the partial sums of the MRB constant, for integer a>1, as x gets large the following seems to be true.

enter image description here

In code that is

(Sum[(-1)^n (n^(1/n) - 1), {n, 1, a^(x + 2)}] - 
    Sum[(-1)^n (n^(1/n) - 1), {n, 1, 
      a^(x + 1)}])
/
(Sum[(-1)^n (n^(1/n) - 1), {n, 1, a^(x + 1)}] - 
    Sum[(-1)^n (n^(1/n) - 1), {n, 1, a^x}]) 
->
((a - 1) x + (a - 2))/(a ((a - 1) x - 1))

Here is a code that makes a table showing the relation to be true for many values:

Clear[a, b, c]; TableForm[
 Table[b[a] = 
   Table[NSum[(-1)^n (n^(1/n) - 1), {n, 1, a^x}, 
     Method -> "AlternatingSigns", WorkingPrecision -> 100, 
     NSumTerms -> 300], {x, 1, 100}]; 
  c[a] = Table[(b[a][[x + 1]]) - (b[a][[x]]), {x, 1, 98}]; 
  Table[N[((a - 1) x + (a - 2))/(a ((a - 1) x - 1)) - 
     N[c[a][[x + 1]]/c[a][[x]], 20], 10], {x, 2, 96}], {a, 2, 7}], 
 TableHeadings -> {Table["a=" <> ToString[x], {x, 2, 7}], 
   Table["x=" <> ToString[x], {x, 1, 100}]}]
POSTED BY: Marvin Ray Burns A.G.S. (cum laude)

Going back to the convergent series, simplify the notation and define,

 Clear[m]; m = 
 Table[N[Sum[n^(1/n)/n^x, {n, 1, Infinity}], 50], {x, 2, 100}];
n = Table[N[Sum[n^(x/n)/n^x, {n, 1, Infinity}], 50], {x, 2, 100}];

 a = Table[((n[[x]] - 1)/(m[[x]] - 1)), {x, 1, 99}];

a1 = Table[a[[x + 1]]/a[[x]], {x, 1, 98}]; a1[[90 ;; 98]]

(*{1.4142135623730948387945, 1.414213562373094905421, \
1.414213562373094950919, 1.414213562373094981986, \
1.41421356237309500320, 1.41421356237309501768, \
1.41421356237309502756, 1.41421356237309503431, 1.4142135623730950389}*)

We get Sqrt[2].

Reverse m and n and the reciprocal behaves half way like a linear function. in that f(a x) == a f(x): so that we get 1/Sqrt[2]..

 b = Table[(m[[x]] - 1)/(n[[x]] - 1), {x, 1, 99}];

b1 = Table[b[[x + 1]]/b[[x]], {x, 1, 98}]; b1[[90 ;; 98]]

(*{0.7071067811865476294044, 0.7071067811865475960914, \
0.707106781186547573342, 0.707106781186547557809, \
0.707106781186547547203, 0.70710678118654753996, \
0.70710678118654753502, 0.70710678118654753165, \
0.70710678118654752935}*)
POSTED BY: Marvin Ray Burns A.G.S. (cum laude)

Concerning the Mathematica NSum error found in the previous post, It can be eliminated by NSumTerms.

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

(* 0.18785964246206712024851793405427323005590309490013878617200468408947\
 7231564660213703296654433107496903842345856258019061231370094759226630\
 438929348896184120837336626081613602738126379373435283224982*)

slll = Table[
    NSum[(-1)^n (n^(1/n) - w/n), {n, 1, Infinity}, 
      Method -> "AlternatingSigns", WorkingPrecision -> 100, 
      NSumTerms -> 500] - (Log[2^w] - 1/2 + m), {w, 450}]; Print[
   N[slll, 30]]

Gives all near 0's

ListPlot[slll]

enter image description here

So by extending sum to divergent series in the regularization method used by Mathematica's NSum,

Sum[(-1)^n (n^(1/n) - w/n),{n,1,Infinity}] == Log[2^w] - 1/2 + m. == w Log[2] - 1/2 +m

Proof by adding two series:

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

has a midpoint (the mean of the upper limit point and the lower middle point) at - 1/2 + m and treat that as the sum of a convergent series.

Sum[(-1)^n (w/n), {n, 1, Infinity}]

is the same as w Log[2]

POSTED BY: Marvin Ray Burns A.G.S. (cum laude)

I checked for round off error in the following and found some evidence of an error on Mathematica's part..

To keep expanding our list of identities,

Let m be the MRB constant:

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

    (* 0.18785964246206712024851793405427323005590309490013878617200468408947\
     7231564660213703296654433107496903842345856258019061231370094759226630\
     438929348896184120837336626081613602738126379373435283224982*)

Then m- Sum[(-1)^n (n^(1/n) - x/n)]==1/2 - Log[2^x]) for x up to and including x=20,

   sl = Table[(m - 
     NSum[(-1)^n (n^(1/n) - x/n), {n, 1, Infinity}, 
      Method -> "AlternatingSigns", WorkingPrecision -> 200]) - (
      1/2 - Log[2^x]), {x, 2, 350}];Print[N[sl[[1 ;; 19]], 30],
       N[sl[[340 ;; 349]], 30]]
    (* {1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194,1.2429*10^-194
,0.0259183374259628836676682211919}
{2.26076864811449590986989210226*10^-14,-8.88315735092798090493028735628*10^-15,3.41440692151960990535420984521*10^-15,-1.28342528622733270311828562834*10^-15,4.71627690575458679289370587222*10^-16,-1.69380112008895556586806590448*10^-16,5.94313651116753436913326660086*10^-17,-2.03661686166157149664474358887*10^-17,6.81377121338534361189573743102*10^-18,-2.22478627625166599855471551340*10^-18,7.08668056816025010760503247866*10^-19}
*)

x=20 is the 18th element of sl. Notice that the 19th element is ,0.0259183374259628836676682211919.

But for x>20 something beautiful happens:

ListPlot[sl]

enter image description here

The reason for the poor behavior is that Sum[(-1)^n (n^(1/n) - x/n)] for x/n not equal to 1 is divergent. and as x gets large x/n is further from 1 and

NSum[(-1)^n (n^(1/n) - x/n), {n, 1, Infinity}, Method -> "AlternatingSigns", WorkingPrecision -> 200] /. x -> 10^t

for the most part goes to 10^(t - 1) Log[2^10] - 1/2 + m) as t gets large:

Table[NSum[(-1)^n (n^(1/n) - 10^t/n), {n, 1, Infinity}, 
   Method -> "AlternatingSigns", 
   WorkingPrecision -> 200] - (10^(t - 1) Log[2^10] - 1/2 + m), {t, 
  10}]
(* {-1.3908983*10^-190, \
-0.0018047654004370285056973513785100572645865454457815534444526025649\
6588183515222563305775295474928095349258443231532776865726011389856029\
989033125798213015705226943409189152746974520337737698733944, \
-1.402096*10^-190, -1.50389*10^-190, -2.5218*10^-190, \
-1.2701*10^-189, -1.1450*10^-188, -1.1325*10^-187, -1.1312*10^-186, \
-1.1311*10^-185}*)

Notice that 

NSum[(-1)^n (n^(1/n) - s^t/n), {n, 1, Infinity}, 
  Method -> "AlternatingSigns", 
  WorkingPrecision -> 
   200]

for the most part goes to (s^(t - 1) Log[2^s] - 1/2 + m) Enter the following:

Table[N[NSum[(-1)^n (n^(1/n) - s^t/n), {n, 1, Infinity}, 
     Method -> "AlternatingSigns", 
     WorkingPrecision -> 200] - (s^(t - 1) Log[2^s] - 1/2 + m), 
   10], {t, 10}, {s, 10}] // TableForm

In general we have, NSum[(-1)^n (n^(1/n) - w/n), {n, 1, Infinity}, Method -> "AlternatingSigns", WorkingPrecision -> 200]

going to ( Log[2^w] - 1/2 + m). See next:

 sll = Table[
   NSum[(-1)^n (n^(1/n) - w/n), {n, 1, Infinity}, 
     Method -> "AlternatingSigns", 
     WorkingPrecision -> 200] - (Log[2^w] - 1/2 + m), {w, 450}]; Print[
  Print[N[sll[[1 ;; 20]], 30], N[sll[[340 ;; 349]], 30]]

  (*{-1.3907965*10^-190,-1.3908079*10^-190,-1.3908192*10^-190,-1.3908305*10^-190,-1.3908418*10^-190,-1.3908531*10^-190,-1.3908644*10^-190,-1.3908757*10^-190,-1.3908870*10^-190,-1.3908983*10^-190,-1.3909097*10^-190,-1.3909210*10^-190,-1.3909323*10^-190,-1.3909436*10^-190,-1.3909549*10^-190,-1.3909662*10^-190,-1.3909775*10^-190,-1.3909888*10^-190,-1.3910001*10^-190,
-0.0259183374259628836676682211919}
{-1.394631*10^-190,-1.394642*10^-190,-1.394653*10^-190,-1.394665*10^-190,-1.394676*10^-190,-1.394687*10^-190,-1.394699*10^-190,-1.394710*10^-190,-1.394721*10^-190,-1.394733*10^-190}*)

This is the same formula we started with, yet the results are a little different giving some evidence of an error on Mathematica's part.

ListPlot[sll]

enter image description here
POSTED BY: Marvin Ray Burns A.G.S. (cum laude)

Like the upper limit of the divergent Sum[(-1)^n n^(1/n)] can be found in the convergent Sum[(-1)^n (n^(1/n) - 1)],

mm1=Table[N[Sum[(-1)^n (n^(1/n) - 1)/n^x, {n, 1, Infinity}], 30], {x, 2, 
  50}]; 
Table[(mm1[[x + 1]])/(mm1[[x]]), {x, 1, 48}]

Still goes to 1/2

And

nn1 = Table[
  N[Sum[(-1)^n (n^(x/n) - 1)/n^x, {n, 1, Infinity}], 30], {x, 2, 50}];
Table[(nn1[[x + 1]])/(nn1[[x]]), {x, 1, 48}]

Still goes to 1/Sqrt[2]

And the computation is a lot faster with the "-1" in the summation:

 Timing[
 Table[N[Sum[(-1)^n (n^(1/n) - 1)/n^x, {n, 1, Infinity}], 30], {x, 2, 
    50}];]

(* {0.780005, Null}*)

 Timing[
 Table[N[Sum[(-1)^n (n^(1/n))/n^x, {n, 1, Infinity}], 30], {x, 2, 
    50}];]

(* {6.864044, Null}*)
POSTED BY: Marvin Ray Burns A.G.S. (cum laude) 
 mn1 = Table[
   N[Sum[(-1)^n (n^(x/n) - 1)/n, {n, 1, Infinity}], 30], {x, 2, 
    200}]; Table[(mn1[[x + 1]])/(mn1[[x]]), {x, 1, 198}]

Very, very slowly goes to 1/Log[2]
POSTED BY: Marvin Ray Burns A.G.S. (cum laude)

Thank you Daniel, I might have a chance to work on that tomorrow.
POSTED BY: Marvin Ray Burns A.G.S. (cum laude)

This should get you started. The limiting behavior of the first is explained by the fact that the first term hugely dominates, and approaches 1; the rest get small quickly as x increases.

The second (subtract off 1, take successive ratios) comes from the fact that the first terms approach 1 fast. The part to show is that it is fast enough that the difference between them and 1 becomes negligeable faster than the second terms decrease. So now the second terms dominate and we are looking at ratios approximating 2^(1/2-(x+1))/2^(1/2-x) which of course is 1/2.

I think I'll lleave the last for homework.
POSTED BY: Daniel Lichtblau
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard