Power Tower

Author

Eric W. Weisstein
December 4, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/SpecialFunctions/PowerTower.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/PowerTower.html.

©2008 Wolfram Research, Inc. except for portions noted otherwise

Initialization

PowerTower[x_,n_]:=Nest[Power[x,#]&,x,n-1]
PowerTower[x_]:=-ProductLog[-Log[x]]/Log[x]
PowerTower2[x_,n_]:=Power@@Table[x,{n}]
PowerSeries[x_]:=Sum[(i+1)^(i-1)Log[x]^i/i!,{i,0,Infinity}]

Examples

Table[PowerTower[x,n],{n,5}]

Table[PowerTower2[x,n],{n,5}]

(z^z)

Series

Series[(z^z),{z,0,4}]

SeriesCoefficient[(z^z),{z,0,n}]

Sum[(1/(n!))((Log[z])^n)(z^n),{n,0,∞}]

GeneratingFunction[(x^x),x,n]

ExponentialGeneratingFunction[(x^x),x,n]

Derivative

D[x^x,x]

Minimum

Solve[(1+Log[x])==0,x]

x^x /. x->1/E

Indefinite Integral

Integrate[x^x,x]

Definite Integrals

(∫_0^1)(x^x)dx

Through[{Integrate,NIntegrate}[x^x,{x,0,1}]]

Through[{Sum,NSum}[((((-1))^(n+1))/(n^n)),{n,∞}]]

NSum[(-1)^(n+1)/n^n,{n,Infinity},WorkingPrecision->200,NSumExtraTerms->100]

(∫_0^1)(x^(-x))dx

Through[{Integrate,NIntegrate}[(x^(-x)),{x,0,1}]]

Through[{Sum,NSum}[(1/(n^n)),{n,∞}]]

NSum[1/n^n,{n,Infinity},WorkingPrecision->200,NSumExtraTerms->100]

Plots

Real Axis

Plot[x^x,{x,0,4},AxesLabel->TraditionalForm/@{x,x^x},PlotStyle->Red]

<<Utilities`Plot`

Show[GraphicsArray[
ComplexPlot3D[z^z,{z,-#,#},PlotPoints->70,
DisplayFunction->Identity,
Mesh->False,ClipFill->None][[1]]&/@{2,5}
]
]//Timing

Show[GraphicsArray[
ComplexContourPlot[z^z,{z,-#,#},DisplayFunction->Identity][[1]]&/@{2,5}
]
]//Timing

(z^(1/z))

With[{x=3.4},{1+((2(x-1))/((x^2)+1+ContinuedFractionK[-((n^2)(x^2)-1)(((x-1))^2),(2n+1)x(x+1),{n,20}])),(x^(1/x))}]

1+((2(x-1))/((x^2)+1+ContinuedFractionK[-((n^2)(x^2)-1)(((x-1))^2),(2n+1)x(x+1),{n,∞}]))

(z^(z^z))

Plots

Real Axis

Plot[x^x^x,{x,0,2.5},AxesLabel->TraditionalForm/@{x,x^x^x},PlotStyle->Red,
PlotRange->{Automatic,{0,10^3}}]

Show[GraphicsArray[
ComplexPlot3D[z^z^z,{z,-#,#},PlotPoints->150,
DisplayFunction->Identity,
Mesh->False,ClipFill->None][[1]]&/@{2,5}
]
]//Timing

Show[GraphicsArray[
ComplexContourPlot[If[Abs[z^z^z]<10^100,z^z^z,10^100],{z,-#,#},
ComplexPlotLabel->z^z^z,
DisplayFunction->Identity][[1]]&/@{2,5}
]
]//Timing

n, (n^n), (n^(n^n)),(n^(n^(n^⋰)))

Table[PowerTower[n,1],{n,10}]

Table[PowerTower[n,2],{n,10}]

Table[PowerTower[n,3],{n,4}]

Table[PowerTower[n,4],{n,3}]

Table[PowerTower[1,a],{a,10}]

Table[PowerTower[2,a],{a,4}]

Table[PowerTower[3,a],{a,4}]

Table[PowerTower[4,a],{a,4}]

2, (2^2),(2^(2^2)), (2^(2^(2^(⋰)))),…

Table[PowerTower[1,n],{n,5}]

N[Table[PowerTower[2,n],{n,6}],10]

Table[PowerTower[3,n],{n,4}]//N

Table[PowerTower[4,n],{n,4}]//N

h(x)

Plots

Plot[PowerTower[x],{x,0,1.5},AxesLabel->TraditionalForm/@{x,h[x]},PlotStyle->Red]

<<Utilities`Plot`
<<Utilities`Typesetting`

ComplexPlot3D[PowerTower[z],{z,-5,5},ComplexPlotLabel->TraditionalForm[h[z]]]//Timing

ComplexContourPlot[PowerTower[z],{z,-5,5},ComplexPlotLabel->TraditionalForm[h[z]]]//Timing

ProductLog

Solve[Log[h]/h==Log[x],h]

Special Values

PowerTower[I]

N[%,20]

Knöbel Series

V5

PowerSeries[x]

PowerSeries[1.2]//N

PowerTower[1.2]

V7

Sum[(((((n+1))^n)((Log[z])^n))/((n+1)!)),{n,0,∞}]

Series[-((ProductLog[-Log[z]])/(Log[z])),{Log[z],0,5}]

Table[((((n+1))^n)/((n+1)!)),{n,6}]

FullSimplify[Series[-((ProductLog[-Log[z]])/(Log[z])),{z,0,1}],z>1]

SeriesCoefficient[-((ProductLog[-Log[z]])/(Log[z])),{Log[z],0,n}]

FullSimplify[%,n∈Integers]

g(x)

g[x_,n_]:=x^Fold[Power[1/x,#]&,1/x,Table[x,{n-1}]];

g[x_]:=Log[x]/ProductLog[Log[x]]

g[x,3]

Analytic Solution

Solve[g Log[g]==Log[x],g]

Reduce[g^g==x&&x>0,g]

Simplify[%,x>0]

FullSimplify[C[1]∈Integers&&2 π C[1]-I Log[x]≠0&&x>0]

g[16.1234,2000]

values=Table[Exp[ProductLog[i,2Pi I n+Log[#]]],{i,-1,1},{n,-10,10}]&[16.1234]

Select[Flatten[values],Im[#]==0&]

Reduce[g Log[g]==Log[x]&&x>0,g]

Plot[g[x,2000],{x,Exp[-1/E],25},AxesLabel->TraditionalForm/@{x,HoldForm[g[x]]},PlotStyle->Red,Epilog->{Blue,Dashing[{.02}],Line[{{#,0},{#,20}}]&/@{Exp[-1/E],Exp[E]}}
]

(a^((((a^2)))^((((a^3)))^((((a^4)))^((((a^5)))^(a^6))))))

Power@@Table[a^k,{k,6}]

v=Reverse[NestList[Drop[#,-1]&,power@@Table[a^k,{k,20}],19]]/.power->Power;

Take[v,5]

ListPlot[v/.a->1/2,PlotJoined->True,PlotRange->All]

h=N[v/.a->1/2,20]

N[v/.a->1/3,20]

N[v/.a->2/3,20]

N[v/.a->1/7,20]

(a^((((a^2)))^((((a^4)))^((((a^8)))^((((a^16)))^((((a^32)))^(a^64)))))))

Power@@Table[a^(2^k),{k,0,6}]

v=Reverse[NestList[Drop[#,-1]&,power@@Table[a^(2^k),{k,0,20}],20]]/.power->Power;

Take[v,5]

ListPlot[v/.a->1/2,PlotJoined->True,PlotRange->All]

N[v/.a->1/2,20]