4
$\begingroup$

This Mathematica program:

Clear[nn, t, n, k, i];
nn = 85;
t[1, 1] = 1;
t[n_, k_] := 
  t[n, k] = If[n >= k, Exp[-Sum[N[t[n - i, k]], {i, 1, k - 1}]], 1];
Table[t[nn, k]^-1, {k, 1 + 1, 12 + 1}]
Table[N[n/ProductLog[n]], {n, 1, 12}]

seems to give LambertW(n)/n for n=1 to 12 by tetration.

Output:

{1.76322, 2.34575, 2.85739, 3.32732, 3.76868, 4.18881, 4.59206, 4.98129, 5.36656, 5.72993, 6.07439, 6.44781}

Compared to Mathematicas buildt-in n/LambertW(n):

{1.76322, 2.34575, 2.85739, 3.32732, 3.76868, 4.18876, 4.59214, \ 4.9819, 5.36028, 5.72893, 6.08911, 6.44186}

Works much better in Microsoft Excel:

=IF(OR(ROW()=1; COLUMN()=1); 1; IF(ROW()>=COLUMN(); EXP(-SUM(INDIRECT(ADDRESS(ROW()-COLUMN()+1; COLUMN(); 4)&":"&ADDRESS(ROW()-1; COLUMN(); 4); 4)));1))

