Copeland-Erdős Constant Continued Fraction

Author

Eric W. Weisstein
September 14, 2013

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Constants/Copeland-ErdosConstantContinuedFraction.nb.

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

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

Compute

Read constant

Get["/Developer/eww/Constants/CopelandErdos_10_8.mx"];//Timing//AbsoluteTiming

{ByteCount[cons],MaxMemoryUsed[]}/10^6. MB

Compute

(10^6)

{$MachineName,DateString[],$TopDirectory,$Version}//Column

N[cons]

Precision[cons]

Length[cf=ContinuedFraction[cons]]//Timing

{ByteCount[cf],MaxMemoryUsed[]}/10^6. GB

DumpSave["/Developer/eww/ContinuedFractions/CopelandErdos_969357.mx",cf];

(10^8)

{$MachineName,DateString[],$TopDirectory,$Version}//Column

{N[cons],Precision[cons]}

Length[cf=ContinuedFraction[cons]]//Timing

{ByteCount[cf],MaxMemoryUsed[]}/10^9. GB

DumpSave["/Developer/eww/ContinuedFractions/CopelandErdos_98456832.mx",cf];

(10^9)

{$MachineName,DateString[],$TopDirectory,$Version}//Column

{N[cons],Precision[cons]}

Length[cf=ContinuedFraction[cons]]//Timing

{ByteCount[cf],MaxMemoryUsed[]}/10^9. GB

DumpSave["/Developer/eww/ContinuedFractions/CopelandErdos_1011597392.mx",cf];

Plot

CopelandErdosTerms[n_]:=ToExpression["0."<>StringJoin@@ToString/@Prime[Range[n]]]

l1=IntegerLength[ContinuedFraction[CopelandErdosTerms[1000]]];//Timing

p1=ListPlot[Log10@l1,PlotRange->All,Filling->Axis,PlotLabel->"Copeland\[Hyphen]Erdős log(c.f. digit count)",AxesLabel->{n,HoldForm@Log10[Subscript[d,n]]}]

l2=IntegerLength[ContinuedFraction[N[ChampernowneNumber[10],5*^7],2000]];//Timing

p2=ListPlot[Log10@l2,PlotRange->All,Filling->Axis,PlotLabel->"Champernowne log(digit count)",AxesLabel->{n,HoldForm@Log10[Subscript[d,n]]}]

GraphicsRow[{p1,p2},Spacings->-50,ImageSize->400]

High Water Marks

A033310

A224890

(10^6)

Length[cf]

Take[cf,20]

(hwm=HighWaterMarks[cf])//Timing

{hwm[[1]],hwm[[2]]-1}

(10^8)

Length[cf]

Take[cf,20]

(hwm=HighWaterMarks[cf])//Timing

{hwm[[1]],hwm[[2]]-1}

Length/@%62

(10^9)

Length[cf]

(hwm=HighWaterMarks[cf]);//Timing

{hwm[[1]],hwm[[2]]-1}

Length/@hwm

First Occurrences

A224891

(10^6)

Length[cf]

Loop

fo=FirstOccurrences[cf];//Timing

p=Take[Position[fo,0],10]//Flatten

Take[fo,20]-1

BFile["~/b224891.txt",Take[fo,p[[1]]-1]-1]

ListPlot[Take[fo,p[[1]]-1]-1,AxesLabel->{Subscript[a,n],n},PlotRange->All]

Clear[fo]

(10^8)

Length[cf]

Loop

fo=FirstOccurrences[cf];//Timing

p=Take[Position[fo,0],10]//Flatten

Take[fo,20]-1

BFile["~/b224891.txt",Take[fo,p[[1]]-1]-1]

ListPlot[Take[fo,p[[1]]-1]-1,AxesLabel->{Subscript[a,n],n},PlotRange->All]

Clear[fo]

(10^9)

Length[cf]

Loop

fo=FirstOccurrences[cf];//Timing

p=Take[Position[fo,0],10]//Flatten

Take[fo,20]-1

BFile["~/b224891.txt",Take[fo,p[[1]]-1]-1]

ListPlot[Take[fo,p[[1]]-1]-1,AxesLabel->{Subscript[a,n],n},PlotRange->All]

Clear[fo]

n-Digit Terms

(10^6)

Length[cf]

digs=IntegerLength[cf];//Timing

Max[digs]//Timing

positions=Table[Flatten[Position[digs,n,1,20]],{n,11}];//Timing

data=MapIndexed[{#2[[1]],{#,cf[[#]]}}&,positions]

Grid[{#[[1]],Column@#[[2]]}&/@data,Dividers->All,Alignment->Left]

(10^9)

Length[cf]

digs=IntegerLength[cf];//Timing

Max[digs]//Timing

positions=Table[Flatten[Position[digs,n,1,20]],{n,15}];//Timing

data=MapIndexed[{#2[[1]],{#,cf[[#]]}}&,positions]

Grid[{#[[1]],Column@#[[2]]}&/@data,Dividers->All,Alignment->Left]

Khinchin and Lévy Constant

KhinchinList[x_,n_:200]:=MapIndexed[#1^(1/#2[[1]])&,Rest@FoldList[Times,1,Rest[ContinuedFraction[Mod[x,1],n+1]]]]
LevyList[x_,n_:200]:=MapIndexed[#1^(1/#2[[1]])&,Denominator/@FromContinuedFraction/@Reverse[NestList[Drop[#,-1]&,Rest[ContinuedFraction[Mod[x,1],n+1]],n]]]

<<Utilities`Typesetting`

With[{k=5000,c=CopelandErdos[...]},
g1=ListPlot[KhinchinList[c,k],Joined->True,PlotStyle->Red,AxesLabel->{n,((Subscript[a, 1])(Subscript[⋯a, n]))^InlineFraction[1,n]},
PlotLabel->"Khinchin's constant",
Epilog->{Blue,Dashing[{.02}],Line[{{0,#},{k,#}}]&[2.685452001]}];
g2=ListPlot[LevyList[c,k],Joined->True,PlotStyle->Red,AxesLabel->{n,(Subscript[q, n])^InlineFraction[1,n]},
PlotLabel->"Lévy constant",
Epilog->{Blue,Dashing[{.02}],Line[{{0,#},{k,#}}]&[Exp[Pi^2/12/Log[2]]]}
];
];

GraphicsRow[{g1,g2},Spacings->-50,ImageSize->400]