Simple Continued Fraction

Author

Eric W. Weisstein
January 19, 2017

This notebook downloaded from http://mathworld.wolfram.com/notebooks/NumberTheory/SimpleContinuedFraction.nb.

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

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

Notation

Big-K

HoldForm[Subscript[b,0]+ContinuedFractionK[1,Subscript[b,i],{i,1,∞}]]//TraditionalForm

Options[TraditionalForm]

Nested

Removed around V9 timeframe

<<NumberTheory`ContinuedFractions`

?ContinuedFractionForm

ContinuedFractionForm[ContinuedFraction[Pi,7]]

Pringsheim

With[{top={Black,White,White,Black},bot={White,Black,Black,White}},Grid[{{Item[1,Frame->top]},{Item[Subscript[b,1],Frame->bot]}}]+Grid[{{Item[1,Frame->top]},{Item[Subscript[b,2],Frame->bot]}}]]//TraditionalForm

Closed Forms

(Underoverscript[\[ContinuedFractionK], (n=1), ∞])(1/n)==((BesselI[1, 2])/(BesselI[0, 2]))

ContinuedFractionK[n,{n,∞}]

N[%]

Table[FromContinuedFraction[Range[0,n]],{n,0,10}]

N[%]

(Underoverscript[\[ContinuedFractionK], n, ∞])(1/i) [diverges]

ContinuedFractionK[I,{n,∞}]

Properties

BasicPropertiesOfRegularContinuedFractionConvergents

Recurrence

ConvergentsByRecurrence[x_,n_]:=Module[{A,B,b=Rest[ContinuedFraction[x,n+1]]},
A[-1]=1;
A[0]=Floor[x];
B[-1]=0;
B[0]=1;
A[k_]:=b[[k]] A[k-1]+A[k-2];
B[k_]:=b[[k]] B[k-1]+B[k-2];
Table[A[k]/B[k],{k,0,n}]
]

c=ConvergentsByRecurrence[ξ=Sqrt[2]+E,10]

A[-1]:=1
A[-2]:=0
B[-1]:=0
B[-2]:=1
A[n_]:=Numerator[c[[n+1]]]
B[n_]:=Denominator[c[[n+1]]]

Convergents[ξ,11]

(Subscript[A, n])(Subscript[B, n-1])-(Subscript[A, n-1]) (Subscript[B, n])==(((-1))^(n-1))

Table[A[n]B[n-1]-A[n-1]B[n],{n,5}]

((Subscript[A, n])/(Subscript[B, n]))==(((Subscript[A, n+1])-(Subscript[A, n-1]))/((Subscript[B, n+1])-(Subscript[B, n])))

Subtract@@@Table[{((A[n])/(B[n])),((A[n+1]-A[n-1])/(B[n+1]-B[n-1]))},{n,1,9}]

((Subscript[A, n])/(Subscript[B, n]))-((Subscript[A, n+1])/(Subscript[B, n+1]))==((((-1))^(n+1))/((Subscript[B, n+1]) (Subscript[B, n])))

Subtract@@@Table[{((A[n])/(B[n]))-((A[n+1])/(B[n+1])),((((-1))^(n+1))/(B[n+1]B[n]))},{n,1,9}]

((Subscript[A, n])/(Subscript[B, n]))-((Subscript[A, n-1])/(Subscript[B, n-1]))==((((-1))^(n+1))/((Subscript[B, n]) (Subscript[B, n-1])))

Subtract@@@Table[{((A[n])/(B[n]))-((A[n-1])/(B[n-1])),((((-1))^(n+1))/(B[n]B[n-1]))},{n,1,9}]

((Subscript[A, n])/(Subscript[B, n]))-((Subscript[A, n-2])/(Subscript[B, n-2]))==((((Subscript[b, n])(-1))^n)/((Subscript[B, n])(Subscript[B, n-2])))

b[n_]:=cf[[n+1]]

Subtract@@@Table[{((A[n])/(B[n]))-((A[n-2])/(B[n-2])),((b[n](((-1))^n))/(B[n]B[n-2]))},{n,2,9}]

((Subscript[A, n])/(Subscript[A, n-1]))==[(Subscript[b, n]);(Subscript[b, n-1]),…,(Subscript[b, 0])]