(Excel formula needs to be entered in cell A1, filled down to about row 1000. Each column then has the reciprocal value.

In latex the the recurrence is:

$$t(1,1)=1$$ $$t(\text{n$\_$},\text{k$\_$})\text{:=}t(n,k)=\text{If}\left[n\geq k,\exp \left(-\sum _{i=1}^{k-1} t(n-i,k)\right),1\right]$$

In english the recurrence is:

If $n$ is greater than equal to $k$: $$t(n,k)=\exp \left(-\sum _{i=1}^{k-1} t(n-i,k)\right)$$ else $$t(n,k)=1$$

The infinite table $t(n,k)$ of tetration starts:

$$\begin{array}{llllll} 1 & 1 & 1 & 1 & 1 & 1 \\ \frac{1}{e} & 1 & 1 & 1 & 1 & 1 \\ e^{-1/e} & \frac{1}{e^2} & 1 & 1 & 1 & 1 \\ e^{-e^{-1/e}} & e^{-1-\frac{1}{e^2}} & \frac{1}{e^3} & 1 & 1 & 1 \\ e^{-e^{-e^{-1/e}}} & e^{-\frac{1}{e^2}-e^{-1-\frac{1}{e^2}}} & e^{-2-\frac{1}{e^3}} & \frac{1}{e^4} & 1 & 1 \\ e^{-e^{-e^{-e^{-1/e}}}} & e^{-e^{-1-\frac{1}{e^2}}-e^{-\frac{1}{e^2}-e^{-1-\frac{1}{e^2}}}} & e^{-1-\frac{1}{e^3}-e^{-2-\frac{1}{e^3}}} & e^{-3-\frac{1}{e^4}} & \frac{1}{e^5} & 1 \end{array}$$

The claim is that $\lim_{n->\infty}\text{LambertW(k)/k} = t(n,k)$

Why does it work? Is it known?

Link to limit representation of LambertW

LambertW(x) is also called ProductLog(x).


Tetration appears to work for complex numbers too:

Clear[nn, t, n, k, i];
nn = 85;
t[1, 1] = 1;
t[n_, k_] := 
  t[n, k] = If[n >= k, Exp[-Sum[N[I*t[n - i, k]], {i, 1, k - 1}]], I];
Table[t[nn, k]*(k - 1)*I, {k, 1 + 1, 6 + 1}]
Table[N[ProductLog[n*I]], {n, 1, 6}]

recurrence output: {0.374699 + 0.576413 I, 0.683408 + 0.743386 I, 0.898668 + 0.826935 I, 1.06393 + 0.87901 I, 1.19448 + 0.915874 I, 1.31837 + 0.936584 I}

compared too Mathematica: {0.374699 + 0.576413 I, 0.683408 + 0.743386 I, 0.89871 + 0.826955 I, 1.06384 + 0.879803 I, 1.19805 + 0.917331 I, 1.31129 + 0.945888 I}


Tetration of integer multiples of 1/ZetaZero[1]:

Clear[nn, t, n, k, i];
nn = 75;
t[1, 1] = 1;
t[n_, k_] := 
  t[n, k] = 
   If[n >= k, 
    Exp[-Sum[N[(1/ZetaZero[1])*t[n - i, k]], {i, 1, k - 1}]], (1/
      ZetaZero[1])];
Table[t[nn, k]*(k - 1)*(1/ZetaZero[1]), {k, 1 + 1, 6 + 1}]
Table[N[ProductLog[n*(1/ZetaZero[1])]], {n, 1, 6}]

Tetration of n*(1/ZetaZero[1]):

{0.00736674 - 0.0697969 I, 0.0235635 - 0.136089 I, 0.0466203 - 0.197008 I, 0.07436 - 0.251797 I, 0.104914 - 0.300521 I, 0.136894 - 0.343688 I}

Mathematicas ProductLog[n*(1/ZetaZero[1])]:

{0.00736674 - 0.0697969 I, 0.0235635 - 0.136089 I, 0.0466203 - 0.197008 I, 0.07436 - 0.251797 I, 0.104914 - 0.300521 I, 0.136894 - 0.343688 I}


In[217]:= Clear[a, b, c, d]
a = 1;
b = 1;
c = 1;
d = 1;
e = 1;
f = 1;
Do[
 a = N[Exp[(-a - b - c - d - e - f)]];
 b = N[Exp[(-a - b - c - d - e - f)]];
 c = N[Exp[(-a - b - c - d - e - f)]];
 d = N[Exp[(-a - b - c - d - e - f)]];
 e = N[Exp[(-a - b - c - d - e - f)]];
 f = N[Exp[(-a - b - c - d - e - f)]];
 , {n, 1, 575}]
a

Out[225]= 0.238734

In[226]:= N[LambertW[6]/6]

Out[226]= 0.238734

By integrating the variables in the do loop:

Clear[nn, t, n, k, i];
nn = 85;
t[1, 1] = 1;
t[n_, k_] := 
  t[n, k] = 
   If[n >= k, Exp[-Sum[N[(t[n - i, k]^2)/2], {i, 1, k - 1}]], 1];
Table[t[nn, k], {k, 1 + 1, 6 + 1}]
Table[N[Sqrt[ProductLog[n]/n]], {n, 1, 6}]

we appear to get:

$$\sqrt{\frac{W(n)}{n}}$$

Integrating once more:

Clear[nn, t, n, k, i];
nn = 85;
t[1, 1] = 1;
t[n_, k_] := 
  t[n, k] = 
   If[n >= k, Exp[-Sum[N[(t[n - i, k]^3)/6], {i, 1, k - 1}]], 1];
Table[t[nn, k], {k, 1 + 1, 12 + 1}]
Table[N[(ProductLog[n/2]/(n/2))^(1/3)], {n, 1, 12}]

we appear to get:

$$\sqrt[3]{\frac{W\left(\frac{n}{2}\right)}{\frac{n}{2}}}$$

Doing:

Clear[nn, t, n, k, i];
nn = 85;
t[1, 1] = 1;
t[n_, k_] := 
  t[n, k] = 
   If[n >= k, Exp[-Sum[N[(t[n - i, k]^(1/2))*2], {i, 1, k - 1}]], 1];
Table[t[nn, k], {k, 1 + 1, 6 + 1}]
Table[N[(ProductLog[n]/n)^2], {n, 1, 6}]

we appear to get:

$$\left(\frac{W(n)}{n}\right)^2$$

Shifting to normal exponentiation:

Clear[nn, t, n, k, i];
nn = 75;
t[1, 1] = 1;
t[n_, k_] := 
  t[n, k] = 
   If[n >= k, k^(-Sum[N[(t[n - i, k])/(k - 1), 12], {i, 1, k - 1}]), 
    1];
Table[t[nn, k], {k, 1 + 1, 6 + 1}] 
Table[N[ProductLog[Log[n]]/Log[n], 12], {n, 1 + 1, 6 + 1}]

we seem to get:

$$\frac{W(\log (n))}{\log (n)}$$


Better do-loops:

Clear[a, b, c, d, bigNumber]
a = RandomReal[] 10;
b = RandomReal[] 10;
c = RandomReal[] 10;
bigNumber = 10000000000000000000000000;
Monitor[Do[
  a = Round[(Exp[-(a + b + c)])*bigNumber]/bigNumber;
  b = Round[(Exp[-(a + b + c)])*bigNumber]/bigNumber;
  c = Round[(Exp[-(a + b + c)])*bigNumber]/bigNumber;
  , {n, 1, 2000}], n]
N[a, 30]
N[b, 30]
N[c, 30]
N[LambertW[3]/3, 30]

Clear[a, b, c, d, bigNumber]
a = RandomReal[] 10;
b = RandomReal[] 10;
c = RandomReal[] 10;
d = RandomReal[] 10;
bigNumber = 10000000000000000000000000;
Monitor[Do[
  a = Round[(Exp[-(a + b + c + d)])*bigNumber]/bigNumber;
  b = Round[(Exp[-(a + b + c + d)])*bigNumber]/bigNumber;
  c = Round[(Exp[-(a + b + c + d)])*bigNumber]/bigNumber;
  d = Round[(Exp[-(a + b + c + d)])*bigNumber]/bigNumber;
  , {n, 1, 2000}], n]
N[a, 30]
N[b, 30]
N[c, 30]
N[d, 30]
N[LambertW[4]/4, 30]
$\endgroup$
  • 1
    $\begingroup$ Hi Mats - for me it is way too much information in this question; this kept me always away from dealing with it. I had to learn myself a couple of monthes ago that this site should serve primarily for focused questions and not the discussion/presentation of a whole project. (well, today I had a lot of time and mood, so I gave it a try anyway, see below) $\endgroup$ – Gottfried Helms Feb 18 '14 at 10:56
  • $\begingroup$ what significance does the 1st zeta zero have here? Or was that just some random transcendental number you chose for demonstration purposes? $\endgroup$ – crow Dec 8 '16 at 22:37
  • $\begingroup$ @crow Yes the first zetazero was chosen only as a random transcendental number for demonstration purposes, as you said. Since the Riemann hypothesis is still unproven and nothing useful is known about the zeta zeros I should in retrospect not have used that number since at a first glance it can give the impression that I know something more about the zeta zeros, which I don't. $\endgroup$ – Mats Granvik Dec 9 '16 at 14:09
  • $\begingroup$ no worries, thanks for the clarification ;) $\endgroup$ – crow Dec 13 '16 at 3:02
