(***********************************************************************
Mathematica-Compatible Notebook
This notebook can be used on any computer system with Mathematica 3.0,
MathReader 3.0, or any compatible application. The data for the notebook
starts with the line of stars above.
To get the notebook into a Mathematica-compatible application, do one of
the following:
* Save the data starting with the line of stars above into a file
with a name ending in .nb, then open the file inside the application;
* Copy the data starting with the line of stars above to the
clipboard, then use the Paste menu command inside the application.
Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode. Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).
NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the
word CacheID, otherwise Mathematica-compatible applications may try to
use invalid cache data.
For more information on notebooks and Mathematica-compatible
applications, contact Wolfram Research:
web: http://www.wolfram.com
email: info@wolfram.com
phone: +1-217-398-0700 (U.S.)
Notebook reader applications are available free of charge from
Wolfram Research.
***********************************************************************)
(*CacheID: 232*)
(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[ 116817, 3583]*)
(*NotebookOutlinePosition[ 117900, 3620]*)
(* CellTagsIndexPosition[ 117856, 3616]*)
(*WindowFrame->Normal*)
Notebook[{
Cell[CellGroupData[{Cell[TextData[
"Ten Algorithms for Egyptian Fractions"], "Title",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[StyleBox["by\nDavid Eppstein",
Evaluatable->False,
AspectRatioFixed->True,
FontSize->18,
FontSlant->"Plain"]], "Subsubtitle",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"Mathematica in Education and Research\nVolume 4 Number 2\nCopyright 1995 \
TELOS/Springer-Verlag"], "Subsubtitle",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"When we use fractional numbers today, there are two ways we usually \
represent them: as fractions (ratios of integers) such as 5/6, and as decimal \
numbers such as 0.8333.\nComputers typically use binary versions of either of \
these two representations. But these are not the only possibilities. The \
ancient Egyptians used a third method: instead of writing down a single \
fraction, they would write a sum of several distinct ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["unit fractions",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
", each having numerator one. For instance the Egyptians would have \
written 5/6 as 1/2 + 1/3 (of course, they would have used hieroglyphics \
instead of Arabic numerals). Today such sums are known as ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Egyptian fractions",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[". (We will see another important modern representation, ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["continued fractions",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[", later.)",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"Any number has infinitely many Egyptian fraction representations, although \
there are only finitely many having a given number of terms [Ste92]. It is \
not known how the Egyptians found their representations, but today many \
algorithms are known for this problem, each behaving differently in terms of \
the number of unit fractions produced, the size of the denominators of the \
fractions, and the time taken to find the representations. For a good but \
brief introduction to Egyptian fraction algorithms and their implementation \
in ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Mathematica",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
", see Wagon's book [Wag91]. Here we examine a number of algorithms in \
more detail, implement them, and analyze their performance. We also include \
some investigations into how many unit fractions are needed to represent \
rational numbers having small numerators.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["We will represent Egyptian fractions in ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Mathematica",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" simply as a list of unit fractions. The original rational number \
represented by such a list can be recovered by ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Apply[Plus,%].",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[
" Throughout we use q to denote the rational number we are trying to \
represent, or x/y when we want to talk about its numerator and denominator \
separately.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["Methods Based on Approximation"], "Section",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The most natural and obvious method of finding an Egyptian fraction \
representation for a given number is to approximate the number as closely as \
possible by a single unit fraction, and then to use the same method to \
represent the remainder. For instance, the largest unit fraction less than \
5/6 is 1/2, and removing 1/2 from 5/6 leaves 1/3, so this idea leads to the \
representation 1/2+1/3 mentioned above. There are several ways of \
translating this idea into a specific algorithm."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["The Greedy Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"The greedy method produces an Egyptian fraction representation of a number \
",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["q",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" by letting the first unit fraction be the largest unit fraction less than \
",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["q",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
", and then continuing in the same manner to represent the remaining value. \
If ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["q",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[">1, we first separate out the integer part ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Floor[",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox["q",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox["]",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[
" before representing the remaining fraction. Our implementation works by \
first computing a list of the fractions left after subtracting each \
successive term in the greedy representation, and then subtracting a shifted \
copy of this list from itself.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"GreedyPart[q_Integer] := 0;\nGreedyPart[Rational[1,y_]] := 0;\n\
GreedyPart[q_Rational] :=\n\tq - If[q < 0 || q > 1, Floor[q],\n\t\t \
Rational[1,1+Quotient[1,q]]];\n \t\t \nSubtractShifted[l_] := Drop[l,-2] - \
Take[l,{2,-2}];\n\nEgyptGreedy[q_] :=\n\t\
SubtractShifted[FixedPointList[GreedyPart,q]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"Let us now make sure that this routine correctly finds an Egyptian \
fraction representation, and analyze its performance. If we start with ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox["/",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[", the remaining value after one step is\n(",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" mod ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[") / ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox["(Ceiling[",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox["/",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
"]), which has a smaller numerator. Similarly, the numerator decreases \
after each further step, so the algorithm always halts. The resulting \
sequence of fractions clearly adds to the original input, so the only way \
this method could go wrong would be if two of the fractions were equal (this \
is not allowed in Egyptian fractions). But this can't happen, since the \
denominators of the fractions must be strictly increasing: if we had two \
successive terms 1/",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["a",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" and 1/",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["b",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" with ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["b",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" \[Dagger] ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["a",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[", we could have chosen 1/(",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["a",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox["-1) instead of 1/",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["a",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[".",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"Since the numerator decreases after each step, the number of terms in the \
representation of ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox["/",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" is at most ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
". In many cases we could expect each successive numerator to be randomly \
distributed modulo the previous numerator; if this were really true we would \
instead only expect to see O(log ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
") terms. The denominator is at most squared each step, so the largest \
denominator is at most ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox["^(2^",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[") or more generally ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox["^(2^",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["k",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[") where ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["k",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" is the number of terms. The number of operations performed by the \
algorithm is proportional to ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["k",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
", but some of these operations might involve arithmetic on very large \
numbers. We demonstrate this method with a simple example.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptGreedy[18/23]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{1/2, 1/4, 1/31, 1/2852}\
\>", "\<\
1 1 1 1
{-, -, --, ----}
2 4 31 2852\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"That example was fairly well behaved; Wagon [Wag91] suggests trying this \
method on 31/311, which produces a representation with 10 terms, the maximum \
denominator having over 500 digits. (As we will see later, other methods \
produce much better representations for 31/311.)"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"We can easily modify our code to test the assertion that the numerators of \
the fractions remaining at each step do indeed decrease."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"EgyptGreedyNumerators[q_] :=\n \
Numerator[Drop[FixedPointList[GreedyPart,q],-2]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptGreedyNumerators[18/23]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{18, 13, 3, 1}\
\>",
"\<\
{18, 13, 3, 1}\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["The Harmonic Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"The greedy method treats the integer and fractional parts of a number \
differently. Instead, we can always remove the largest unit fraction that is \
smaller than both ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x/y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" and the previously removed unit fraction, even if ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x/y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" is larger than one. We treat this separately from the greedy method as \
it must be implemented somewhat differently \[LongDash] ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["FixedPointList",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[
" now needs two values, the remaining fraction and the bound on the \
denominator. Once we have found the sequence of remaining fractions, we \
remove the denominator bounds by ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Transpose",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[" (faster than applying ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["First",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[
" to each member of the list) and subtract the shifted list from itself as \
before. Our function takes two arguments, the first being the number we want \
to represent and the second being the largest denominator already included in \
the representation. The same method can also be used to generate Egyptian \
fractions in which the first term is arbitrarily small, simply by supplying a \
large integer in the second argument.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"HarmonicPart[{0,d_}] := {0,d};\nHarmonicPart[{Rational[1,y_],d_}] := {0,d};\n\
HarmonicPart[{q_,d_}] :=\n Max[d,1+Quotient[1,q]] //\n {q-1/#,#+1} &;"],
"Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"EgyptHarmonic[q_,d_] :=\n \
Transpose[FixedPointList[HarmonicPart,{q,d}]][[1]] //\n SubtractShifted"],
"Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["The algorithm constructs a fragment of the harmonic series ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["1/2+1/3+1/4+1/5+...",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" until this would produce a result larger than the original input, at \
which point the algorithm switches to the Greedy method for the remainder. \
This switch must happen after at most Exp[O(x/y+Log d)] terms, because the \
Harmonic series diverges (the sum up to 1/",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["k",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" is roughly log ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["k",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
"). Therefore the correctness of the algorithm follows from the same \
analysis we saw before. However it may produce many more terms, with larger \
denominators, than the greedy method. Each step at most squares the \
denominator, so when the switch happens, the denominator of the remaining \
fraction can be at most doubly exponentially small with respect to ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x/y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[", and the eventual number of terms is doubly exponential in ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x/y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" (singly exponential in ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["d",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
"). By the same analysis as the greedy algorithm, the largest denominator \
of the eventual representation is then at most quadruply exponential in x/y \
and triply exponential in ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["d",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
". As for the greedy method, this is only the worst case, and we can \
expect in practice to see one fewer level of exponentials in both the number \
of terms and the largest denominator. Even so, this algorithm tends to \
produce large representations.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptHarmonic[18/23,5]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData[
"\<\
{1/5, 1/6, 1/7, 1/8, 1/9, 1/28, 1/794, 1/23010120}\
\>",
"\<\
1 1 1 1 1 1 1 1
{-, -, -, -, -, --, ---, --------}
5 6 7 8 9 28 794 23010120\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["The Odd Greedy Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["Each ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["x/y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" with ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" odd is known to have an Egyptian fraction representation in which each \
denominator is odd [Bre54,Ste54]. Conversely, if ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" is even, at least one of the terms in its representation must also be \
even. The most straightforward method of finding an odd-denominator \
representation seems to be to modify the greedy method to only use odd \
denominators, but it is not known whether this really works.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"OddGreedyPart[{0,d_}] := {0,d};\nOddGreedyPart[{Rational[1,y_],d_}] := \
{0,d};\nOddGreedyPart[{q_,d_}] :=\n Max[d,1+Quotient[1,q]] //\n \
If[OddQ[#],#,#+1] & //\n {q-1/#,#+1} &;\n\nEgyptOddGreedy[q_,d_:3] :=\n \
Transpose[FixedPointList[OddGreedyPart,{q,d}]][[1]] //\n SubtractShifted"],
"Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"Unlike the greedy method, the numerators of the remaining fractions do not \
decrease at each step.\nThere are two reasons: first, like the harmonic \
method, we use a parameter ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["d",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" to make sure that the fractions we generate are distinct; ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["d",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" is used until the series ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["1/3+1/5+1/7+1/9+...",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" becomes larger than ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["q",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
", at which point it becomes unimportant, but in this stage the numerators \
will in general increase. Second, whenever parity forces us to use a larger \
denominator than the greedy method, the denominator will again increase. We \
now give an example with ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["q<1/3",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" to demonstrate the second phenomenon.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"EgyptOddGreedyNumerators[q_,d_:3] :=\n \
Transpose[FixedPointList[OddGreedyPart,{q,d}]][[1]] //\n \
Numerator[Drop[#,-2]] &"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptOddGreedy[10/39]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{1/5, 1/19, 1/265, 1/196365}\
\>",
"\<\
1 1 1 1
{-, --, ---, ------}
5 19 265 196365\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData["EgyptOddGreedyNumerators[10/39]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{10, 11, 14, 1}\
\>",
"\<\
{10, 11, 14, 1}\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[{
StyleBox[
"Proving whether this method always halts remains an important open problem \
in the theory of Egyptian fractions [Guy81,KW91]. A heuristic argument shows \
that the answer is likely to be positive. After enough fractions have been \
generated for ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["d",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" to become unimportant, each step reduces the remaining fraction from some \
value x/y to a smaller fraction in which the numerator is between 1 and ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["2x-1",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
". If each successive numerator were randomly distributed in this range, \
we would expect to see the numerators decrease by a factor of ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Exp[Integrate[Log[x],{x,0,2}]/2]",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[" ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["\.af",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[
" 0.73576 per step. Therefore we should expect the algorithm to produce \
roughly (Log n)/(1-Log 2) \.af 3.26 Log n unit fractions before halting, \
where ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["n",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" is the numerator of the remaining fraction at the point that ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["d",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" becomes unimportant. Of course nothing here is actually random, which \
is why this argument is not rigorous. (Also it ignores the possibility that \
the numerator and denominator of the fraction remaining after some steps may \
have a common factor, but that only serves to reduce the number of terms.) \
To test this argument, we compare it with the actual performance of our \
algorithm.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"TestOddGreedy[q_] :=\n\tEgyptOddGreedyNumerators[q] //\n\t\
ListPlot[Log[#]/(1-Log[2]),\n\t\t\t PlotJoined->True,\n\t\t\t \
AxesOrigin->{0,0}]&"], "Input",
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["TestOddGreedy[1999999991/123412340001]"], "Input",
AspectRatioFixed->True],
Cell[GraphicsData["PostScript", "\<\
%!
%%Creator: Mathematica
%%AspectRatio: .61803
MathPictureStart
%% Graphics
/Courier findfont 10 scalefont setfont
% Scaling calculations
0.0238095 0.0634921 0.0147151 0.00843347 [
[(2)] .15079 .01472 0 2 Msboxa
[(4)] .27778 .01472 0 2 Msboxa
[(6)] .40476 .01472 0 2 Msboxa
[(8)] .53175 .01472 0 2 Msboxa
[(10)] .65873 .01472 0 2 Msboxa
[(12)] .78571 .01472 0 2 Msboxa
[(14)] .9127 .01472 0 2 Msboxa
[(10)] .01131 .09905 1 0 Msboxa
[(20)] .01131 .18338 1 0 Msboxa
[(30)] .01131 .26772 1 0 Msboxa
[(40)] .01131 .35205 1 0 Msboxa
[(50)] .01131 .43639 1 0 Msboxa
[(60)] .01131 .52072 1 0 Msboxa
[(70)] .01131 .60506 1 0 Msboxa
[ -0.001 -0.001 0 0 ]
[ 1.001 .61903 0 0 ]
] MathScale
% Start of Graphics
1 setlinecap
1 setlinejoin
newpath
[ ] 0 setdash
0 g
p
p
.002 w
.15079 .01472 m
.15079 .02097 L
s
P
[(2)] .15079 .01472 0 2 Mshowa
p
.002 w
.27778 .01472 m
.27778 .02097 L
s
P
[(4)] .27778 .01472 0 2 Mshowa
p
.002 w
.40476 .01472 m
.40476 .02097 L
s
P
[(6)] .40476 .01472 0 2 Mshowa
p
.002 w
.53175 .01472 m
.53175 .02097 L
s
P
[(8)] .53175 .01472 0 2 Mshowa
p
.002 w
.65873 .01472 m
.65873 .02097 L
s
P
[(10)] .65873 .01472 0 2 Mshowa
p
.002 w
.78571 .01472 m
.78571 .02097 L
s
P
[(12)] .78571 .01472 0 2 Mshowa
p
.002 w
.9127 .01472 m
.9127 .02097 L
s
P
[(14)] .9127 .01472 0 2 Mshowa
p
.001 w
.04921 .01472 m
.04921 .01847 L
s
P
p
.001 w
.0746 .01472 m
.0746 .01847 L
s
P
p
.001 w
.1 .01472 m
.1 .01847 L
s
P
p
.001 w
.1254 .01472 m
.1254 .01847 L
s
P
p
.001 w
.17619 .01472 m
.17619 .01847 L
s
P
p
.001 w
.20159 .01472 m
.20159 .01847 L
s
P
p
.001 w
.22698 .01472 m
.22698 .01847 L
s
P
p
.001 w
.25238 .01472 m
.25238 .01847 L
s
P
p
.001 w
.30317 .01472 m
.30317 .01847 L
s
P
p
.001 w
.32857 .01472 m
.32857 .01847 L
s
P
p
.001 w
.35397 .01472 m
.35397 .01847 L
s
P
p
.001 w
.37937 .01472 m
.37937 .01847 L
s
P
p
.001 w
.43016 .01472 m
.43016 .01847 L
s
P
p
.001 w
.45556 .01472 m
.45556 .01847 L
s
P
p
.001 w
.48095 .01472 m
.48095 .01847 L
s
P
p
.001 w
.50635 .01472 m
.50635 .01847 L
s
P
p
.001 w
.55714 .01472 m
.55714 .01847 L
s
P
p
.001 w
.58254 .01472 m
.58254 .01847 L
s
P
p
.001 w
.60794 .01472 m
.60794 .01847 L
s
P
p
.001 w
.63333 .01472 m
.63333 .01847 L
s
P
p
.001 w
.68413 .01472 m
.68413 .01847 L
s
P
p
.001 w
.70952 .01472 m
.70952 .01847 L
s
P
p
.001 w
.73492 .01472 m
.73492 .01847 L
s
P
p
.001 w
.76032 .01472 m
.76032 .01847 L
s
P
p
.001 w
.81111 .01472 m
.81111 .01847 L
s
P
p
.001 w
.83651 .01472 m
.83651 .01847 L
s
P
p
.001 w
.8619 .01472 m
.8619 .01847 L
s
P
p
.001 w
.8873 .01472 m
.8873 .01847 L
s
P
p
.001 w
.9381 .01472 m
.9381 .01847 L
s
P
p
.001 w
.96349 .01472 m
.96349 .01847 L
s
P
p
.001 w
.98889 .01472 m
.98889 .01847 L
s
P
p
.002 w
0 .01472 m
1 .01472 L
s
P
p
.002 w
.02381 .09905 m
.03006 .09905 L
s
P
[(10)] .01131 .09905 1 0 Mshowa
p
.002 w
.02381 .18338 m
.03006 .18338 L
s
P
[(20)] .01131 .18338 1 0 Mshowa
p
.002 w
.02381 .26772 m
.03006 .26772 L
s
P
[(30)] .01131 .26772 1 0 Mshowa
p
.002 w
.02381 .35205 m
.03006 .35205 L
s
P
[(40)] .01131 .35205 1 0 Mshowa
p
.002 w
.02381 .43639 m
.03006 .43639 L
s
P
[(50)] .01131 .43639 1 0 Mshowa
p
.002 w
.02381 .52072 m
.03006 .52072 L
s
P
[(60)] .01131 .52072 1 0 Mshowa
p
.002 w
.02381 .60506 m
.03006 .60506 L
s
P
[(70)] .01131 .60506 1 0 Mshowa
p
.001 w
.02381 .03158 m
.02756 .03158 L
s
P
p
.001 w
.02381 .04845 m
.02756 .04845 L
s
P
p
.001 w
.02381 .06532 m
.02756 .06532 L
s
P
p
.001 w
.02381 .08218 m
.02756 .08218 L
s
P
p
.001 w
.02381 .11592 m
.02756 .11592 L
s
P
p
.001 w
.02381 .13278 m
.02756 .13278 L
s
P
p
.001 w
.02381 .14965 m
.02756 .14965 L
s
P
p
.001 w
.02381 .16652 m
.02756 .16652 L
s
P
p
.001 w
.02381 .20025 m
.02756 .20025 L
s
P
p
.001 w
.02381 .21712 m
.02756 .21712 L
s
P
p
.001 w
.02381 .23399 m
.02756 .23399 L
s
P
p
.001 w
.02381 .25085 m
.02756 .25085 L
s
P
p
.001 w
.02381 .28459 m
.02756 .28459 L
s
P
p
.001 w
.02381 .30145 m
.02756 .30145 L
s
P
p
.001 w
.02381 .31832 m
.02756 .31832 L
s
P
p
.001 w
.02381 .33519 m
.02756 .33519 L
s
P
p
.001 w
.02381 .36892 m
.02756 .36892 L
s
P
p
.001 w
.02381 .38579 m
.02756 .38579 L
s
P
p
.001 w
.02381 .40265 m
.02756 .40265 L
s
P
p
.001 w
.02381 .41952 m
.02756 .41952 L
s
P
p
.001 w
.02381 .45326 m
.02756 .45326 L
s
P
p
.001 w
.02381 .47012 m
.02756 .47012 L
s
P
p
.001 w
.02381 .48699 m
.02756 .48699 L
s
P
p
.001 w
.02381 .50386 m
.02756 .50386 L
s
P
p
.001 w
.02381 .53759 m
.02756 .53759 L
s
P
p
.001 w
.02381 .55446 m
.02756 .55446 L
s
P
p
.001 w
.02381 .57132 m
.02756 .57132 L
s
P
p
.001 w
.02381 .58819 m
.02756 .58819 L
s
P
p
.002 w
.02381 0 m
.02381 .61803 L
s
P
P
0 0 m
1 0 L
1 .61803 L
0 .61803 L
closepath
clip
newpath
.004 w
.0873 .60332 m
.15079 .5802 L
.21429 .55235 L
.27778 .44148 L
.34127 .42326 L
.40476 .43552 L
.46825 .44934 L
.53175 .28058 L
.59524 .2567 L
.65873 .22462 L
.72222 .23964 L
.78571 .24803 L
.84921 .25598 L
.9127 .25951 L
.97619 .01472 L
s
% End of Graphics
MathPictureEnd
\
\>"], "Graphics",
Evaluatable->False,
AspectRatioFixed->True,
ImageSize->{282, 174},
ImageMargins->{{34, Inherited}, {Inherited, Inherited}},
ImageCache->GraphicsData["Bitmap", "\<\
CF5dJ6E]HGAYHf4PAg9QL6QYHggYjN[Vi^OShn03ooeGooj[ooonIgYjN[Vi^OShn03o
oclo?ginO[fm_Oclo5H/1JX00=d81_l0VOl0I_l0CXf=SLcCXf=SLcII03=VoalO7eiN
GYfMWMcLg02Z0200005`02oo0000?o00003P0001L000?o0000
k`000ol0000>00005`000ol0003_0003o`0000h0000G0003o`000>h000?o00003`0001L000?o0000
kP000ol0000?00005`02onl000?o00003`0001L000?o0000kP000ol0000?00005`000ol0003]0003
o`000100000G0003o`000>d000?o0000400001L00_o^0003o`000100000G0003o`000>d000?o0000
400001L000?o0000k0000ol0000A00005`000ol0003/0003o`000140000G00;ok@000ol0000A0000
5`000ol0003/0003o`000140000800Go0P02o`H000?o0000j`000ol0000B00002P001Ol0003o0080
00?o00000`000ol0003[0003o`000180000:0005o`000?l00P000ol000030003o`000>/000?o0000
4P0000X000Go0000o`020003o`0000<00_o/0003o`000180000:0005o`000?l00P000ol000030003
o`000>X000?o00004`0000P00ol30004o`00o`D000?o0000jP000ol0000C00002P000ol0000200;o
1P000ol0003Z0003o`0001<0000G00;oj`000ol0000C00005`000ol0003Y0003o`0001@0000G0003
o`000>T000?o0000500001L000?o0000j@000ol0000D00005`02onX000?o0000500001L000?o0000
j0000ol0000E00005`000ol0003X0003o`0001D0000G0003o`000>P000?o00005@0001L000?o0000
i`000ol0000F00005`02onP000?o00005P0001L000?o0000i`000ol0000F00005`000ol0003W0003
o`0001H0000G0003o`000>H000?o00005`0001L00_oW0003o`0001L0000G0003o`000>H000?o0000
5`0000P01?l300;o1P000ol0003V0003o`0001L000080004o`00o`8000Co003o1@000ol0003U0003
o`0001P000090003o`00008000Co003o1@02onH000?o0000600000X000Go0000o`020003o`0000<0
00?o0000i@000ol0000H00002`001?l00?l20003o`0000<000?o0000i@000ol0000H000020001?l0
0?l20004o`00o`D000?o0000i0000ol0000I00002@02o`@00_l600;oi@000ol0000I00005`000ol0
003T0003o`0001T0000G0003o`000>@000?o00006@0001L000?o0000h`000ol0000J00005`000ol0
003S0003o`0001X0000G00;oi0000ol0000J00005`000ol0003S0003o`0001X0000G0003o`0009h0
1?m00003o`0001/0000G0003o`0009`00_l400Co?0000ol0000K00005`02oi/00_l:00Co>0000ol0
000K00005`000ol0002H00;o4004oc@000?o00006`0001L000?o0000UP02oaH01_l]0003o`0001`0
000G0003o`0009@00_lN00So9@000ol0000L00005`02oi<00_lX00So7@000ol0000L00005`000ol0
002@00;o00;o?@0000020000ol000030004
o`00o`D000?o0000?P02ob801Ol80003o`0008h000080003o`0000<000Co003o1@000ol0000n0003
o`0002H01Ol30003o`0008h0000800Co0`02o`H000?o0000?@000ol0000/00?oT@0001L00_ln0003
o`000<00000G0003o`0003`000?o0000`@0001L000?o0000>`000ol0003200005`000ol0000k0003
o`000<80000G00;o>`000ol0003300005`000ol0000j0003o`000<<0000G0003o`0003T000?o0000
a00001L000?o0000>0000ol0003500005`000ol0000h0003o`0000000ol000360000
5`000ol0000g0003o`0000000
5`000ol0000^0003o`000"],
ImageRangeCache->{{{0, 281}, {173, 0}} -> {-1.42199, -7.64881, 0.0615758,
0.463579}}]}, Open]],
Cell[TextData[
"Our code normalizes the vertical axis to match our heuristic prediction of \
the number of steps remaining. At least for this example, the numerators \
seem to decrease much more quickly than our prediction, so the number of \
terms generated (15) is considerably smaller than the 70 we would expect. It \
is also interesting to note the large drops made by the numerator in the \
third, seventh, and final steps. A closer inspection reveals that these \
phenomena are due to cancellation between common factors of the numerators \
and denominators of intermediate terms: these three steps involve common \
factors of 63, 45, and 5739, and two other steps involve factors of three.\n\
It is not clear to me why such large cancellations should occur."], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["Conflict Resolution Methods"], "Section",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"We next examine two methods for Egyptian fraction representation that \
employ the following simple idea: from a fraction x/y we can form a \
representation in unit fractions by making x copies of 1/y. This is not an \
Egyptian fraction since the unit fractions are not distinct. However we can \
now search for ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["conflicting pairs",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" (two copies of the same fraction) and resolve the conflict by replacing \
the pair with some other fractions adding to the same value. The methods \
differ in the way they choose the replacement fractions. It is trivial to \
prove that such methods give correct representations, but it may be harder to \
prove that they always halt or to analyze how well they perform.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["The Pairing Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"This method uses the conflict resolution idea above. Whenever we have a \
conflicting pair (two copies of some fraction 1/y), we replace them either by \
a single fraction 2/y if y is even, or by 2/(y+1)+2/(y(y+1)) if y is odd. \
(Note that in all cases, the fractions simplify to have unit numerators.) \
The order in which this is done does not matter. Note that this process may \
combine pairs of fractions to form integers; e.g. this happens with \
sufficiently many copies of 1/7. If this happens, we allow integers to be \
combined to make larger integers.\nThis type of method is a natural fit to \
the pattern-matching capabilities of ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Mathematica",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[", so our implementation defines a function ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["DoPairing",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[" in such a way that ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Mathematica",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" repeatedly transforms its argument list using the replacement defined \
above.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"DoPairing[p___,q:Rational[1,y_],q_,r___] :=\n\tIf[OddQ[y], \
DoPairing[p,2/(y+1), 2/(y(y+1)),r],\n\t\t\t\tDoPairing[p,2/y,r]];\n\
DoPairing[p___,q_Integer,r_Integer,s___] :=\n DoPairing[p,q+r,s];\n\t\t\n\
SetAttributes[DoPairing, Orderless];\n\nEgyptPairList[l_] := Reverse[List @@ \
DoPairing @@ l];\nEgyptPairing[Rational[x_,y_]] :=\n \t\
EgyptPairList[Table[1/y, {x}]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"Each replacement of 1/y+1/y by 2/y reduces the number of terms, initially x, \
by one, which can happen at most x times. Each other replacement leaves the \
number of terms the same but reduces the list of terms in lexicographic \
order; one can only perform such reductions a finite number of times. \
Therefore the algorithm eventually halts, with a representation having at \
most x terms.\n\nNext let us determine the largest denominator that can \
arise. One of the fractions must be at least 1/y, and in general if the \
remainder after the first few terms is a/b, the next largest fraction in the \
representation must be at least a/xb. So if we remove the fractions from the \
final representation in order by size, then at each step the denominator is \
at most increased to its square times x, and the largest denominator is at \
most (xy)^(2^x). But this seems somewhat pessimistic \[PlusMinus] with the \
heuristic assumption that equal fractions are not usually generated from \
different starting pairs, we get at most x replacements and in this case the \
largest denominator is roughly y^x (or even fewer if some denominators of \
intermediate terms are divisible by two)."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptPairing[18/23]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{1/2, 1/6, 1/12, 1/35, 1/276, 1/2415}\
\>",
"\<\
1 1 1 1 1 1
{-, -, --, --, ---, ----}
2 6 12 35 276 2415\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"Perhaps more important than the direct use of this method for finding \
Egyptian fractions is the following fact, which shows that if we want to find \
a representation with few terms, it suffices to represent the given number as \
a sum of unit fractions without worrying about distinctness."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"Theorem: Let q be represented as a sum of t unit fractions, not \
necessarily distinct.\nThen q has a t-term Egyptian fraction representation.\n\
\n Proof: apply the function ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["EgyptPairList",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[
" defined above to the given representation.\n Each step leaves the \
sum of the fractions unchanged, and either shrinks the list by one\n \
fraction or leaves its length unchanged. The fact that this halts can be \
shown by the same\n argument given for the termination of ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["EgyptPairing",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[".",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"It would be of interest to bound the number of replacement steps performed \
by ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["EgyptPairList",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[" and ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["EgyptPairing",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[".",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData["The Splitting Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The next method we describe is similar to the pairing method, but less \
clever: we keep a list of unit fractions as before, and resolve conflicts by \
replacing fractions with smaller fractions adding to the same quantity. \
However, instead of replacing 2/y with 2/(y+1) + 2/(y(y+1)), we replace it \
with 1/y + 1/(y+1) + 1/(y(y+1)). In other words, when two fractions \
conflict, we leave one of them in place and split the other one, creating a \
list with one more fraction than before."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"DoSplitting[p___,q:Rational[1,y_],q_,r___] :=\n\t\
DoSplitting[p,q,1/(y+1),1/(y(y+1)),r];\n\t\t\nSetAttributes[DoSplitting, \
Orderless];\n\nEgyptSplitting[Rational[x_,y_]] :=\n \tReverse[List @@ \
DoSplitting @@ Table[1/y, {x}]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"It is not obvious that this method halts, but this has been proven by Graham \
and Jewett [Wag91]; see also Beeckmans [Bee93]. If no fraction arises in two \
different ways (once as 1/(y+1) and once as 1/(y(y+1)), we could analyze the \
algorithm on input x/y as having x-1 levels of splitting, each of which \
essentially doubles the number of terms in the representation. The total \
number of terms produced would then be O(2^x), and the largest denominator \
would be O(y^(2^x)). This is a best-case analysis; in practice the results \
will be even worse."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptSplitting[5/6]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData[
"\<\
{1/6, 1/7, 1/8, 1/9, 1/10, 1/42, 1/43, 1/44, 1/45, 1/56,
1/57, 1/58, 1/72, 1/73, 1/90, 1/1806, 1/1807, 1/1808,
1/1892, 1/1893, 1/1980, 1/3192, 1/3193, 1/3306, 1/5256,
1/3263442, 1/3263443, 1/3267056, 1/3581556, 1/10192056,
1/10650056950806}\
\>",
"\<\
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
{-, -, -, -, --, --, --, --, --, --, --, --, --, --, --,
6 7 8 9 10 42 43 44 45 56 57 58 72 73 90
1 1 1 1 1 1 1 1 1
----, ----, ----, ----, ----, ----, ----, ----, ----,
1806 1807 1808 1892 1893 1980 3192 3193 3306
1 1 1 1 1 1
----, -------, -------, -------, -------, --------,
5256 3263442 3263443 3267056 3581556 10192056
1
--------------}
10650056950806\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["Methods Based on the Binary Number System"], "Section",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["The Binary Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"An Egyptian fraction representation can be formed from the binary \
representation of a number; e.g.",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox[" ",
Evaluatable->False,
AspectRatioFixed->True,
FontWeight->"Bold"],
StyleBox[
"27/22 = 1.00111010001. (The underscored digits repeat in blocks of 10 \
after these initial digits.) The initial part before the underscores gives \
fractions 1/2^a, and the repeating part gives fractions 1/(2^a (2^b - 1)), \
where b is the length of the repetition. We must take some care that the a \
in the second type of fraction is nonnegative, so we modify the \
representation above so that there are as many nonrepeating terms as \
repeating terms:",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["\n",
Evaluatable->False,
AspectRatioFixed->True,
FontWeight->"Bold"],
StyleBox[
"27/22 = 1.0011101000101110100.\n\nA similar technique works for some other \
bases than binary. For instance the only digit that causes any trouble in a \
base 6 representation is 5, but 5/6 = 3/6+2/6 so we can still use this method \
with base 6. On the other hand this method does not work well with decimal \
notation as we can not represent 4, 7, 8, or 9 as sums of distinct divisors \
of 10, so numbers with those digits in their decimal representation would \
cause a problem for a decimal version of this method.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"To implement the binary method, we first define a function to find the \
binary (or other base) representation of q, returned as two lists of digits. \
The first member of the first list is the integer part of q, the rest of the \
first list is the nonrepeating part of the representation, and the second \
list is the repeating part. It turns out to be easier to find, instead of \
the digits themselves, certain values mod y from which the digits can be \
computed. This makes it easier to detect repeating blocks of digits, since \
they occur exactly when the same value mod y arises twice."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"RationalDigits[q_Integer, base_] := {{q},{0}};\n\
RationalDigits[Rational[a_,b_], base_Integer] :=\n \
Module[{nextunit,addunit,units,\n \t\treppos,breakpt,finddigit,digitize},\n\
\t nextunit = (Mod[base Last[#], b]&);\n \t addunit = \
(Module[{c=nextunit[#]},\n \t \t\t\t\t If[MemberQ[#,c],\n \t \t\
\t\t\t #, Append[#,c]]]&);\n \t units = FixedPoint[addunit, \
{Mod[a,b]}];\n \t reppos = Position[units, nextunit[units]];\n \t \
breakpt = reppos[[1]][[1]]-1;\n \t finddigit = (Floor[base # / b]&);\n \
\t digitize = (finddigit /@ # &);\n \t \
{Prepend[digitize[Take[units,breakpt]],Floor[a/b]],\n \t \
digitize[Drop[units,breakpt]]}];"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"Once we have found the repeating binary representation of a fraction, it is \
simple to turn the nonzero digits of the representation into terms in an \
Egyptian fraction representation. Most of the complication in our \
implementation is due to the point noted earlier, that we should have at \
least as many nonrepeating digits as repeating digits."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"EgyptBinary[q_Integer] := {q};\nEgyptBinary[q_Rational] :=\n Module[{l = \
RationalDigits[q,2],\n tpow = ({2 #1[[1]], #2}&),\n \
invprod = (#[[2]]/#[[1]]&),\n tplist,invlist,\n \
firstlen,firstlist,firstpart,\n mul,seclist,secpart,full},\n \
tplist = (FoldList[tpow, {1,#[[1]]}, Drop[#,1]]&);\n invlist = \
(invprod /@ tplist[#])&;\n firstlen = \
Max[Length[l[[1]]],Length[l[[2]]]];\n firstlist = \
Take[Apply[Join,l],firstlen];\n firstpart = invlist[firstlist];\n \
mul = 2^Length[l[[2]]]-1;\n seclist = RotateRight[l[[2]], \
Length[l[[1]]]];\n secpart = (#/mul& /@ invlist[seclist]);\n \
full = (If[#==0,{ }, #]& /@\n \t\tJoin[firstpart,secpart]);\n \
Flatten[full]];"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"The correctness of this algorithm is straightforward. The fact that it \
halts for input q=x/y follows from the fact that the list units computed in ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["RationalDigits",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[
" is a list of distinct values modulo y, so can have length at most y. The \
lists of binary digits for",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox[" ",
Evaluatable->False,
AspectRatioFixed->True,
FontWeight->"Bold"],
StyleBox[
"x/y have between them at most y elements, and the padding to make the \
repetition start far enough along at most doubles this. At most y/2 elements \
on the list can correspond to binary ones, so the eventual Egyption fraction \
has at most y terms. All denominators are at most 2^(2y).",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptBinary[27/22]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData[
"\<\
{1, 1/8, 1/16, 1/32, 1/128, 1/2046, 1/8184, 1/16368,
1/32736, 1/130944}\
\>",
"\<\
1 1 1 1 1 1 1 1 1
{1, -, --, --, ---, ----, ----, -----, -----, ------}
8 16 32 128 2046 8184 16368 32736 130944\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["The Binary Remainder Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"Let p be a power of two larger than the denominator of x/y. By dividing \
xp by y we find r and",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox[" ",
Evaluatable->False,
AspectRatioFixed->True,
FontWeight->"Bold"],
StyleBox[
"s satisfying x p = s y + r. Then we can represent r/p and s/p as sums of \
inverse powers of two; but x/y = s/p + r/(p y) so by concatenating the \
representation of s/p with 1/y times the representation of r/p we get a \
representation of x/y. The division by y ensures that no overlap occurs \
between the fractions from the two parts of the representation. For \
convenience of implementation we call ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["EgyptBinary",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[" to find the binary representations of r/p and s/p.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"BiggerPower[bound_, base_] :=\n base^Length[IntegerDigits[bound,base]];\n\
\nEgyptBinRem[Rational[x_,y_]] :=\n Module[{p, r, s},\n p = \
BiggerPower[y,2];\n r = Mod[x p, y];\n s = Quotient[x p, \
y];\n Join[If[s==0,{},EgyptBinary[s/p]],\n \t\t\
If[r==0,{},(#/y&) /@ EgyptBinary[r/p]]]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"The method produces at most Log x + Log y terms; in practice it will \
typically produce half that many. Each denominator is at most 2y^2."], "Text",\
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptBinRem[18/23]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{1/2, 1/4, 1/32, 1/736}\
\>", "\<\
1 1 1 1
{-, -, --, ---}
2 4 32 736\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"The binary remainder method appears in a paper of Stewart [Ste54], where he \
uses it to find representations with all denominators even. Similar methods \
that replace the term p=2^k by some other value have proven useful in many \
recent results about Egyptian fractions. Breusch [Bre54] and Stewart [Ste54] \
set p to small multiples of 3^k, to show that every odd-denominator fraction \
has a representation with all denominators odd. Tenenbaum and Yokota [TY90] \
use factorial values of p to find representations with (1+o(1))(Log y) / (Log \
Log y) terms having all denominators bounded by O(y (Log y)^2 / (Log Log y)). \
Vose [Vos85] uses an even more complicated value of p to show that any x/y \
has a representation with only O(Sqrt Log[y]) terms. "], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["Continued Fraction Methods"], "Section",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["The Continued Fraction Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["One can derive a good Egyptian fraction algorithm from ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["continued fractions",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
": the algorithm is quick, generates reasonably few terms, and uses \
fractions with very small denominators [Ble72].\n\nAny real number q can be \
represented as a continued fraction:",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[OutputFormData[
"\<\
x=a[0]+(a[1] + (a[2] + (a[3] + (a[4]...)^(-1))^(-1))^(-1))^(-1)\
\>",
"\<\
1
x = a[0] + ----------------------------
1
a[1] + ---------------------
1
a[2] + --------------
1
a[3] + -------
a[4]...\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"in which all the values a[i] are integers. This terminates in a finite \
sequence if and only if q is rational."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["The ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["convergents",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" of q are formed by truncating the sequence; they are alternately above \
and below q, and are useful for finding good rational approximations to the \
original number.\n(For instance the famous approximation 355/113 \.af \:201e \
can be found as a convergent in this way.) Successive convergents have \
differences that are unit fractions. The sequence of these differences gives \
something like an Egyptian fraction representation of q, but unfortunately \
every other fraction in the sequence is negative.\n\nIf h[i]/k[i] denotes the \
ith convergent, we can define a sequence of ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["secondary convergents",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[":",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[OutputFormData["\<\
(h[i-1]+j h[i])/(k[i-1]+j k[i])\
\>",
"\<\
h[i - 1] + j h[i]
-----------------
k[i - 1] + j k[i]\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"As j ranges from 0 to a[n+1] the secondary convergents give an increasing \
sequence ranging from the (i-1)st convergent to the (i+1)st convergent \
[NZ80]. As with the primary convergents, successive secondary convergents \
differ by a unit fraction. If we interleave the sequence of every other \
primary convergent, connected by the appropriate sequences of secondary \
convergents, the differences of this interleaved sequence give an Egyptian \
fraction representation of ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["q",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[".",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"We first find the continued fraction representation of q=x/y. (",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Mathematica",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" provides a package for continued fractions, but one must supply a bound \
on the number of terms to compute. We don't need or want such a bound.) In \
order to use this method, the continued fraction must have an odd number of \
terms, so if necessary we replace the last term a[i] with two terms a[i]-1 \
and 1.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"CFNextTerm[q_Integer] := 0;\nCFNextTerm[q_Rational] := 1/(q-Floor[q])\n\n\
ContinuedFractionList[q_] :=\n Floor /@ Drop[FixedPointList[CFNextTerm, \
q],-2];\n\nCFMakeOdd[l_] :=\n \
If[OddQ[Length[l]],l,Join[Drop[l,-1],{Last[l]-1,1}]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"We next find the primary and secondary sequences of unit fractions from \
these continued fraction representations."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"CFPSAux[{a_,b_},c_] := {b + a c, a};\nCFPrimarySeq[l_] :=\n \
Transpose[Drop[FoldList[CFPSAux,{0,1},l],1]][[1]];\n \n\
CFSecondarySeq[l_] :=\n If[Length[l] < 3, l,\n Table[l[[1]] + i \
l[[2]],\n \t\t {i, 0, (l[[3]]-l[[1]])/l[[2]]-1}] ~Join~\n\t\t \
CFSecondarySeq[Drop[l,2]]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"As described above, our final representation is formed by hooking together \
secondary sequences. We first separate out the integer part of the input, \
which we leave as is. The remaining fractions are formed by multiplying \
pairs of values in the secondary sequence."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"EgyptContinuedFraction[q_] :=\n\tCFSecondarySeq[CFPrimarySeq[CFMakeOdd[\n\t\t\
\t\t\t\tContinuedFractionList[q]]]] //\n 1/(Drop[#,1] Drop[#,-1])& //\n \
If[Floor[q]==0, #, Prepend[#, Floor[q]]]&"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"Termination of the algorithm follows from the termination of the continued \
fraction representation algorithm, which is essentially the same as Euclid's \
algorithm for integer GCD's. It is clear from the construction of the \
secondary sequence, and from the fact that the final result has denominators \
that are products of pairs of numbers in the secondary sequence, that all \
fractions are distinct. The fact that the sum of the fractions is the \
original input number\nis a straightforward but tedious exercise in algebraic \
manipulation. The number of terms in the Egyptian fraction representation of \
x/y is the sum of the odd terms after the first in the continued fraction \
list, which is at most x. Each fraction is a difference between two \
secondary convergents with denominator at most y, so each fraction has \
denominator at most y^2."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptContinuedFraction[18/23]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{1/2, 1/6, 1/12, 1/36, 1/207}\
\>",
"\<\
1 1 1 1 1
{-, -, --, --, ---}
2 6 12 36 207\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["The Grouped Continued Fraction Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The worst case for the continued fraction method above occurs when the \
continued fraction representation has only three terms producing a long \
secondary sequence. In this case the Egyptian fraction representation will \
involve long sequences of fractions of the form\n1/(a+b i)(a+b(i+1)). If we \
add k consecutive values in such a sequence, we get\nk/(a+b i)(a + b(i + k)); \
it may happen that this can be simplified to a unit fraction again. By \
performing several simplifications, we both reduce the number of terms in the \
overall representation and also reduce some denominators. For instance, the \
continued fraction method for 7/15 gives"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{1/3, 1/15, 1/35, 1/63, 1/99, 1/143, 1/195}\
\>",
"\<\
1 1 1 1 1 1 1
{-, --, --, --, --, ---, ---}
3 15 35 63 99 143 195\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"But 1/15 + 1/35 + 1/63 = 1/9, and 1/99 + 1/143 + 1/195 = 1/45, so we can \
replace these triples and find the shorter representation "], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{1/3,1/9,1/45}\
\>", "\<\
1 1 1
{-, -, --}
3 9 45\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"This phenomenon is not unusual, and Bleicher [Ble72] showed how to take \
advantage of it to dramatically reduce the number of terms produced by the \
continued fraction method. Some care is required: if in the above list we \
instead group the last five terms, we get"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{1/3,1/15,1/15}\
\>", "\<\
1 1 1
{-, --, --}
3 15 15\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["which is not an Egyptian fraction representation."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"Our implementation finds all shortest representations rather than a single \
representation, so if they had distinct fractions we would return both \
representations above. We partition the secondary sequence into blocks of \
arithmetic progressions and find groupings separately within each \
progression; this is safe as the sum of all fractions from one progression is \
smaller than half of any fraction in a previous progression. Within a \
progression, we determine which groups of terms can be combined to form a \
unit fraction, and represent each group as an edge in a graph, labelled with \
the corresponding unit fraction. For the example above, the graph has eight \
vertices and ten edges, as follows:"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[GraphicsData["PostScript", "\<\
%!
%%Creator: Mathematica
%%AspectRatio: .30488
MathPictureStart
%% Graphics
/Courier findfont 10 scalefont setfont
% Scaling calculations
0.121951 0.121951 0.182927 0.121951 [
[ 0 0 0 0 ]
[ 1 .30488 0 0 ]
] MathScale
% Start of Graphics
1 setlinecap
1 setlinejoin
newpath
[ ] 0 setdash
0 g
p
P
0 0 m
1 0 L
1 .30488 L
0 .30488 L
closepath
clip
newpath
p
p
.004 w
.12195 .18293 m
.12195 .18293 .0122 0 365.73 arc
F
.2439 .18293 m
.2439 .18293 .0122 0 365.73 arc
F
.36585 .18293 m
.36585 .18293 .0122 0 365.73 arc
F
.4878 .18293 m
.4878 .18293 .0122 0 365.73 arc
F
.60976 .18293 m
.60976 .18293 .0122 0 365.73 arc
F
.73171 .18293 m
.73171 .18293 .0122 0 365.73 arc
F
.85366 .18293 m
.85366 .18293 .0122 0 365.73 arc
F
.97561 .18293 m
.97561 .18293 .0122 0 365.73 arc
F
P
p
.004 w
.12195 .18293 m
.2439 .18293 L
s
.2439 .18293 m
.36585 .18293 L
s
.36585 .18293 m
.4878 .18293 L
s
.4878 .18293 m
.60976 .18293 L
s
.60976 .18293 m
.73171 .18293 L
s
.73171 .18293 m
.85366 .18293 L
s
.85366 .18293 m
.97561 .18293 L
s
P
p
.004 w
.2439 .18293 m
.30488 .30488 L
.54878 .30488 L
.60976 .18293 L
s
.60976 .18293 m
.67073 .30488 L
.91463 .30488 L
.97561 .18293 L
s
.36585 .18293 m
.42683 .06098 L
.91463 .06098 L
.97561 .18293 L
s
P
p
[(1/3)] .18293 .15854 0 0 Mshowa
[(1/15)] .30488 .15854 0 0 Mshowa
[(1/35)] .42683 .15854 0 0 Mshowa
[(1/63)] .54878 .15854 0 0 Mshowa
[(1/99)] .67073 .15854 0 0 Mshowa
[(1/143)] .79268 .15854 0 0 Mshowa
[(1/195)] .91463 .15854 0 0 Mshowa
[(1/9)] .42683 .28049 0 0 Mshowa
[(1/45)] .79268 .28049 0 0 Mshowa
[(1/15)] .67073 .03659 0 0 Mshowa
P
P
% End of Graphics
MathPictureEnd
\
\>"], "Graphics",
Evaluatable->False,
AspectRatioFixed->True,
ImageSize->{337, 102},
ImageMargins->{{34, Inherited}, {Inherited, Inherited}},
ImageCache->GraphicsData["Bitmap", "\<\
CF5dJ6E]HGAYHf4PAg9QL6QYHggYjN[Vi^OShn03ooeGooj[ooonIgYjN[Vi^OShn03o
oclo?ginO[fm_Oclo5H/1JX00=d81_l0VOl0I_l0CXf=SLcCXf=SLcII03=VoalO7eiN
GYfMWMcLg02Z0200Go00<0o`001005o`030?oo00@00ol20003o`0000h0000h0005o`000?l0
1@001?l00?lH0005o`000?l01`000ol000040003o`0000`000?o00000`001Ol0003o00D000Co003o
1@000ol0000C0005o`000?l01@001?l00?l20004o`00oa@000Go0000o`070003o`0000<000?o0000
40001Ol0003o00L000?o00000`001Ol0003o008000?o00003@001Ol0003o00L000?o00000`000ol0
00040003o`3o0100000h0003o`00008000?o00001@000ol0000F0003o`00008000?o000010000ol0
00040003o`0000/000?o000010000ol000020003o`0000D000?o00000`000ol0000C0003o`000080
00?o00000P001?l00?l50003o`00018000?o00000P000ol000050003o`0000<000?o00003`000ol0
00020003o`0000@000?o00001Ol50003o`0000d000?o00000P000ol000040003o`0000@000?o0000
0`001?l00?l?0000>0000ol000020003o`0000<00_lI0003o`00008000?o000010001?l00003o`h0
00?o000010000ol000020003o`0000<00_l300?o5P000ol000020003o`0000800ol400;o5@000ol0
00020003o`0000<00ol300?o4@000ol000020003o`0000@000Co003o0P000ol0000200;o40000ol0
00020003o`0000@000?o00000P03o`800ol30003o`0000d0000h0003o`0000<000?o000010000ol0
000F0003o`0000<000?o00000`001Ol0003o00l000?o00001@000ol000030003o`0000@000Co003o
60000ol000030005o`000?l020000ol0000B0003o`0000<000Go0000o`020004o`00o`8000?o0000
3`000ol000030003o`0000<000Oo0000o`3o00H000?o00003@000ol000030003o`0000<000Go0000
o`020004o`00o`H000?o0000300003H00ol50005o`000?l00P000ol0000D00?o1@001?l00003o`<0
00?o00003@000ol0000300?o1@001Ol0003o008000Co003o5P03o`D000?o00000P000ol000020004
o`00oa800ol50005o`000?l00P001?l00?l20003o`0000d00ol50004o`0000?o1002o`<000Co003o
3@03o`D000Co00000ol30004o`00o`8000?o000010000ol0000<0000>0000ol000040004o`0000;o
6@000ol000040003o`00008000Co00001?l;0003o`0000H000?o000010001?l00002o`<01?lE0003
o`0000@000?o00000P02o`<00_lE0003o`0000@000Co00000_l400;o4P000ol000040003o`000080
00?o00000`000ol0000200;o40000ol000040003o`00008000?o00000P02o`<01?l40003o`0000/0
000Z00;o9P03obD01?lU00?o9@03obH00_lV00?o9004o`X0000X00Go8`06ob801_lS00Ko8P06ob<0
1OlS00Ko8P06o`T0000X00Go8`06ob801_lS00Ko8P06ob<01OlS00Ko8P06o`T0000W0?oo8ol80000
9P08ob402?lP00So8009ob002?lP00So8@08ob002?l800009`07ob801olQ00Oo8@08ob401olQ00Oo
8P07ob401ol800009`06ob<01_lR00Ko8P07ob801_lR00Ko8`06ob801_l90000:P02obL000?o0?l0
9@02obH00_lU0003o`3o00;o9@02obL000?o00008`001?l0ool:0000E@000ol0001b0005o`000?l0
M0000ol0000;0000EP000ol0001`0003o`0000<000?o0000L0000ol0000<0000EP000ol0001`0003
o`0000<000?o0000L0000ol0000<0000E`000ol0001^0003o`0000D000?o0000KP000ol0000=0000
E`000ol0001^0003o`0000D000?o0000KP000ol0000=0000F0000ol0001/0003o`0000L000?o0000
K0000ol0000>0000F0000ol0001/0003o`0000L000?o0000K0000ol0000>0000F@000ol0001Z0003
o`0000T000?o0000JP000ol0000?0000F@000ol0001Z0003o`0000T000?o0000JP000ol0000?0000
FP000ol0001X0003o`0000/000?o0000J0000ol0000@0000FP000ol0001X0003o`0000/000?o0000
J0000ol0000@0000F`000ol0001V0003o`0000d000?o0000IP000ol0000A0000F`000ol0001V0003
o`0000d000?o0000IP000ol0000A0000G0000ol0001T0003o`0000l000?o0000I0000ol0000B0000
G0000ol0001T0003o`0000l000?o0000I0000ol0000B0000G@000ol0001R0003o`00014000?o0000
HP000ol0000C0000G@000ol0001R0003o`00014000?o0000HP000ol0000C0000GP000ol0001P0003
o`0001<000?o0000H0000ol0000D0000GP000ol0001P0003o`0001<000?o0000H0000ol0000D0000
G`000ol0001N0003o`0001D000?o0000GP000ol0000E0000G`000ol0001N0003o`0001D000?o0000
GP000ol0000E0000H0000ol0001L0003o`0001L000?o0000G0000ol0000F0000H0000ol0001L0003
o`0001L000?o0000G0000ol0000F0000H@000ol0001J0003o`0001T000?o0000FP000ol0000G0000
H@000ol0000X0003o`0002l000?o00006@000ol0000U0003o`00038000?o00005`00068000?o0000
8P05o`030?l000@00_lX0003o`0001/000?o00007`05o`030?l000H000Co00000olT0003o`0001P0
001R0003o`0002@000Go0000o`070003o`0002D000?o00006`000ol0000Q0005o`000?l01`000ol0
00040003o`00024000?o0000600006<000?o00008`000ol000020003o`0000D000?o00008`000ol0
000M0003o`00020000?o00000P001?l00005o`D000?o000080000ol0000I0000H`000ol0000S0003
o`00008000?o00000`03obD000?o00007@000ol0000P0003o`00008000Go0000o`020004o`0000?o
8`000ol0000I0000I0000ol0000R0003o`0000<000Go0000o`020003o`00028000?o00007`000ol0
000O0003o`0000<000Oo0000o`3o00<000?o00008P000ol0000J0000I0000ol0000P00?o1@001Ol0
003o008000?o00008P000ol0000O0003o`0001d00ol50003o`0000800_l30003o`00028000?o0000
6P0006D000?o00008@000ol000040004o`0000;o90000ol0000Q0003o`0001h000?o000010000ol0
00020004o`0000Co80000ol0000K0000I@000ol0001B0003o`00024000?o0000DP000ol0000K0000
IP000ol0001@0003o`0002<000?o0000D0000ol0000L0000IP000ol0001@0003o`0002<000?o0000
D0000ol0000L0000I`1BobL0D_lO0000\
\>"],
ImageRangeCache->{{{0, 336}, {101, 0}} -> {-1.05848, -1.50002, 0.0247529,
0.0247529}}],
Cell[TextData[
"Each edge is directed from left to right. The horizontal edges represent \
the original terms produced by the continued fraction method, while the \
longer edges represent the groupings that result in unit fractions. Our task \
then becomes one of finding the shortest path through this graph, with the \
restriction that we cannot use two edges with the same label.\n\n\
Unfortunately finding paths without repeated labels is NP-complete, so an \
efficient algorithm for this subproblem is unlikely to exist. Fortunately \
most of the time our graphs have few repeated labels and the problem is not \
as hard as its worst case. We use the following heuristic: for increasing \
values of k, find all paths of k or fewer edges, and filter out the paths \
with repeated labels; if not all paths are filtered out, return the remaining \
list of paths. The theoretically fastest algorithm for listing all short \
paths takes constant time per path, after preprocessing time proportional to \
the time to find a single shortest path [Epp94], however for ease of \
implementation we use a simpler method invented by Byers and Waterman [BW84]. \
(The motivation of both papers was not Egyptian fractions, but rather \
comparison of DNA and protein sequences; this also turns out to be equivalent \
to a certain shortest path problem.)"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"First we include code to make an adjacency matrix for a graph, containing in \
each entry either the fraction corresponding to an edge in the graph, or the \
empty set if no such edge exists (i.e. if the corresponding sum of terms does \
not reduce to a unit fraction). The input to this routine is the secondary \
sequence of the continued fraction."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"ECFMakeGraph[l_] :=\n\tTable[If[iTrue,
AspectRatioFixed->True],
Cell[TextData[
"Next we include a shortest path algorithm, which takes as input the \
adjacency matrix above and produces a vector of distances from vertices to \
the last vertex. This vector is needed for our bounded length path search."],
"Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"ECFPathLengths[g_] := ECFPathLengths[g,Length[g]-1,{0}];\n\
ECFPathLengths[g_,i_,vec_] :=\n\tPrepend[vec, Min@@Table[If[g[[i,j]]==={},\n \
\t\t \t\t\t\t\tInfinity,\n \t\t\t\t\t\t\tvec[[j-i]]+1],\n \t\t\t\t\t\t\
{j,i+1,i+Length[vec]}]] //\n (If[i===1,#,ECFPathLengths[g,i-1,#]]&);"],
"Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"We now implement Byers and Waterman's algorithm for finding all paths that \
contain at most b more edges than are in the shortest path itself. We will \
call this algorithm repeatedly, using larger and larger values of b, until we \
find a path without repeated labels. Our implementation takes as input the \
graph, the value of b, the vertex to start at, the number of vertices, and \
the vector of distances produced above, but all but the first two can be \
omitted (in which case we supply appropriate values automatically).\n\nThe \
technique is simply to build the path one edge at a time. At each step we \
compute a value d measuring the amount by which the path length would \
increase if we followed the given edge instead of keeping to the shortest \
path (d=0 for shortest path edges). We subtract d from b and continue \
recursively as long as the result is nonnegative."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"ECFBoundedPaths[g_,b_] :=\n\t\
ECFBoundedPaths[g,b,1,Length[g],ECFPathLengths[g]];\n\
ECFBoundedPaths[g_,b_,i_,l_,v_] :=\n If[i===l,{{}},\n \
Join@@Table[If[g[[i,j]]==={},Infinity,\n \t\t\t\t\t\t\t\t\
1+v[[j]]-v[[i]]] //\n \t\t\t (If[#>b,{},(Prepend[#,g[[i,j]]]&) /@\n \
\t\t\t\t\t \t ECFBoundedPaths[g,b-#,j,l,v]]&),\n \t\t\t \
{j,i+1,l}]]\n \t\t\t\t\t \t \t "], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"We next include code for removing from the list those paths that contain a \
duplicated fraction.\nIt is not clear that the paths will have the fractions \
listed in sorted order, so we sort them first."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"ECFContainsDupl[{___,q_,q_,___}] := True;\nECFContainsDupl[l_] := False;\n \
\t\t \nECFFilterDuplSub[x_] :=\n If[ECFContainsDupl[x],{},{x}];"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"ECFFilterDupls[l_] :=\n Join @@ (ECFFilterDuplSub[Reverse[Sort[#]]]&) /@ \
l;\n \nECFShortFilter[g_] := ECFShortFilter[g,ECFPathLengths[g],0];\n\
ECFShortFilter[g_,v_,b_] :=\n\t\
ECFFilterDupls[ECFBoundedPaths[g,b,1,Length[g],v]] //\n \t\
(If[#==={},ECFShortFilter[g,v,b+1],#]&);"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"The next function applies all of the above steps for three-term continued \
fractions. The final algorithm applies this to several three-term \
subsequences of the whole continued fraction."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"ECFArithSeq[a_,b_,c_]:=ECFShortFilter[\n\t\t\t\t\t \t \
ECFMakeGraph[CFSecondarySeq[{a,b,c}]]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"The next function takes two lists of lists, and forms all pairwise \
concatenations of one item from the first list and one from the second. The \
obvious approach of using ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Outer[Join,...]",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[" ",
Evaluatable->False,
AspectRatioFixed->True,
FontWeight->"Bold"],
StyleBox["doesn't work since ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Outer",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[
" interprets lists of lists as tensors, so we use an alternate method based \
on ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Distribute",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[".",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"OuterJoin[ll_,mm_] :=\n\tDistribute[{ll,mm},List,List,List,Join];"], "Input",\
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"We are finally ready to define the overall modified continued fraction \
method, which breaks the primary sequence into subsequences and calls ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["ECFArithSeq",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[" on each one.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"ECFSecondaryPaths[l_] :=\n If[Length[l]<3,{{}},\n \
OuterJoin[ECFArithSeq[l[[1]],l[[2]],l[[3]]],\n \t\t\t \
ECFSecondaryPaths[Drop[l,2]]]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"EgyptGroupedCF[q_] :=\n ECFSecondaryPaths[CFPrimarySeq[\n \t\
CFMakeOdd[ContinuedFractionList[q]]]]"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"Every step involves a fixed number of nested loops with indices bounded by \
the length of the secondary sequence, so (with the possible exception of \
finding a short repetition-free path) the overall time is polynomial in the \
numerator of the original rational number given as input.\nIt is not hard to \
see that the algorithm produces sequences of fractions formed by grouping the \
results of the continued fraction method, so the sum of the sequence is \
correct. It remains to verify that no fraction is duplicated. This is \
checked explicitly within each subsequence, and the entire sum of any \
subsequence is less than half any single fraction in previous subsequences, \
so no two separate subsequences can produce duplications.\n\nAs in the \
continued fraction method, the largest denominator in the representation of \
x/y is O[y^2]. The number of terms is still O[x] but it can also be analyzed \
in terms of y.\nBleicher [Ble72] shows that by choosing a prime p with \
gcd(a,p)=1 and p=O(log a),\nand using groups with sizes equal to powers of p, \
one can find a representation with\nO(p Log[b]/Log[p]) = O(Log[x]Log[y]/Log \
Log[y]) terms.\nSince the actual representation is chosen to have minimum \
length, it can be no longer than this.\nIt remains unclear whether the \
implementation above really takes polynomial time, or whether there can be \
sufficiently many repeated labels that the algorithm for listing short paths \
has to list a large number of paths and slows down to exponential. However \
in practice this method seems to work well. (Bleicher's method of grouping \
can apparently be done in polynomial time.)"], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptGroupedCF[31/311]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{{1/11, 1/121, 1/2541, 1/9933, 1/93611}}\
\>",
"\<\
1 1 1 1 1
{{--, ---, ----, ----, -----}}
11 121 2541 9933 93611\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[
"The graph constructed for 31/311 is too complicated to depict here. It has \
two paths of length five; however one of the paths is eliminated because it \
has two copies of the label 1/231."], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData["A Hybrid Pairing / Continued Fraction Method"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"We can use potentially even fewer terms than the grouped continued \
fraction method, at the expense of possibly increasing the maximum \
denominator in the representation. We simply find shortest paths in the same \
graph constructed by that method, ignoring the possibility of repeated \
labels, and then make the unit fractions in the resulting representation \
distinct by applying ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["EgyptPairList",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Courier"],
StyleBox[".",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"EHArithSeq[a_,b_,c_] := ECFBoundedPaths[\n\t\
ECFMakeGraph[CFSecondarySeq[{a,b,c}]],0]\n\nEHSecondaryPaths[l_] :=\n \
If[Length[l]<3,{{}},\n OuterJoin[EHArithSeq[l[[1]],l[[2]],l[[3]]],\n \
\t\t\t EHSecondaryPaths[Drop[l,2]]]]\n\nEgyptHybrid[q_] := EgyptPairList \
/@\n EHSecondaryPaths[CFPrimarySeq[\n \t\
CFMakeOdd[ContinuedFractionList[q]]]];"], "Input",
InitializationCell->True,
AspectRatioFixed->True],
Cell[TextData[
"This method uses O(Log[x]Log[y]/Log Log[y]) terms to represent any number \
x/y. In the following example, we see representations corresponding to both \
shortest paths in the graph constructed for 31/311."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["EgyptHybrid[31/311]"], "Input",
AspectRatioFixed->True],
Cell[OutputFormData["\<\
{{1/11, 1/116, 1/9933, 1/26796, 1/93611},
{1/11, 1/121, 1/2541, 1/9933, 1/93611}}\
\>",
"\<\
1 1 1 1 1
{{--, ---, ----, -----, -----},
11 116 9933 26796 93611
1 1 1 1 1
{--, ---, ----, ----, -----}}
11 121 2541 9933 93611\
\>"], "Output",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["Small Numerators"], "Section",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The algorithms described above work for any input. We now discuss \
techniques limited to specific numerators. The typical question here is how \
many terms are needed to represent fractions with a given numerator. For \
fractions 2/y the answer is clearly 2. Some fractions 3/y require 3 terms, \
as we see below. It is not known whether any fraction 4/y requires 4 terms.\n\
\nMore generally, good bounds are known on the number of terms needed to \
represent x/y measured as a function of y [Vos85], but there seems to be less \
work on measuring this minimum number of terms as a function only of x. As \
we note in the section on 4/y, a solution to this specific case would have \
implications for the general problem."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["Numerator 3"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The basic result for fractions of the form 3/y is that there is a two-term \
expansion if and only if y has a factor congruent to 2 mod 3. Klee and Wagon \
[KW91] credit this result to N.\:02daNakayama; however they supply no \
citation, so we repeat the proof below."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"Theorem: 3/y has a two-term expansion if and only if y has a factor \
congruent to 2 mod 3."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"Proof: In one direction, the representation 3/(3n+2)=1/(n+1)+1/(n+1)(3n+2) \
is found by both the greedy and continued fraction methods. This idea can \
easily be extended to 3/y where y is a multiple of 3n+2."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"In the other direction, suppose y=3n+1 and 3/y=1/a+1/b=(a+b)/ab. First note \
that a and b must be divisible by the same power of 3, since if a were \
divisible by 3^i and b by 3^j, with j>i, then a+b would not divisible by 3^j \
and the powers of 3 wouldn't cancel from the denominator. Let g=gcd(a,b), \
u=a/g, v=b/g, so 3/y=(u+v)/guv and 3 divides u+v; let u+v=3z. Then \
1/a+1/b=3z/guv and g must factor as zw since gcd(uv,u+v)=1. So y=uvw. For \
u+v=3z, one of u and v (say u) must be 2 mod 3, giving the factor of y we \
seek."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"Unfortunately this seems to imply that finding short representations, even \
in this special case, is computationally difficult: at least as difficult as \
factoring integers."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"Some examples of two-term representations that would not be found by our \
general algorithms: 3/25=1/10+1/50; 3/55=1/22+1/110=1/20+1/220; \
3/121=1/44+1/484"], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData["Numerator 4"], "Subsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The question of whether all fractions 4/y have 3-term representations is \
discussed by Mordell [Mor69], who attributes it to Erdos and Straus. Guy \
[Guy81] cites several other authors as having worked on the problem: \
Bernstein, Obl\[CapitalCCedilla]th, Rosati, Shapiro, Straus, Yamamoto, and \
Franceschine. Others have worked on more general versions of this problem \
including Schinzel, Sierpinski, Sedl\[CapitalCCedilla]cek, Palam\
\[CapitalEGrave], Stewart, Webb, Breusch, Graham, and Vaughan.\nA positive \
solution to this question would have more general implications: we could use \
such a solution as the basis for a conflict resolution method that, given a \
number x/y, would find an Egyptian fraction representation with \
x^(Log[3]/Log[4]) \.af x^0.7925 terms."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[CellGroupData[{Cell[TextData["Modular Conditions"], "Subsubsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"Mordell shows that in any example 4/y requiring 4 terms in an Egyptian \
fraction representation, y must be 1 mod 24, \[Dash]1 mod 5, and one of three \
values mod 7 (giving a total of 6 possible values mod 840, all squares of \
small numbers). If y is a minimal counterexample, it must be prime (since if \
y=ab we could divide all terms in a representation of 4/a by b)."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"If y is 2 or 3 mod 4, the greedy algorithm gives a 2 or 3 term \
representation. If y is 3 mod 6, we have the representation 3/y+1/y. And if \
y is 5 mod 6, we have the representation 1/ceil[y/6] + 3/(y ceil[y/6]) where \
the last term has a 2-term expansion by our previous analysis. So if 4/y is \
to fail to have a 3 term representation, y must be of the form 24n + 1. \
Several methods extend this analysis by representing 4/y when y (equivalently \
n) has certain values modulo small primes."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The representations 1/(6n+1) + 3/(24n+1)(6n+1) and 1/(18n+1)(24n+1) + \
3/(18n+1) work if one of 6n+1, 18n+1, or 24n+1 is divisible by a prime p \
congruent to 5 mod 6. Thus for any of these primes one can derive rules for \
finding three-term representations of 4/y, that work whenever y has certain \
values mod p. We can use this technique to find representations when n is \
congruent to 4, 3, or 1 mod 5 (and so, rule out counterexamples for y \
congruent to anything but \[Dash]1 mod 5)."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"The representation 1/(6n+k) + (4k-1)/(6n+k)(24n+1) works via a greedy method \
if a factor of the second denominator is (4k-2) mod (4k-1), or more generally \
if the factor is (4k-1-i) mod (4k-1) and i divides the denominator. In \
particular these work with k=2 when n is 2, 3, 4, or 6 mod 7 (with the \
corresponding values of i being 0, 1, 1, and 2). Therefore in any \
counterexample 4/y, y must be a quadratic residue mod 7."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"Yet another type of rule is possible: consider the decomposition\n1/(6n+k) \
+a/(6n+k)(24n+1) + b/(6n+k)(24n+1), where a+b = 4k-1. This is only possible \
when k is even, since otherwise one of a or b would be even and not divide \
the denominator.\nFor instance 4/(24n+1)=1/(6n+10) + 26/(6n+10)(24n+1) + \
13/(6n+10)(24n+1)\nwhere the last two simplify to unit fractions if n is 7 \
mod 13."], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData["Particular Values"], "Subsubsection",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"As noted above, the numbers y for which 4/y might possibly require four \
terms fall into six classes modulo 840: 1, 121, 169, 289, 361, and 529. We \
only need to consider prime n since if mn is a counterexample, so must be \
both m and n. Following are representations for all such cases through \
12500. Most use rules like the ones described above that depend only on the \
values of y mod 11, 13, and 19, but 4/3361 uses a method that depends on y \
mod 29 and 4/8089 uses a method that depends on y mod 17."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData["4/1801 = 1/451 + 1/295364 + 1/3249004"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/2521 = 1/636 + 1/69748 + 1/131876031"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/2689 = 1/676 + 1/139828 + 1/908882"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/3049 = 1/772 + 1/60980 + 1/5884570"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/3361 = 1/841 + 1/974690 + 1/28266010"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/3529 = 1/892 + 1/80726 + 1/569764108"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/3889 = 1/975 + 1/345150 + 1/268457670"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/4201 = 1/1096 + 1/25208 + 1/13237351"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/4561 = 1/1244 + 1/13684 + 1/15603181"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/4729 = 1/1185 + 1/510732 + 1/201739140"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/5209 = 1/1308 + 1/296262 + 1/3086457516"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/5569 = 1/1402 + 1/200484 + 1/140539284"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/5881 = 1/1604 + 1/17644 + 1/25941091"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/6841 = 1/1713 + 1/1065486 + 1/7288989726"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/7681 = 1/1924 + 1/1136788 + 1/7389122"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/8089 = 1/2023 + 1/5775546 + 1/98184282"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/8521 = 1/2324 + 1/25564 + 1/54457711"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/8689 = 1/2175 + 1/1718250 + 1/14929874250"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/8761 = 1/2196 + 1/836676 + 1/3665059218"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/8929 = 1/2233 + 1/7250348 + 1/79753828"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/9241 = 1/2314 + 1/1644898 + 1/10691837"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/9601 = 1/2406 + 1/1008105 + 1/269500070"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/9769 = 1/2452 + 1/614226 + 1/12000747588"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/10369 = 1/2828 + 1/31108 + 1/80639713"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/12049 = 1/3016 + 1/2795368 + 1/18169892"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData["4/12289 = 1/3078 + 1/1644678 + 1/30317171913"], "Text",
Evaluatable->False,
AspectRatioFixed->True,
FontFamily->"Times",
FontWeight->"Plain",
FontSlant->"Italic",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
Cell[TextData[{
StyleBox[
"According to Guy, N. Franceschine has performed similar calculations for ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["y<10^8",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[".",
Evaluatable->False,
AspectRatioFixed->True,
FontSize->11]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]]}, Open]]}, Open]],
Cell[CellGroupData[{Cell[TextData["References"], "Section",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"[Bee93]\nL. Beeckmans. The splitting algorithm for Egyptian fractions. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["J. Number Th.",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" 43, 1993, pp. 173--185. This paper contains a proof that the splitting \
method terminates; Wagon [Wag91] credits the same result to Graham and \
Jewett.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"[Ble72]\nM. N. Bleicher. A new algorithm for the expansion of continued \
fractions. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["J. Number Th.",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" 4, 1972, pp. 342--382. Defines two methods for Egyptian fraction \
representation: what he calls the Farey sequence method, which is equivalent \
to the continued fraction method described here, and what he calls the \
continued fraction method, which is a variant of what we call the grouped \
continued fraction method.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"[Bre54]\nR. Breusch. A special case of Egyptian fractions, solution to \
advanced problem 4512. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Amer. Math. Monthly",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" 61, 1954, pp. 200--201. Shows that every x/y with y odd has an Egyptian \
fraction representation with all denominators odd, by using a method similar \
to the binary remainder method but using the base 5(3^k) instead of 2^k.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"[BW84]\nT. H. Byers and M. S. Waterman. Determining all optimal and \
near-optimal solutions when solving shortest path problems by dynamic \
programming. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Oper. Res.",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" 32,1984, pp. 1381--1384. Byers and Waterman describe a simple algorithm \
for finding short paths in a graph, used in our implementation of the grouped \
continued fraction method.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["[Epp94]\nD. Eppstein. Finding the ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["k",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[" shortest paths. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["35th IEEE Symp. Foundations of Computer Science",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
", 1994, pp. 154--165. I describe what is theoretically the fastest known \
algorithm for the shortest path problem used in the grouped continued \
fraction method, however my technique is rather more complex than that of \
[BW84] and has not been implemented.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["[Guy81]\nR.K. Guy. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Unsolved Problems in Number Theory",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
". Springer-Verlag, 1981, pp. 87\[LongDash]93. Guy lists a number of \
questions about Egyptian fractions, including the following:\nDoes 4/y have a \
3-term representation for all y?\n\nDoes 5/y? Does x/y for x sufficiently \
large relative to y?\n\nDoes the odd greedy method terminate?\n\nWhat \
different denominators are possible in a t-term representation of one?\n\nDo \
all positive-density sets of integers have a subset forming the denominators \
of a representation of one?\n\nIf we assign to each of the integers one of a \
finite set of colors, can we pick a single color that can be used as the \
denominators for representations of all rationals? Guy",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox[" also ",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["[KW91]\nV. Klee and S. Wagon. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox[
"Old and New Unsolved Problems in Plane Geometry and Number Theory",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
". Math. Assoc. of America, 1991, pp. 175--177 and 206\[LongDash]208. \
Concentrates primarily on the question of whether the odd greedy method \
halts; notes that a similar method for finding representations with even \
denominators does halt; contains a number of further references.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["[Mor69]\nL. J. Mordell. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Diophantine Equations",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
". Academic Press, 1969, pp. 287--290. Discusses the question of whether \
4/y has a three-term representation; describes methods of finding such \
representations depending on the value of n modulo various small primes.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["[NZ80]\nI. Niven and H.S. Zuckerman. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["An Introduction to the Theory of Numbers",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
", 4th ed., Wiley, 1980, p. 200. They describe in an exercise here the \
secondary sequences used in the continued fraction methods of Egyptian \
fraction representation.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"[Ste54]\nB. M. Stewart. Sums of distinct divisors. Amer. J. Math. 76, \
1954, pp. 779--785. Uses the binary remainder method to find representations \
with all denominators even. Also, like [Bre54], uses a method similar to the \
binary remainder method (using base 35(3^k)) to find odd representations of \
fractions with odd denominators."], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["[Ste92]\nI. Stewart. The riddle of the vanishing camel. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Scientific American",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[", June 1992, pp. 122",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["--",
Evaluatable->False,
AspectRatioFixed->True,
FontSize->11],
StyleBox[
"124. Stewart shows that any rational has only a finite number of t-term \
Egyptian fraction representations, for any fixed number t, and describes a \
brute force method for finding all such representations.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox[
"[TY90]\nG. Tenenbaum and H. Yokota. Length and denominators of Egyptian \
fractions. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["J. Number Th.",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" 35, 1990, pp. 150--156. This paper provides good simultanous bounds on \
the number of terms and the denominators of an Egyptian fraction \
representation, as discussed in the section on the binary remainder method.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["[Vos85]\nM. Vose. Egyptian fractions. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Bull. Lond. Math. Soc.",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
" 17, 1985, p. 21. Shows that every x/y has a t-term representation where \
t=O(Sqrt Log[y]). The technique is similar to the binary remainder method.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[{
StyleBox["[Wag91]\nS. Wagon. ",
Evaluatable->False,
AspectRatioFixed->True],
StyleBox["Mathematica in Action",
Evaluatable->False,
AspectRatioFixed->True,
FontSlant->"Italic"],
StyleBox[
". W.H. Freeman, 1991, pp. 271--277. Wagon implements the greedy and odd \
greedy methods, and describes the splitting method. He also mentions the open \
problem of whether the odd greedy method always terminates for the special \
case of fractions with numerator 2.",
Evaluatable->False,
AspectRatioFixed->True]
}], "Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[CellGroupData[{Cell[TextData["About the Author"], "Section",
Evaluatable->False,
AspectRatioFixed->True],
Cell[TextData[
"David Eppstein received his Ph.D. in computer science from Columbia \
University in 1989.\nAfter a postdoctorate at the Xerox Palo Alto Research \
Center, he took a position at the University of California, Irvine, where he \
is now an associate professor. Prof. Eppstein's primary research areas are \
graph algorithms and computational geometry; his work is supported by an NSF \
National Young Investigator award and by matching funds from Xerox Corp."],
"Text",
Evaluatable->False,
AspectRatioFixed->True]}, Open]],
Cell[TextData[{
StyleBox[
"David Eppstein\nDepartment of Information and Computer Science\nUniversity \
of California, Irvine CA 92717\n",
Evaluatable->False,
TextAlignment->Left,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->12,
FontWeight->"Plain",
FontSlant->"Plain",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
StyleBox["eppstein@ics.uci.edu",
Evaluatable->False,
TextAlignment->Left,
AspectRatioFixed->True,
FontFamily->"Courier",
FontSize->12,
FontWeight->"Plain",
FontSlant->"Plain",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
StyleBox["\n",
Evaluatable->False,
TextAlignment->Left,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->12,
FontWeight->"Plain",
FontSlant->"Plain",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}],
StyleBox["http://www.ics.uci.edu/~eppstein/",
Evaluatable->False,
TextAlignment->Left,
AspectRatioFixed->True,
FontFamily->"Courier",
FontSize->12,
FontWeight->"Plain",
FontSlant->"Plain",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}]
}], "Subsubtitle",
Evaluatable->False,
TextAlignment->Left,
AspectRatioFixed->True,
FontFamily->"Times",
FontSize->12,
FontWeight->"Plain",
FontSlant->"Plain",
FontTracking->"Plain",
FontVariations->{"Underline"->False,
"Outline"->False,
"Shadow"->False}]}, Open]]
},
FrontEndVersion->"Macintosh 3.0",
ScreenRectangle->{{0, 640}, {0, 460}},
AutoGeneratedPackage->None,
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{520, 365},
WindowMargins->{{20, Automatic}, {30, Automatic}},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
MacintoshSystemPageSetup->"\<\
AVU/IFiQKFD000000V:^/09R]g0000000OVaH097bCP0AP1Y06`0I@1^0642HZj`
0V:gT0000001nK500TO9>000000000000000009R[[0000000000000000000000
00000000000000000000000000000000\>"
]
(***********************************************************************
Cached data follows. If you edit this Notebook file directly, not using
Mathematica, you must remove the line containing CacheID at the top of
the file. The cache data will then be recreated when you save this file
from within Mathematica.
***********************************************************************)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[1731, 51, 113, 3, 70, "Title",
Evaluatable->False],
Cell[1847, 56, 195, 6, 70, "Subsubtitle",
Evaluatable->False],
Cell[2045, 64, 178, 4, 70, "Subsubtitle",
Evaluatable->False],
Cell[2226, 70, 1386, 36, 70, "Text",
Evaluatable->False],
Cell[3615, 108, 1131, 25, 70, "Text",
Evaluatable->False],
Cell[4749, 135, 812, 25, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[5584, 162, 107, 2, 70, "Section",
Evaluatable->False],
Cell[5694, 166, 570, 9, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[6287, 177, 97, 2, 70, "Subsection",
Evaluatable->False],
Cell[6387, 181, 1532, 52, 70, "Text",
Evaluatable->False],
Cell[7922, 235, 387, 7, 70, "Input",
InitializationCell->True],
Cell[8312, 244, 2995, 106, 70, "Text",
Evaluatable->False],
Cell[11310, 352, 2434, 87, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[13767, 441, 71, 1, 70, "Input"],
Cell[13841, 444, 172, 8, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[14025, 454, 353, 6, 70, "Text",
Evaluatable->False],
Cell[14381, 462, 208, 4, 70, "Text",
Evaluatable->False],
Cell[14592, 468, 166, 4, 70, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[14781, 474, 81, 1, 70, "Input"],
Cell[14865, 477, 131, 7, 70, "Output",
Evaluatable->False]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[15037, 486, 99, 2, 70, "Subsection",
Evaluatable->False],
Cell[15139, 490, 1981, 55, 70, "Text",
Evaluatable->False],
Cell[17123, 547, 239, 5, 70, "Input",
InitializationCell->True],
Cell[17365, 554, 190, 5, 70, "Input",
InitializationCell->True],
Cell[17558, 561, 2536, 71, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[20117, 634, 75, 1, 70, "Input"],
Cell[20195, 637, 252, 10, 70, "Output",
Evaluatable->False]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[20488, 649, 101, 2, 70, "Subsection",
Evaluatable->False],
Cell[20592, 653, 1048, 33, 70, "Text",
Evaluatable->False],
Cell[21643, 688, 385, 7, 70, "Input",
InitializationCell->True],
Cell[22031, 697, 1561, 48, 70, "Text",
Evaluatable->False],
Cell[23595, 747, 211, 5, 70, "Input",
InitializationCell->True],
Cell[CellGroupData[{
Cell[23829, 754, 74, 1, 70, "Input"],
Cell[23906, 757, 188, 9, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[24126, 768, 84, 1, 70, "Input"],
Cell[24213, 771, 133, 7, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[24358, 780, 2318, 65, 70, "Text",
Evaluatable->False],
Cell[26679, 847, 197, 4, 70, "Input"],
Cell[CellGroupData[{
Cell[26899, 853, 91, 1, 70, "Input"],
Cell[26993, 856, 12565, 624, 70, 4934, 525, "GraphicsData",
"PostScript", "Graphics",
Evaluatable->False]
}, Closed]],
Cell[39570, 1482, 827, 12, 70, "Text",
Evaluatable->False]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[40438, 1496, 104, 2, 70, "Section",
Evaluatable->False],
Cell[40545, 1500, 1012, 23, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[41580, 1525, 98, 2, 70, "Subsection",
Evaluatable->False],
Cell[41681, 1529, 1456, 38, 70, "Text",
Evaluatable->False],
Cell[43140, 1569, 458, 8, 70, "Input",
InitializationCell->True],
Cell[43601, 1579, 1269, 18, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[44893, 1599, 72, 1, 70, "Input"],
Cell[44968, 1602, 213, 9, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[45193, 1613, 367, 6, 70, "Text",
Evaluatable->False],
Cell[45563, 1621, 977, 27, 70, "Text",
Evaluatable->False],
Cell[46543, 1650, 582, 22, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[47157, 1674, 100, 2, 70, "Subsection",
Evaluatable->False],
Cell[47260, 1678, 568, 9, 70, "Text",
Evaluatable->False],
Cell[47831, 1689, 313, 6, 70, "Input",
InitializationCell->True],
Cell[48147, 1697, 637, 10, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[48807, 1709, 72, 1, 70, "Input"],
Cell[48882, 1712, 905, 30, 70, "Output",
Evaluatable->False]
}, Closed]]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[49837, 1744, 118, 2, 70, "Section",
Evaluatable->False],
Cell[CellGroupData[{
Cell[49978, 1748, 97, 2, 70, "Subsection",
Evaluatable->False],
Cell[50078, 1752, 1554, 36, 70, "Text",
Evaluatable->False],
Cell[51635, 1790, 672, 10, 70, "Text",
Evaluatable->False],
Cell[52310, 1802, 793, 13, 70, "Input",
InitializationCell->True],
Cell[53106, 1817, 426, 7, 70, "Text",
Evaluatable->False],
Cell[53535, 1826, 919, 14, 70, "Input",
InitializationCell->True],
Cell[54457, 1842, 1036, 29, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[55516, 1873, 71, 1, 70, "Input"],
Cell[55590, 1876, 336, 12, 70, "Output",
Evaluatable->False]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[55967, 1890, 107, 2, 70, "Subsection",
Evaluatable->False],
Cell[56077, 1894, 1037, 28, 70, "Text",
Evaluatable->False],
Cell[57117, 1924, 423, 7, 70, "Input",
InitializationCell->True],
Cell[57543, 1933, 216, 5, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[57782, 1940, 71, 1, 70, "Input"],
Cell[57856, 1943, 169, 8, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[58037, 1953, 839, 12, 70, "Text",
Evaluatable->False]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[58917, 1967, 103, 2, 70, "Section",
Evaluatable->False],
Cell[CellGroupData[{
Cell[59043, 1971, 109, 2, 70, "Subsection",
Evaluatable->False],
Cell[59155, 1975, 563, 16, 70, "Text",
Evaluatable->False],
Cell[59721, 1993, 492, 16, 70, "Output",
Evaluatable->False],
Cell[60216, 2011, 188, 4, 70, "Text",
Evaluatable->False],
Cell[60407, 2017, 1090, 28, 70, "Text",
Evaluatable->False],
Cell[61500, 2047, 187, 9, 70, "Output",
Evaluatable->False],
Cell[61690, 2058, 789, 20, 70, "Text",
Evaluatable->False],
Cell[62482, 2080, 699, 19, 70, "Text",
Evaluatable->False],
Cell[63184, 2101, 321, 6, 70, "Input",
InitializationCell->True],
Cell[63508, 2109, 190, 4, 70, "Text",
Evaluatable->False],
Cell[63701, 2115, 382, 7, 70, "Input",
InitializationCell->True],
Cell[64086, 2124, 346, 6, 70, "Text",
Evaluatable->False],
Cell[64435, 2132, 282, 5, 70, "Input",
InitializationCell->True],
Cell[64720, 2139, 937, 14, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[65680, 2155, 82, 1, 70, "Input"],
Cell[65765, 2158, 188, 9, 70, "Output",
Evaluatable->False]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[65994, 2169, 117, 2, 70, "Subsection",
Evaluatable->False],
Cell[66114, 2173, 732, 11, 70, "Text",
Evaluatable->False],
Cell[66849, 2186, 232, 9, 70, "Output",
Evaluatable->False],
Cell[67084, 2197, 208, 4, 70, "Text",
Evaluatable->False],
Cell[67295, 2203, 145, 8, 70, "Output",
Evaluatable->False],
Cell[67443, 2213, 344, 6, 70, "Text",
Evaluatable->False],
Cell[67790, 2221, 149, 8, 70, "Output",
Evaluatable->False],
Cell[67942, 2231, 123, 2, 70, "Text",
Evaluatable->False],
Cell[68068, 2235, 792, 12, 70, "Text",
Evaluatable->False],
Cell[68863, 2249, 8770, 206, 70, 1660, 113, "GraphicsData",
"PostScript", "Graphics",
Evaluatable->False],
Cell[77636, 2457, 1408, 20, 70, "Text",
Evaluatable->False],
Cell[79047, 2479, 426, 7, 70, "Text",
Evaluatable->False],
Cell[79476, 2488, 261, 5, 70, "Input",
InitializationCell->True],
Cell[79740, 2495, 300, 6, 70, "Text",
Evaluatable->False],
Cell[80043, 2503, 376, 7, 70, "Input",
InitializationCell->True],
Cell[80422, 2512, 964, 14, 70, "Text",
Evaluatable->False],
Cell[81389, 2528, 488, 9, 70, "Input",
InitializationCell->True],
Cell[81880, 2539, 277, 5, 70, "Text",
Evaluatable->False],
Cell[82160, 2546, 226, 4, 70, "Input",
InitializationCell->True],
Cell[82389, 2552, 367, 7, 70, "Input",
InitializationCell->True],
Cell[82759, 2561, 265, 5, 70, "Text",
Evaluatable->False],
Cell[83027, 2568, 178, 4, 70, "Input",
InitializationCell->True],
Cell[83208, 2574, 1034, 36, 70, "Text",
Evaluatable->False],
Cell[84245, 2612, 149, 4, 70, "Input",
InitializationCell->True],
Cell[84397, 2618, 475, 15, 70, "Text",
Evaluatable->False],
Cell[84875, 2635, 235, 5, 70, "Input",
InitializationCell->True],
Cell[85113, 2642, 187, 4, 70, "Input",
InitializationCell->True],
Cell[85303, 2648, 1728, 24, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[87054, 2674, 75, 1, 70, "Input"],
Cell[87132, 2677, 229, 9, 70, "Output",
Evaluatable->False]
}, Closed]],
Cell[87373, 2688, 265, 5, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[87670, 2695, 124, 2, 70, "Subsection",
Evaluatable->False],
Cell[87797, 2699, 709, 19, 70, "Text",
Evaluatable->False],
Cell[88509, 2720, 447, 8, 70, "Input",
InitializationCell->True],
Cell[88959, 2730, 281, 5, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[89263, 2737, 72, 1, 70, "Input"],
Cell[89338, 2740, 371, 15, 70, "Output",
Evaluatable->False]
}, Closed]]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[89759, 2757, 93, 2, 70, "Section",
Evaluatable->False],
Cell[89855, 2761, 804, 12, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[90682, 2775, 91, 2, 70, "Subsection",
Evaluatable->False],
Cell[90776, 2779, 343, 6, 70, "Text",
Evaluatable->False],
Cell[91122, 2787, 166, 4, 70, "Text",
Evaluatable->False],
Cell[91291, 2793, 285, 5, 70, "Text",
Evaluatable->False],
Cell[91579, 2800, 610, 10, 70, "Text",
Evaluatable->False],
Cell[92192, 2812, 250, 5, 70, "Text",
Evaluatable->False],
Cell[92445, 2819, 232, 5, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[92709, 2826, 91, 2, 70, "Subsection",
Evaluatable->False],
Cell[92803, 2830, 854, 13, 70, "Text",
Evaluatable->False],
Cell[CellGroupData[{
Cell[93680, 2845, 101, 2, 70, "Subsubsection",
Evaluatable->False],
Cell[93784, 2849, 448, 7, 70, "Text",
Evaluatable->False],
Cell[94235, 2858, 575, 9, 70, "Text",
Evaluatable->False],
Cell[94813, 2869, 570, 9, 70, "Text",
Evaluatable->False],
Cell[95386, 2880, 506, 8, 70, "Text",
Evaluatable->False],
Cell[95895, 2890, 467, 8, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[96394, 2900, 100, 2, 70, "Subsubsection",
Evaluatable->False],
Cell[96497, 2904, 591, 9, 70, "Text",
Evaluatable->False],
Cell[97091, 2915, 284, 9, 70, "Text",
Evaluatable->False],
Cell[97378, 2926, 285, 9, 70, "Text",
Evaluatable->False],
Cell[97666, 2937, 283, 9, 70, "Text",
Evaluatable->False],
Cell[97952, 2948, 283, 9, 70, "Text",
Evaluatable->False],
Cell[98238, 2959, 285, 9, 70, "Text",
Evaluatable->False],
Cell[98526, 2970, 285, 9, 70, "Text",
Evaluatable->False],
Cell[98814, 2981, 286, 9, 70, "Text",
Evaluatable->False],
Cell[99103, 2992, 285, 9, 70, "Text",
Evaluatable->False],
Cell[99391, 3003, 285, 9, 70, "Text",
Evaluatable->False],
Cell[99679, 3014, 287, 9, 70, "Text",
Evaluatable->False],
Cell[99969, 3025, 288, 9, 70, "Text",
Evaluatable->False],
Cell[100260, 3036, 287, 9, 70, "Text",
Evaluatable->False],
Cell[100550, 3047, 285, 9, 70, "Text",
Evaluatable->False],
Cell[100838, 3058, 289, 9, 70, "Text",
Evaluatable->False],
Cell[101130, 3069, 286, 9, 70, "Text",
Evaluatable->False],
Cell[101419, 3080, 287, 9, 70, "Text",
Evaluatable->False],
Cell[101709, 3091, 285, 9, 70, "Text",
Evaluatable->False],
Cell[101997, 3102, 290, 9, 70, "Text",
Evaluatable->False],
Cell[102290, 3113, 288, 9, 70, "Text",
Evaluatable->False],
Cell[102581, 3124, 287, 9, 70, "Text",
Evaluatable->False],
Cell[102871, 3135, 287, 9, 70, "Text",
Evaluatable->False],
Cell[103161, 3146, 288, 9, 70, "Text",
Evaluatable->False],
Cell[103452, 3157, 289, 9, 70, "Text",
Evaluatable->False],
Cell[103744, 3168, 286, 9, 70, "Text",
Evaluatable->False],
Cell[104033, 3179, 288, 9, 70, "Text",
Evaluatable->False],
Cell[104324, 3190, 291, 9, 70, "Text",
Evaluatable->False],
Cell[104618, 3201, 409, 16, 70, "Text",
Evaluatable->False]
}, Closed]]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell[105077, 3219, 87, 2, 70, "Section",
Evaluatable->False],
Cell[105167, 3223, 555, 18, 70, "Text",
Evaluatable->False],
Cell[105725, 3243, 732, 20, 70, "Text",
Evaluatable->False],
Cell[106460, 3265, 652, 18, 70, "Text",
Evaluatable->False],
Cell[107115, 3285, 656, 19, 70, "Text",
Evaluatable->False],
Cell[107774, 3306, 828, 24, 70, "Text",
Evaluatable->False],
Cell[108605, 3332, 1099, 25, 70, "Text",
Evaluatable->False],
Cell[109707, 3359, 691, 18, 70, "Text",
Evaluatable->False],
Cell[110401, 3379, 572, 16, 70, "Text",
Evaluatable->False],
Cell[110976, 3397, 553, 16, 70, "Text",
Evaluatable->False],
Cell[111532, 3415, 419, 7, 70, "Text",
Evaluatable->False],
Cell[111954, 3424, 764, 23, 70, "Text",
Evaluatable->False],
Cell[112721, 3449, 623, 18, 70, "Text",
Evaluatable->False],
Cell[113347, 3469, 519, 15, 70, "Text",
Evaluatable->False],
Cell[113869, 3486, 612, 17, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[CellGroupData[{
Cell[114513, 3505, 93, 2, 70, "Section",
Evaluatable->False],
Cell[114609, 3509, 533, 9, 70, "Text",
Evaluatable->False]
}, Closed]],
Cell[115154, 3520, 1651, 62, 70, "Subsubtitle",
Evaluatable->False]
}, Open ]]
}
]
*)
(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)