c=ConvergentsByRecurrence[ξ=Pi,10]

A[-1]:=1
A[-2]:=0
B[-1]:=0
B[-2]:=1
A[n_]:=Numerator[c[[n+1]]];
B[n_]:=Denominator[c[[n+1]]];

cf=ContinuedFraction[ξ,10]

((A[4])/(A[3]))

Table[A[n]/A[n-1],{n,0,10}]

Table[FromContinuedFraction[Reverse[Take[cf,n+1]]],{n,0,8}]

((Subscript[B, n])/(Subscript[B, n-1]))==[(Subscript[b, n]);(Subscript[b, n-1]),…,(Subscript[b, 1])]

Table[B[n]/B[n-1],{n,10}]

Table[FromContinuedFraction[Reverse[Take[Rest@cf,n]]],{n,8}]

GCD

GCD@@@Partition[Numerator[cf],2,1]

GCD@@@Partition[Denominator[cf],2,1]

Bounds

(Subscript[A, n])≥(Fibonacci[n]) and (Subscript[B, n])≥(Fibonacci[n+1])

Table[A[n]≥Fibonacci[n],{n,0,10}]

Table[B[n]≥Fibonacci[n+1],{n,0,10}]

((Subscript[A, 2n])/(Subscript[B, 2n]))<ξ<((Subscript[A, 2n+1])/(Subscript[B, 2n+1]))

Table[((A[2n])/(B[2n]))<ξ<((A[2n+1])/(B[2n+1])),{n,0,4}]

(1/((Subscript[B, n])+(Subscript[B, n+1])))<(Abs[ξ (Subscript[B, n])-(Subscript[A, n])])≤(1/(Subscript[B, n+1]))

Rocket and Szuss, p. 19, eqn (2)

Table[(1/(B[n]+B[n+1]))<Abs[ξ B[n]-A[n]]≤(1/(B[n+1])),{n,0,8}]

(1/(2 (Subscript[B, n])))<(Abs[ξ (Subscript[B, n])-(Subscript[A, n])])≤(1/(Subscript[B, n])) [wrong]

Table[(1/(2B[n]))<Abs[ξ B[n]-A[n]]≤(1/(B[n])),{n,0,4}]

...wrong...

Table[{(1/(2B[n])),ξ B[n]-A[n],(1/(B[n]))},{n,0,4}]//N

(Abs[ξ-((Subscript[A, n])/(Subscript[B, n]))])>(Abs[ξ-((Subscript[A, n+1])/(Subscript[B, n+1]))])

Table[Abs[ξ-((A[n])/(B[n]))]>Abs[ξ-((A[n+1])/(B[n+1]))],{n,0,4}]

(1/((Subscript[B, n])((Subscript[B, n+1])+(Subscript[B, n]))))<(Abs[ξ-((Subscript[A, n])/(Subscript[B, n]))])<(1/((Subscript[B, n]) (Subscript[B, n+1])))

Table[(1/(B[n](B[n+1]+B[n])))<Abs[ξ-((A[n])/(B[n]))]<(1/(B[n]B[n-1])),{n,0,6}]

(Abs[ξ-((Subscript[A, n])/(Subscript[B, n]))])<(1/(2 (Subscript[B, n]^2))) [wrong]

Table[Abs[ξ-((A[n])/(B[n]))]<(1/(2((B[n])^2))),{n,0,6}]//N

(Abs[ξ-((Subscript[A, n])/(Subscript[B, n]))])<(1/((Fibonacci[n+1]) (Fibonacci[n+2])))

Table[Abs[ξ-((A[n])/(B[n]))]<(1/(Fibonacci[n+1]Fibonacci[n+2])),{n,0,6}]//N

(Abs[ξ-((Subscript[A, n])/(Subscript[B, n]))])<(1/(ϕ^(2 n-1)))

Table[Abs[ξ-((A[n])/(B[n]))]<(1/(GoldenRatio^(2n-1))),{n,0,6}]//N

(Abs[ξ-((Subscript[A, n])/(Subscript[B, n]))])<(1/((((Sqrt[2])))^n))

Table[Abs[ξ-((A[n])/(B[n]))]<(1/((((Sqrt[2])))^n)),{n,0,6}]//N

