Cantor Function

Author

Eric W. Weisstein
February 17, 2014

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

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

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

Additional Authors

Code based on
Stan Wagon
Mathematica in Action, 2nd ed.
p. 133

Code

spawn[{a_Rational,b_Rational}]:=Module[{w=(b-a)/3},{{a-2 w,a-w},{b+w,b+2 w}}]
spawn[intervals_List]:=spawn/@intervals

f[0]=0;
f[x_]:=f[3 x]/2/;x≤1/3
f[x_]:=1-f[1-x]/;x ≥ 2/3

CantorFunctionIntervals[n_]:=CantorFunctionIntervals[n]=Module[
{
intervals=Flatten[Union[{0,1},Cases[NestList[spawn,{1/3,2/3},n],_Rational,∞]]]
},
intervals
]

CantorFunctionPlot[n_,opts___] := Module[
{intervals=CantorFunctionIntervals[n]},ListPlot[Transpose[{intervals,f/@intervals}],opts,PlotJoined->True,Axes->True]
]

CantorFunctionValues[n_]:=Module[{intervals=CantorFunctionIntervals[n]},{Transpose[{intervals,f/@intervals}]}
]

CantorFunction[x_?NumericQ,n_:5]:=f[Select[CantorFunctionIntervals[n],#>=x&,1][[1]]]

Identities

bug(265443)

(CantorStaircase[(x/3)])==((CantorStaircase[x])/2)

FullSimplify[CantorStaircase[x/3]-CantorStaircase[x]/2,0<=x<=1]

Table[CantorStaircase[x/3]-CantorStaircase[x]/2,{x,0,1,.1}]//Chop

(CantorStaircase[1-x])==1-(CantorStaircase[x])

FullSimplify[CantorStaircase[1-x]-(1-CantorStaircase[x]),0<=x<=1]

Table[CantorStaircase[1-x]-(1-CantorStaircase[x]),{x,0,1,.1}]//Chop

Values

CantorFunctionIntervals[3]

CantorFunctionValues[3]

CantorFunction[#,5]&/@{0,1/3,2/3,1/9,2/9,7/9,8/9,1/27,2/27,7/27,8/27,19/27,20/27,25/27,26/27,1}

Plot

V5

Plot[CantorFunction[x,6],{x,0,1},PlotPoints->100,PlotStyle->Red]

V6

CantorFunctionPlot[6,PlotStyle->Red,AxesLabel->{x,HoldForm[F][x]}]

V10

Plot[CantorStaircase[x],{x,0,1},AxesLabel->{x,F[x]},BaseStyle->FontFamily->"Times",PlotStyle->Red]

Integrals

Integer Powers

Table[Integrate[CantorStaircase[x]^n,{x,0,1}]//Timing,{n,2}]

Table[NIntegrate[CantorStaircase[x]^n,{x,0,1}]//Timing,{n,2}]

Table[NIntegrate[CantorFunction[x,5]^n,{x,0,1},MaxRecursion->20],{n,5}]//Timing

Table[Plus@@Times@@@({Plus@@((CantorFunction/@#)^n),-Subtract@@#}&/@Partition[CantorFunctionIntervals[8],2,1]),{n,5}]/2//N

i[3,n]

i[q_,n_]:=(1/(n+1))-(q-2)Sum[Binomial[n,k](((2^(k-1))-1)/(q (2^(k-1))-1))((BernoulliB[k])/(n-k+1)),{k,2,n,2}]

Table[i[3,n],{n,10}]

i2[q_,n_]:=(1/(n+1))-(q-2)Sum[Binomial[n,2k](((2^(2k-1))-1)/(q (2^(2k-1))-1))((BernoulliB[2k])/(n-2k+1)),{k,n/2}]

Table[i2[3,n],{n,10}]

i2[3,n]

Through[{Numerator,Denominator}[Table[i2[3,n],{n,10}]]]

(∫_0^1)((CantorStaircase[x])^(CantorStaircase[x]))dx

Integrate[CantorStaircase[x]^CantorStaircase[x],{x,0,1}]//Timing

Plot[CantorStaircase[x]^CantorStaircase[x],{x,0,1}]

NIntegrate[CantorStaircase[x]^CantorStaircase[x],{x,0,1}]//Timing

NIntegrate[CantorStaircase[x]^CantorStaircase[x],{x,0,1},WorkingPrecision->10]//Timing

NIntegrate[CantorStaircase[x]^CantorStaircase[x],{x,0,1},WorkingPrecision->20]//Timing

NIntegrate[CantorStaircase[x]^CantorStaircase[x],{x,0,1},WorkingPrecision->20,MaxRecursion->20]//Timing

NIntegrate[CantorStaircase[x]^CantorStaircase[x],{x,0,1},WorkingPrecision->50,MaxRecursion->20]//Timing

NIntegrate[CantorStaircase[x]^CantorStaircase[x],{x,0,1},Method->"DoubleExponential",WorkingPrecision->20]//Timing

NIntegrate[CantorFunction[x,5]^CantorFunction[x,5],{x,0,1},MaxRecursion->20]//Timing

NIntegrate[CantorFunction[x,5]^CantorFunction[x,5],{x,0,1},MaxRecursion->20,WorkingPrecision->10]//Timing

NIntegrate[CantorFunction[x,6]^CantorFunction[x,6],{x,0,1},MaxRecursion->20,WorkingPrecision->10]//Timing

NIntegrate[CantorFunction[x,6]^CantorFunction[x,6],{x,0,1},MaxRecursion->20,WorkingPrecision->15]//Timing

SequenceLimit

(l=Table[Plus@@Times@@@({(c=CantorFunction[#[[1]]])^c,-Subtract@@#}&/@Partition[Rest[CantorFunctionIntervals[n]],2,1]),{n,15}]//N[#,50]&);//Timing

(l=Table[Plus@@Times@@@({(c=CantorFunction[#[[1]]])^c,-Subtract@@#}&/@Partition[Rest[CantorFunctionIntervals[n]],2,1]),{n,16}]//N[#,110]&);//Timing

ListPlot[l,PlotJoined->True,PlotStyle->Red,AxesLabel->TraditionalForm/@{n,i[n]}]

SequenceLimit/@NestList[Rest,l,11]