3
$\begingroup$

Concerning the first question. Let's rewrite the generation-rule of the columns of your table $t(n,k)$ (where it would be helpful a) if we would write $t(r,c)$ to make clear what is column- and what row index and b) if it would be explicite, whether it begins wiith 0 or 1 - there are different conventions around).


Well. For column $0$ we have $$ x_{0} = 1 \qquad \qquad x_k=\exp(-x_{k-1})$$
If we assume, that this converges with the index $k$ to some $$c_0= \lim_{k \to \infty} x_k $$ then we have approximation to the equality $$ \begin{array} {} &c_0 &=& \exp (-c_0) \\ &c_0 \cdot \exp c_0 &=& 1 \end{array}$$ and it follows $$ \begin{array} {} \to& c_0 &=& W(1) \end{array} $$


For the next column ($1$) we have $$ x_{0} = 1 \\ x_{1} = 1 \\ x_k=\exp(-(x_{k-1}+x_{k-2}))$$
If again we assume, that this converges such that $x_k$ with high indices approach equality and $$c_1= \lim_{k \to \infty} x_k $$then in the limit we can write $$ \begin{array} {} &c_1 &=& \exp (-(c_1+c_1)) \\ &c_1 \cdot \exp 2c_1 &=& 1 \\ &2c_1 \cdot \exp 2c_1 &=& 2 \\ \end{array}$$ and it follows $$ \begin{array} {} \to& 2c_1 &=& W(2) \\ & c_1 &=& W(2)/2 \\ \end{array} $$
I think it is easy to see, how this generalizes to the other columns.

Now after we have some idea what it would be if we had convergence, we must now attempt to prove that convergence or at least to find an interval of convergence.


Btw, the process reminds me more to the concept of "continued fractions" than fractional/generalized iteration of exponentials, so I would also tend to avoid the term "tetration" for this; it's somehow "continued reciprocal exponentiation" or the like and I think it has a nice and interesting flavour in its own. Remember the matrix-notation for the representation of the infinite periodic continued fractions, which converge to square roots of rational numbers.

[added] Here is a picture of the convergence-behaviour along the columns in the t(n,k)-table. Interesting the oscillation around, but towards, the fixpoint. Similar to the greater/smaller-approximation with the continued fractions...

The image

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.