(Abs[ξ-((Subscript[A, n])/(Subscript[B, n]))])≤(Abs[ξ-(A/B)]) for all A∈(SuperPlus[ℤ]), B∈(SuperPlus[ℤ]) and 0≤B≤(Subscript[B, n])

Convergents

Pi

ContinuedFraction[Pi,20]

pi=Table[FromContinuedFraction[Take[ContinuedFraction[Pi,50],n]],{n,50}];

Even

N[First/@Partition[pi,2]-Pi,30]

MakeBoxes[xlabel[n_,str_],TraditionalForm]:=RowBox[{MakeBoxes[n,TraditionalForm]," ",str}]

plot1=ListLogPlot[Transpose[{Range[0,Length[pi]-1,2],N[Pi-First/@Partition[pi,2],30]}],Joined->True,PlotStyle->Red,
AxesLabel->{xlabel[n,"even"],Pi-HoldForm[c[n]]}
]

Odd

N[Last/@Partition[pi,2]-Pi,30]

plot2=ListLogPlot[Transpose[{Range[0,Length[pi]-1,2],N[Last/@Partition[pi,2]-Pi,30]}],
AxesLabel->{xlabel[n,"odd"],HoldForm[c[n]-Pi]},
Joined->True,
PlotStyle->Red]

Both

GraphicsArray[{plot1,plot2},ImageSize->400]

Ordering

Less@@First/@Partition[pi,2]

Less@@Reverse[Last/@Partition[pi,2]]

Less@@Join[First/@Partition[pi,2],{Pi},Reverse[Last/@Partition[pi,2]]]

E

ContinuedFraction[E,20]

e=Table[FromContinuedFraction[Take[ContinuedFraction[E,50],n]],{n,50}];

Less@@Join[First/@Partition[e,2],{E},Reverse[Last/@Partition[e,2]]]

Even

ListLogPlot[N[E-First/@Partition[e,2],20],Joined->True,PlotStyle->Red]

Odd

ListLogPlot[N[Last/@Partition[e,2]-E,20],Joined->True,PlotStyle->Red]

Computation

Lattice

Lattice[{x1_,y1_},{x2_,y2_}]:=Table[Disk[{i,j},.1],{i,x1,x2},{j,y1,y2}]
Strings[r_,n_]:=Module[{cf,i,j},
		cf=Table[Normal[ContinuedFraction[r,i]],{i,n}];
	 {Table[{Denominator[cf[[i]]],Numerator[cf[[i]]]},{i,1,n,2}],
	 Table[{Denominator[cf[[i]]],Numerator[cf[[i]]]},{i,2,n,2}]}
	]
ContinuedFractionLattice[r_,n_,opts___]:=Module[{s=Strings[r,n],l,x,y},
		{x,y}=Transpose[Flatten[s,1]];
		Show[Graphics[{
				Lattice[{Min[x],Min[y]},{Max[x],Max[y]}],
				Line[s[[1]]],Line[s[[2]]],{Dashing[{.02,.02}],Line[{{0,0},Max[x]{1,r}}]}
				}],opts,AspectRatio->Automatic,Axes->True
			]
]

Table[FromContinuedFraction[ContinuedFraction[E-2,i]],{i,5}]

ContinuedFractionLattice[E-2,5]

Ayres’ Method (1946, 1947)

Backward

AyresBackwardMethod[b0_:0,b1_List]:=Module[{P,N=Length[b1],n},
b[0]=b0;
b[n_]:=b1[[n]];
P[N+1]=1;
P[N]=b[N];
Do[
P[n]=b[n]P[n+1]+P[n+2],
{n,N-1,0,-1}
];
P[0]/P[1]
]

FromContinuedFraction[{2,3,5,2}]

AyresBackwardMethod[2,{3,5,2}]

FromContinuedFraction[{0,5,1,2,3}]

AyresBackwardMethod[{5,1,2,3}]

