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

[bmmmburns (Marvin Ray Burns A.G.S. (cum laude))]

Consider 2 OEIS sequences:

A250091 Decimal expansion of 1+2^(1/2)+3^(1/3)+4^(1/4)+5^(1/5)+6^(1/6)+7^(1/7).

and

A037077 Decimal expansion of upper limit of - 1^(1/1) + 2^(1/2) - 3^(1/3) + … . (Also known as the MRB constant).

What happens when you take Sum[n^(1/n)/n^x, {n, 1, Infinity}], for larger and larger x? And what is an interesting property of the results?

Start with,

  ml = 
 Table[N[Sum[n^(1/n)/n^x, {n, 1, Infinity}], 30], {x, 2, 20}]

(*{1.87957850179922452548780902030, \
1.28433140829818311804978960294, 1.11649815901955280446360446952, \
1.05230243601496483918417757240, 1.02455966710449268950894930761, \
1.01181956555161661613504788502, 1.00577036801151528942775809119, \
1.00284169266529443639880816265, 1.00140701129195096425768601368, \
1.00069904553360492220816210358, 1.00034807151502562926666795815, \
1.00017356043075113117799946483, 1.00008662379823500633540883697, \
1.00004326025121731439904151647, 1.00002161302955915670254559274, \
1.00001080084552597690154618049, 1.00000539854026299833844244956, \
1.00000269864442366327406568283, 1.00000134911408655949085647188}*)

Then strip the one from the results so that you are left with the fractional part:

 Table[(ml[[x + 1]] - 1)/(ml[[x]] - 1), {x, 1, 18}]

(* {0.32325870597856601335264674468, \
0.40972666268855964950237000356, 0.4489550431967470748752560010, \
0.4695702337356838690155488021, 0.4812591922084509040893131359, \
0.488204747147076802354478580, 0.492462986697483171702127350, \
0.495131408520977249601439190, 0.49683008061408269065187630, \
0.49792395243647742451603934, 0.49863439913591189446856479, \
0.49909877418555419122177077, 0.4994037677723545403535596, \
0.4996048092875231735715817, 0.4997376927845338620069440, \
0.499825708090576356557523, 0.499884096847404516964014, \
0.499922877845513394172502}*)

It appears to go to 1/2.

If you replace 1/n with x’n you get the following.

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

 Table[(nl[[x + 1]] - 1)/(nl[[x]] - 1), {x, 1, 48}]

(* {0.46806917048762805165976009063, \
0.58552410491421033048161264365, 0.63715313842141044277734720504, \
0.66437715102933760259856891504, 0.6800914584690084265802970483, \
0.6896517396623494068107583992, 0.6956645339242514154420027322, \
0.6995308126570528621804163014, 0.7020551160673681928212474536, \
0.7037211349305621509391174590, 0.704829272421506701581292293, \
0.705570526527653090370011062, 0.706068434368063473135523002, \
0.706403915885726363146867730, 0.706630475283771278322974287, \
0.706783737809199814614774542, 0.706887548585582718794905601, \
0.70695793059744011259680719, 0.70700568235807212426782039, \
0.70703809747753197542542866, 0.70706011041940439375378651, \
0.70707506372292522997028901, 0.70708522368715768677252204, \
0.70709212797318195988585045, 0.7070968204128457956537715, \
0.7071000098814048194928538, 0.7071021779224227875086932, \
0.7071036517226710359058870, 0.7071046536265801869716379, \
0.7071053347497099814427328, 0.707105797806408367696005, \
0.707106112617028525990783, 0.707106326644497037070963, \
0.707106472154654201526278, 0.707106571082786572444759, \
0.707106638341462308732904, 0.707106684069050301189998, \
0.70710671515823764830212, 0.70710673629513577042717, \
0.70710675066569719374063, 0.70710676043596925704852, \
0.70710676707859684098774, 0.70710677159479918693162, \
0.7071067746652847275237, 0.7071067767528537886064, \
0.7071067781721555549972, 0.7071067791371142100420, \
0.7071067797931729427458}*)

Which appears to go to 1/Sqrt[2].

You get the same final results if you change the series to alternating series, using

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

and

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

I hope you find this interesting, as well!

[danl (Daniel Lichtblau)]

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.

[bmmmburns (Marvin Ray Burns A.G.S. (cum laude))]

Thank you Daniel, I might have a chance to work on that tomorrow.

[bmmmburns (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}*)

[bmmmburns (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, 1, 198}]

Very, very slowly goes to 1/Log[2]

[bmmmburns (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]

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]

[bmmmburns (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]

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]

[bmmmburns (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}*)

[bmmmburns (Marvin Ray Burns A.G.S. (cum laude))]

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.

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}]}]