(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "NeXT Mathematica Notebook Front End Version 2.2"; NeXTStandardFontEncoding; fontset = title, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e8, 24, "Times"; ; fontset = subtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e6, 18, "Times"; ; fontset = subsubtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, L1, e6, 14, "Times"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, L1, a20, 18, "Times"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, L1, a15, 14, "Times"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L1, a12, 12, "Times"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L1, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; ; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, L1, 12, "Courier"; ; fontset = name, inactive, noPageBreakInGroup, nohscroll, preserveAspect, M7, italic, B65535, L1, 10, "Times"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, L1, 12, "Times"; ; fontset = leftheader, 12; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, italic, L1, 12, "Times"; ; fontset = leftfooter, 12; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Courier"; ; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; paletteColors = 128; currentKernel; ] :[font = title; inactive; preserveAspect] Continued Fractions :[font = subsubtitle; inactive; preserveAspect] by Stephen Wolfram and Ilan Vardi :[font = text; inactive; preserveAspect] This Notebook generates continued fraction approximations to real numbers, represented as ContinuedFractionForm objects. It extends the Normal function to convert such objects to rational numbers. ;[s] 5:0,0;90,1;111,2;137,3;143,4;197,-1; 5:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = section; inactive; Cclosed; preserveAspect; startGroup] Reference :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Context :[font = text; inactive; preserveAspect; endGroup] NumberTheory`ContinuedFractions` :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Package Version :[font = text; inactive; preserveAspect; endGroup] 1.4 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Mathematica Version ;[s] 2:0,0;11,1;19,-1; 2:1,10,8,Times,3,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = text; inactive; preserveAspect; endGroup] 2.0 :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Copyright :[font = text; inactive; preserveAspect; endGroup] Copyright 1987-1993, Wolfram Research, Inc. :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] History :[font = text; inactive; preserveAspect; endGroup] Modified by John Novak (Wolfram Research), May 1992, to allow nonrational nonfloating-point numbers. Modified by John Novak (Wolfram Research), March 1992, to allow rational numbers. Revised by Ilan Vardi (Wolfram Research), September 1989. Version 1.1 by Stephen Wolfram (Wolfram Research), May 1987. :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Keywords :[font = text; inactive; preserveAspect; endGroup] number theory, continued fraction, rational approximation, partial quotient :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Source :[font = text; inactive; preserveAspect; endGroup] Hardy and Wright: "An Introduction to the Theory of Numbers", Cambridge University Press. :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Warning :[font = text; inactive; preserveAspect; endGroup] Loading this package extends the definition of Normal. ;[s] 3:0,0;47,1;53,2;55,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Limitation :[font = text; inactive; preserveAspect; endGroup; endGroup] This package does not define mathematical operations on ContinuedFractionForm objects. ;[s] 3:0,0;56,1;77,2;87,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = section; inactive; Cclosed; preserveAspect; startGroup] Discussion :[font = text; inactive; preserveAspect] The continued fraction of a real number x is ContinuedFractionForm[{a0,a1,a2,...}] if x equals a0+1/(a1+1/(a2+...)). All numbers are forced to bignums, minimizing roundoff error problems. If a nonrational nonfloating-point number is given, ContinuedFraction estimates the precision needed to get a continued fraction of the correct order. Each term in a continued fraction expansion requires an expected 0.429017 decimal digits (i.e., Log[10, Khinchin], cf. Ilan Vardi's book, p. 163). Thus, a comfortable overestimate might be to start with one decimal digit for every two continued fraction coefficients requested. ;[s] 17:0,0;40,1;41,2;46,3;83,4;87,5;89,6;97,7;117,8;244,9;261,10;434,11;438,12;440,13;457,14;459,15;622,16;624,-1; 17:1,11,8,Times,0,12,0,0,0;1,10,8,Times,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Times,2,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,10,8,Times,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] Examples :[font = text; inactive; preserveAspect] In the case of non-numeric numbers such as Pi, ContinuedFraction attempts to numericalize the number to a precision that will give the desired continued fraction order. ;[s] 5:0,0;43,1;45,2;48,3;65,4;169,-1; 5:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; startGroup] ContinuedFraction[Pi, 8] :[font = output; output; inactive; preserveAspect; endGroup] ContinuedFractionForm[{3, 7, 15, 1, 292, 1, 1, 1}] ;[o] ContinuedFractionForm[{3, 7, 15, 1, 292, 1, 1, 1}] :[font = text; inactive; preserveAspect] You can also use ContinuedFraction on rational numbers. ;[s] 3:0,0;17,1;34,2;55,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; startGroup] ContinuedFraction[1234/4321, 10] :[font = output; output; inactive; preserveAspect; endGroup] ContinuedFractionForm[{0, 3, 1, 1, 153, 1, 3}] ;[o] ContinuedFractionForm[{0, 3, 1, 1, 153, 1, 3}] :[font = text; inactive; preserveAspect] We got fewer terms than we asked for, because the expansion became exact before the tenth term. :[font = text; inactive; preserveAspect] You can use the Normal function to turn a ContinuedFraction object into a rational number. This gives a list of some rational approximations of Pi: ;[s] 7:0,0;16,1;22,2;42,3;59,4;145,5;147,6;148,-1; 7:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; preserveAspect; startGroup] Table[Normal[ContinuedFraction[Pi, n]], {n, 1, 7}] :[font = output; output; inactive; preserveAspect; endGroup] {3, 22/7, 333/106, 355/113, 103993/33102, 104348/33215, 208341/66317} ;[o] 22 333 355 103993 104348 208341 {3, --, ---, ---, ------, ------, ------} 7 106 113 33102 33215 66317 :[font = text; inactive; preserveAspect; endGroup; endGroup] You can see why 355/113 is the best rational approximation that most people know, because after that they get pretty ugly. :[font = section; inactive; Cclosed; preserveAspect; startGroup] Implementation :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] Preparation :[font = subsubsection; inactive; preserveAspect; startGroup] Create the context for this Notebook: :[font = help; active; initialization; preserveAspect; plain; bold; fontName = "Courier"; endGroup] *) BeginPackage["NumberTheory`ContinuedFractions`"] (* :[font = subsubsection; inactive; preserveAspect; startGroup] Usage messages: :[font = input; initialization; preserveAspect] *) ContinuedFraction::usage = "ContinuedFraction[x, n] generates the continued fraction representation for the number x to order n. Note that the order returned may be less than n if the continued fraction terminates before n steps." (* :[font = input; initialization; preserveAspect; endGroup; endGroup] *) ContinuedFractionForm::usage = "ContinuedFractionForm[{a0,a1,...}] is a continued fraction; it is converted to an ordinary rational using Normal." (* :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] Definitions :[font = input; initialization; preserveAspect] *) Begin["`Private`"] (* :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] ContinuedFraction error messages: ;[s] 2:0,0;17,1;34,-1; 2:1,10,8,Courier,1,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = input; initialization; preserveAspect; endGroup] *) ContinuedFraction::incomp = "Warning: ContinuedFraction either terminated or the argument was unable to be evaluated to sufficient precision in `` attempts." (* :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] ContinuedFraction for machine numbers: ;[s] 2:0,0;17,1;39,-1; 2:1,10,8,Courier,1,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = input; initialization; preserveAspect; endGroup] *) ContinuedFraction[x_?MachineNumberQ, n_Integer?Positive] := ContinuedFraction[SetPrecision[x, $MachinePrecision], n] (* :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] ContinuedFraction for reals and rationals: ;[s] 2:0,0;17,1;43,-1; 2:1,10,8,Courier,1,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = input; initialization; preserveAspect; endGroup] *) ContinuedFraction[x:(_Real | _Rational), n_Integer?Positive] := ContinuedFractionForm[Floor[Prepend[cf[x, n - 1], x]]] (* :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] ContinuedFraction for non-numeric numbers: ;[s] 2:0,0;17,1;43,-1; 2:1,10,8,Courier,1,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = text; inactive; preserveAspect] Note: A comfortable overestimate for the required precision of a non-numeric number is to start with one decimal digit for every two continued fraction coefficients required. :[font = input; initialization; preserveAspect] *) ContinuedFraction[x_?(Not[NumberQ[#]] && NumberQ[N[#]] &), n_Integer?Positive] := Module[{nx, prec = n/2 + 10, out = {}, i = 0}, While[Length[out] < n && i++ < n, nx = N[x, prec]; out = cf[nx, n-1]; prec += (n - Length[out])/2 + 10 ]; If[Length[out] < n-1, Message[ContinuedFraction::incomp, n] ]; ContinuedFractionForm[Floor[Prepend[out, nx]]] ] (* :[font = text; inactive; preserveAspect] Implement the private cf function: ;[s] 3:0,0;22,1;24,2;34,-1; 3:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,11,8,Times,0,12,0,0,0; :[font = input; initialization; preserveAspect; endGroup] *) cf[num_, 0] := {} cf[num_, ord_] := {} /; ((num - Floor[num]) == 0) cf[num_, ord_] := Module[{tmp = 1/(num - Floor[num])}, Join[{tmp}, cf[tmp, ord - 1]] ] (* :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] Normal for ContinuedFractionForm objects: ;[s] 4:0,0;6,1;11,2;32,3;42,-1; 4:1,10,8,Courier,1,12,0,0,0;1,10,8,Times,1,12,0,0,0;1,10,8,Courier,1,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = input; initialization; preserveAspect; endGroup] *) ContinuedFractionForm/: Normal[ContinuedFractionForm[a_List]] := Fold[ 1 / #1 + #2 &, Last[a], Rest[Reverse[a]]] (* :[font = input; initialization; preserveAspect; endGroup] *) End[] (* :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] Finish :[font = input; initialization; preserveAspect; endGroup; endGroup] *) EndPackage[] (* ^*)