Grid[Transpose[{Join[{""},Most[#2],{""}],Append[Reverse[#[[All,1]]],#[[1,2]]]}],Dividers->{{False,True,False},None}]&[FoldList[{#2*#[[1]]+#[[2]],#[[1]]}&,{#[[-1]],1},Reverse[Most[#]]],#]&[{0,5,1,2,3}]

RationalNumber

AyresMethod[r_Rational]:=Module[{p,q,P,b,n},
{p,q}=Through[{Numerator,Denominator}[r]];
P[-1]=p;
P[0]=q;
n=0;
While[P[n]>1,
b[n]=Floor[P[n-1]/P[n]];
P[n+1]=P[n-1]-b[n]P[n];
n++
];
Append[Array[b,n,0],P[n-1]]
]

AyresMethod[113/89]

With[{p=113,q=89},Grid[Transpose[{Join[{""},Most[Apply[Quotient,#,{1}]],{""}],Append[#[[All,1]],#[[-1,2]]]}],Dividers->{{False,True,False},None}]&[NestWhileList[{#[[2]],Mod[#[[1]],#[[2]]]}&,{p,q},#[[2]]>1&]]]

Surd

AyresMethod[Power[N_,Rational[1,2]]]:=Module[{m,k,a,r},
m=Floor[Sqrt[N]];
k=N-m^2;
a[1]=Floor[2m/k];
r[1]=2m-a[1]k;
n=0;
C[n_]=Mod[A[n],B[n]];
Do[

A[n]=b[n-1]B[n-1]+C[n-2];
B[n]=b[n-1]C[n-1]+D[n-2],
{n,5}
];
Append[Array[b,n,0],P[n-1]]
]

FullForm[Sqrt[22]]

Todd’s code (modfied by eww to use NestWhileList)

ContinuedFraction[Sqrt[22]]

With[{N0=22},With[{m=Floor[Sqrt[N0]],k=Mod[N0,Floor[Sqrt[N0]]^2]},NestWhileList[With[{A=#[[1,1]] #[[1,3]]+#[[2,4]],B=#[[1,1]] #[[1,4]]+#[[2,5]]},{{Quotient[A,B],A,B,Mod[A,B],0},ReplacePart[#[[1]],5->#[[1,3]]-Quotient[A,B] #[[1,4]]]}]&,{{Quotient[2 m,k],2 m,k,Mod[2 m,k],Mod[k,Mod[2 m,k]]},{0,0,0,0,1}},#[[1,1]]≠#[[1,2]]&]]]

With[{N0=22},With[{m=Floor[Sqrt[N0]],k=Mod[N0,Floor[Sqrt[N0]]^2]},NestWhileList[With[{A=#[[1,1]] #[[1,3]]+#[[2,4]],B=#[[1,1]] #[[1,4]]+#[[2,5]]},{{Quotient[A,B],A,B,Mod[A,B],0},ReplacePart[#[[1]],5->#[[1,3]]-Quotient[A,B] #[[1,4]]]}]&,{{Quotient[2 m,k],2 m,k,Mod[2 m,k],Mod[k,Mod[2 m,k]]},{0,0,0,0,1}},#[[1,1]]≠#[[1,2]]&]]][[All,1,1]]

ContinuedFraction[Sqrt[33]]

With[{N0=33},With[{m=Floor[Sqrt[N0]],k=Mod[N0,Floor[Sqrt[N0]]^2]},NestWhileList[With[{A=#[[1,1]] #[[1,3]]+#[[2,4]],B=#[[1,1]] #[[1,4]]+#[[2,5]]},{{Quotient[A,B],A,B,Mod[A,B],0},ReplacePart[#[[1]],5->#[[1,3]]-Quotient[A,B] #[[1,4]]]}]&,{{Quotient[2 m,k],2 m,k,Mod[2 m,k],Mod[k,Mod[2 m,k]]},{0,0,0,0,1}},#[[1,1]]≠#[[1,2]]&]]][[All,1,1]]

ContinuedFraction[Sqrt[11]]

With[{N0=11},With[{m=Floor[Sqrt[N0]],k=Mod[N0,Floor[Sqrt[N0]]^2]},NestWhileList[With[{A=#[[1,1]] #[[1,3]]+#[[2,4]],B=#[[1,1]] #[[1,4]]+#[[2,5]]},{{Quotient[A,B],A,B,Mod[A,B],0},ReplacePart[#[[1]],5->#[[1,3]]-Quotient[A,B] #[[1,4]]]}]&,{{Quotient[2 m,k],2 m,k,Mod[2 m,k],Mod[k,Mod[2 m,k]]},{0,0,0,0,1}},#[[1,1]]≠#[[1,2]]&]]][[All,1,1]]