(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.0' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing 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[ 86384, 2933]*) (*NotebookOutlinePosition[ 93166, 3180]*) (* CellTagsIndexPosition[ 92079, 3133]*) (*WindowFrame->Normal*) Notebook[{ Cell["\[Copyright] 2004 K. Sutner ", "SmallText"], Cell[CellGroupData[{ Cell["Iteration, Recursion and Induction", "Title", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:1"], Cell[CellGroupData[{ Cell["Modular Induction and Josephus", "Section", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:2"], Cell[CellGroupData[{ Cell[" Modular Induction", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:3"], Cell[TextData[{ StyleBox["Here is yet another induction principle that sometimes \ facilitates proofs. Suppose ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`P(n)\)]], StyleBox[" is a property of natural numbers. ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Modular Induction Principle", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox["\nTo show that ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`P(n)\)]], StyleBox[" holds for all ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ \[GreaterEqual] \ 0\)]], StyleBox[", it suffices to show that \n\t(MP 1) ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`P(0)\)]], " ", StyleBox["holds,\n\t(MP 2) Both ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`P(2 n)\)]], StyleBox[" and ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`P(2 n + 1)\)]], StyleBox[" hold, assuming that ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`P(n)\)]], StyleBox[" holds, for all ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ \[GreaterEqual] \ 0\)]], ".\n\nMore formally, we have to show that ", Cell[BoxData[ \(TraditionalForm\`P(0)\ \[And] \ \[ForAll] \ n\ \((\ \(P(n)\)\ \[DoubleLongRightArrow]\ \(P(2 n)\)\ \[And] \ P(2 n + 1))\)\)]], ". \n" }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Theorem", FontWeight->"Bold"], ": The principle of Modular Induction is sound. \nProof.\nSuppose Modular \ Induction fails. Then (MP 1) and (MP2 ) hold for some predicate ", Cell[BoxData[ \(TraditionalForm\`P\)]], ", but ", Cell[BoxData[ \(TraditionalForm\`P(n)\)]], " fails to hold for some ", Cell[BoxData[ \(TraditionalForm\`n\ \[GreaterEqual] \ 0\)]], ". By the LEP, let ", Cell[BoxData[ \(TraditionalForm\`n\_0\)]], " be the minimal such ", Cell[BoxData[ \(TraditionalForm\`n\)]], ". I.e., ", Cell[BoxData[ \(TraditionalForm\`n\_0\)]], " is the least counterexample to the assertion that ", Cell[BoxData[ \(TraditionalForm\`P\)]], " holds for all ", Cell[BoxData[ \(TraditionalForm\`n\)]], ". By (MP 1), ", Cell[BoxData[ \(TraditionalForm\`n\_0\)]], " cannot be 0. So, we have the following possibiliteis. \n\nCase 1: ", Cell[BoxData[ \(TraditionalForm\`n\_0\ > \ 0\)]], " and ", Cell[BoxData[ \(TraditionalForm\`n\_0\)]], " even.\nThen ", Cell[BoxData[ \(TraditionalForm\`n\_0\ = \ 2\ m\)]], " where ", Cell[BoxData[ \(TraditionalForm\`m\ < \ n\_0\)]], ". By our choice of ", Cell[BoxData[ \(TraditionalForm\`n\_0\)]], ", ", Cell[BoxData[ \(TraditionalForm\`P(m)\)]], " holds. But then by (MP 2), ", Cell[BoxData[ \(TraditionalForm\`P(2 m)\)]], " also holds, contradiction. \nCase 2: ", Cell[BoxData[ \(TraditionalForm\`n\_0\ > \ 0\)]], " and ", Cell[BoxData[ \(TraditionalForm\`n\_0\)]], " odd.\nThen ", Cell[BoxData[ \(TraditionalForm\`n\_0\ = \ 2\ m + 1\)]], " where ", Cell[BoxData[ \(TraditionalForm\`m\ < \ n\_0\)]], ". Again, by our choice of ", Cell[BoxData[ \(TraditionalForm\`n\_0\)]], ", ", Cell[BoxData[ \(TraditionalForm\`P(m)\)]], " holds. But then by (MP 2), ", Cell[BoxData[ \(TraditionalForm\`P(2 m + 1)\)]], " also holds, contradiction. \n\[EmptySquare]" }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "Needless to say, there are related principles of induction for moduli \ other than 2. In general, for any fixed ", Cell[BoxData[ \(TraditionalForm\`p\ \[GreaterEqual] \ 2\)]], ", we can establish ", Cell[BoxData[ \(TraditionalForm\`\[ForAll] \ n\ \(P(n)\)\)]], " by showing\n\t\[EmptyCircle] ", Cell[BoxData[ \(TraditionalForm\`P(i)\)]], " for all ", Cell[BoxData[ \(TraditionalForm\`i\ < \ p\)]], ", and \n\t\[EmptyCircle] ", Cell[BoxData[ \(TraditionalForm\`P(n)\)]], " implies ", Cell[BoxData[ \(TraditionalForm\`P(p\[CenterDot]n\ + \ i)\)]], ", for all ", Cell[BoxData[ \(TraditionalForm\`i < p\)]], ", and all ", Cell[BoxData[ \(TraditionalForm\`n\)]], ". \nThe proof is analogous to the case ", Cell[BoxData[ \(TraditionalForm\`p = 2\)]], ", and will be omitted.\n\nHere is an application of Modular Induction, our \ final discussion of the Josephus Problem." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell[" Josephus", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:4"], Cell["\<\ Let us come back to the Josephus problem, and try to complete our \ analysis. The original wording of the problem was this:\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ 41 rebels are trapped in a cave, surrounded by enemy troops \ (Romans, incidentally, trying to stamp out a Jewish insurrection). They \ decide to commit suicide: they line up in a cycle, and systematically kill \ every other one, going around and around, until only one rebel is left -- who \ supposedly kills himself. Who is the last survivor? \ \>", "Text", CellMargins->{{54.625, 98}, {Inherited, Inherited}}, Evaluatable->False, AspectRatioFixed->True], Cell["\<\ If you find this model too bloody, you can think instead about a \ modern, total-quality-managed company, that is in the process of right-sizing \ a department by dehiring a few employes. \ \>", "Text"], Cell[TextData[{ "Of course, we are interested not just in the last survivor for 41 rebels, \ but in general for ", Cell[BoxData[ \(TraditionalForm\`n\)]], " rebels. We would like to obtain a simple description of the survivor \ function ", Cell[BoxData[ \(TraditionalForm\`S\ : \ \(\[DoubleStruckCapitalN]\^+\)\ \ \[LongRightArrow]\ \(\[DoubleStruckCapitalN]\^+\)\)]], ", ", Cell[BoxData[ \(TraditionalForm\`S(n)\ = \ survivor\ starting\ with\ n\ rebels\)]], ". The emphasis here is on simple, the description of ", Cell[BoxData[ \(TraditionalForm\`S\)]], " should be based on some insight in the structure of the problem. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ To this end, let us repeat the straightforward simulation based on \ iteration. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(kill[LL_List] := Rest[RotateLeft[LL]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\((TableForm[#1, TableSpacing \[Rule] {1, 2}] &)\)[ NestList[kill, Range[16], 15]]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "We can implement the survivor function easily enough by iterating ", StyleBox["kill", "SmallText"], ":" }], "Text"], Cell[BoxData[ \(S1[n_Integer] := First[Nest[kill, Range[n], n - 1]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(survs = S1 /@ Range[50]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(ListPlot[survs, \n\tPlotStyle \[Rule] {PointSize[0.015], Blue}, \n\t Ticks -> {2^Range[0, 6], Automatic}];\)\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["The plot of the survivor function suggets the following \ observations: \n(O 1) ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`S(2\^k)\ = \ 1\)]], ". ", StyleBox[" \n(O 2) For ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`2\^k\ \[LessEqual] \ n\ < \ 2\^\(k + 1\)\)]], StyleBox[", the number of the survivors increases in steps of 2. \n \ Thus, ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`S(2\^k + i)\ = \ 2 i\ + \ 1\)]], StyleBox[", where", FontFamily->"Times"], StyleBox[" ", FontFamily->"Times", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`0\ \[LessEqual] \ i\ < \ 2\^k\)]], StyleBox[". ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Prooving the Observations, and More", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:5"], Cell[TextData[{ "Now it's time for some thinking. First, consider a typical run starting \ at an even number of rebels, say, ", Cell[BoxData[ \(TraditionalForm\`n\ = \ 2 m\)]], ". We print the result of the first ", Cell[BoxData[ \(TraditionalForm\`m\)]], " killings. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(TableForm[NestList[kill, Range[10], 5], TableSpacing \[Rule] {1, 2}]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["At the end of the first round, all even numbered rebels are \ killed. So, if we start with ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`2 m\)]], StyleBox[" rebels, we will have the ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`m\)]], StyleBox[" odd numbered ones left. The trick now is to try to use \ recursion:\n \n\tRenumber the surviving rebels to ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`1, 2, ... , m\)]], ": ", Cell[BoxData[ \(TraditionalForm\`x\)]], StyleBox[" is renumbered as ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(x + 1\)\/2\)]], StyleBox[". \n\nNote that this already takes care of the first observation. \ If ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ = \ 2\^k\)]], StyleBox[", then the ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`m\ = \ n/2\)]], StyleBox[" is also a power of 2. Moreover, rebel 1 always keeps his \ number. Clearly, when we get down to 2 rebels, 1 is the one to survive. \nNow \ consider the typical situation when ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ = \ 2 m\ + \ 1\)]], StyleBox[". ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(TableForm[NestList[kill, Range[11], 6], TableSpacing \[Rule] {1, 2}]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["Again, after the first round of killings we will have the ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`m\)]], StyleBox[" odd numbered ones other than 1 left over. We have to modify the \ renumbering function slightly: ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\)]], StyleBox[" goes to ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(x - 1\)\/2\)]], StyleBox[".\nUsing these observations, we can summarize the properties of ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\(S\)\(\ \)\)\)]], " in the following equations.\n", StyleBox["\n\t\[EmptyCircle] ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`S(1)\ = \ 1\)]], ",", StyleBox["\n\t\[EmptyCircle] ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`S(2 m)\ = \ 2\ \(S(m)\)\ - \ 1\)]], ",\n\t\[EmptyCircle] ", Cell[BoxData[ \(TraditionalForm\`S(2 m + 1)\ = \ S(m)\ + \ 1. \)]], "\n\t" }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "Let us see how much mileage we can get out of these claims. First, w", StyleBox["e will show, that the equations determine the function ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`S\)]], " completely. So, if the equations are appropriate, they really pin down \ the solution (see exercise 1 below).\n\n", StyleBox["Lemma", FontWeight->"Bold"], ": The equations for ", Cell[BoxData[ \(TraditionalForm\`S\)]], " above uniquely determine a total function ", Cell[BoxData[ \(TraditionalForm\`S\ : \ \(\[DoubleStruckCapitalN]\^+\)\ \[LongRightArrow]\ \(\[DoubleStruckCapitalN]\^+\)\)]], ".\nProof. \nSuppose ", Cell[BoxData[ \(TraditionalForm\`f\)]], " is an arbitrary function satisfying the equations. First note that ", Cell[BoxData[ \(TraditionalForm\`f\)]], " is total on ", Cell[BoxData[ \(TraditionalForm\`\(\[DoubleStruckCapitalN]\^+\)\)]], ". One can use Modular Induction to show totality: ", Cell[BoxData[ \(TraditionalForm\`f\)]], " is certainly defined on ", Cell[BoxData[ \(TraditionalForm\`1\)]], ", and if ", Cell[BoxData[ \(TraditionalForm\`f(m)\)]], " is defined, so are ", Cell[BoxData[ \(TraditionalForm\`f(2 m)\)]], " and ", Cell[BoxData[ \(TraditionalForm\`f(2 m + 1)\)]], ". \nAnother application of Modular Induction shows that indeed ", Cell[BoxData[ \(TraditionalForm\`\[ForAll] \ n\ \((\ S(n)\ = \ f(n)\ )\)\)]], ". This is obvious for ", Cell[BoxData[ \(TraditionalForm\`n = 1\)]], ", and equality on ", Cell[BoxData[ \(TraditionalForm\`m\)]], " implies equality on ", Cell[BoxData[ \(TraditionalForm\`2 m\)]], " as well as ", Cell[BoxData[ \(TraditionalForm\`2 m + 1\)]], ". \n\[EmptySquare]\n\nTherefore, there is exactly one function that \ satisfies these equations (namely, the survivor function). We can implement \ a corresponding function easily in ", StyleBox["Mathematica", FontSlant->"Italic"], " to check whether things really work out." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(Clear[S2]\), "\n", \(\(S2[1] = 1;\)\), "\n", \(S2[n_] := 2\ S2[n\/2] - 1 /; EvenQ[n]\), "\n", \(\(S2[n_] := 2\ S2[\(n - 1\)\/2] + 1;\)\)}], "Input", AspectRatioFixed->True], Cell[BoxData[{ \(S1 /@ Range[20]\), "\n", \(S2 /@ Range[20]\), "\n", \(% == %%\)}], "Input", AspectRatioFixed->True], Cell["Seems to work. ", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Exercise 1", FontWeight->"Bold"], ": ", StyleBox["Needless to say, we have to give a complete proof that the \ survivor function really satisfies our equations. This is left as an \ exercise.\n", FontFamily->"Times"], StyleBox["Exercise 2", FontWeight->"Bold"], ": Show that observation (O2) is explained by our equations." }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" The Real Solution", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:6"], Cell["\<\ However, the recursive definition of the survivor function in terms \ of our three equations is still somewhat unsatisfactory, since it is always \ difficult to understand deeply nested call structures (recall the Collatz \ function). To get a better description, let us take a second look at the two \ observations from above, which, as we saw, are easily derived from the \ equations.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "\t(O1) ", Cell[BoxData[ \(TraditionalForm\`S(2\^k)\ = \ 1\)]], ",\n\t(O2) ", Cell[BoxData[ \(TraditionalForm\`S(2\^k + i)\ = \ 2 i\ + \ 1\)]], ", where ", Cell[BoxData[ FormBox[ FormBox[\(0\ \[LessEqual] \ i\ < \ 2\^k\), "TraditionalForm"], TraditionalForm]]], "." }], "Text"], Cell[TextData[{ "Since powers of 2 play an important role here, it is tempting to look at \ the binary expansion of ", Cell[BoxData[ \(TraditionalForm\`n\)]], ". The binary expansion of ", Cell[BoxData[ \(TraditionalForm\`2\^k\)]], ", rotated to the left by one, is clearly the same as the binary expansion \ of 1. Also note that the binary expansion of ", Cell[BoxData[ \(TraditionalForm\`2\^k + \ i\)]], ", where ", Cell[BoxData[ FormBox[ FormBox[\(0\ \[LessEqual] \ i\ < \ 2\^k\), "TraditionalForm"], TraditionalForm]]], ", rotated to the left by one, is the same as the binary expansion of ", Cell[BoxData[ \(TraditionalForm\`2 i\ + \ 1\)]], ", if we permit leading zeros in the latter. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(IntegerDigits[2\^10 + 589, 2]\), "\n", \(IntegerDigits[2\ 589 + 1, 2]\), "\n", \(% == RotateLeft[%%]\)}], "Input", AspectRatioFixed->True], Cell["\<\ So, we can give a direct definition for the survivor function, \ without recursion, but based on manipulating binary expansions.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(S3[n_] := FromDigits[RotateLeft[IntegerDigits[n, 2]], 2]\)], "Input", AspectRatioFixed->True], Cell["We check that this works properly. ", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(({#1, S1[#1], S3[#1], \((len = IntegerDigits[#1, 2])\), IntegerDigits[S1[#1], 2, Length@len]} &)\) /@ Range[20]\ // \ TableForm[#, TableDepth \[Rule] 2] &\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["Of course, we now have to prove that the new representation is \ correct. \n\n", FontFamily->"Times"], StyleBox["Lemma", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": For all positive integers ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\)]], StyleBox[": ", FontFamily->"Times"], StyleBox[" ", FontFamily->"Times", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`\(S\_3\)(n)\ = \ S(n)\)]], ". ", StyleBox["\nProof. \nFirst, recall the equations for ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`S\)]], StyleBox[":\n\t\[EmptyCircle] ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`S(1)\ = \ 1\)]], ",", StyleBox["\n\t\[EmptyCircle] ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`S(2 m)\ = \ 2\ \(S(m)\)\ - \ 1\)]], ",\n\t\[EmptyCircle] ", Cell[BoxData[ \(TraditionalForm\`S(2 m + 1)\ = \ 2 \( S(m)\)\ + \ 1. \)]] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ "From our previous uniqueness result, it suffices to show that ", Cell[BoxData[ \(TraditionalForm\`S\_3\)]], " satisfies these equations. Clearly, ", Cell[BoxData[ \(TraditionalForm\`\(S\_3\)(1)\ = \ 1\)]], ", so we can focus on ", Cell[BoxData[ \(TraditionalForm\`n > 1\)]], ".", StyleBox["\nTo keep notation under control, let us write ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`S\_3\)]], StyleBox[" as follows:\n\t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(S\_3\)(\ n\ )\ = \ val(\ RL(\ bin(\ n\ )))\)]], "\nwhere ", Cell[BoxData[ \(TraditionalForm\`val(x)\)]], " is the numerical value of a binary sequence ", Cell[BoxData[ \(TraditionalForm\`x\)]], ", ", Cell[BoxData[ \(TraditionalForm\`RL\)]], " stands for rotate left, and ", Cell[BoxData[ \(TraditionalForm\`bin(r)\)]], " is the binary expansion of ", Cell[BoxData[ \(TraditionalForm\`r\)]], ". ", StyleBox["\n\nSo consider ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ = \ 2 m\)]], ". ", StyleBox["We can write the binary digits of ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`m\)]], StyleBox[" as ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`1\ D\)]], ", where ", Cell[BoxData[ \(TraditionalForm\`\(\(D\)\(\ \)\)\)]], " is a sequence of binary digits", StyleBox[". Then \n\t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(S\_3\)(\ 2 m\ )\ = \ \(val(\ RL(\ bin(2 m)))\ = \ \(val(\ RL(\ 1\ D\ 0\ ))\ = \ val(\ D\ 0\ 1)\)\)\)]], " ", StyleBox["\nand \n\t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`2 \(\( S\_3\)(\ m\ )\)\ = \ \(2\ \(val(\ RL(\ bin(m)))\)\ = \ \(2\ \(val(\ RL(\ 1\ D\ ))\)\ = \(2\ \(val(\ D\ 1)\)\ = \ val(D\ 1\ 0)\)\)\)\)]], " ", StyleBox["\nBut then ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(S\_3\)(\ 2 m\ )\ = \ 2\ \(\(S\_3\)(m)\)\ - \ 1\)]], ", as required. ", StyleBox["\n\nNow consider ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ = \ 2 m\ + \ 1\)]], ". ", StyleBox["This time\n\t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(S\_3\)(\ 2 m\ + 1)\ = \ \(val(\ RL(\ bin(2 m + 1)))\ = \ \(val(\ RL(\ 1\ D\ 1\ ))\ = \ val(\ D\ 1\ 1)\)\)\)]], " ", StyleBox["\nand \n\t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`2 \(\( S\_3\)(\ m\ )\)\ = \ \(2\ \(val(\ RL(\ bin(m)))\)\ = \ \(2\ \(val(\ RL(\ 1\ D\ ))\)\ = \(2\ \(val(\ D\ 1)\)\ = \ val(D\ 1\ 0)\)\)\)\)]], " ", StyleBox["\nBut then ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(S\_3\)(\ 2 m + 1\ )\ = \ 2\ \(\(S\_3\)(m)\)\ + \ 1\)]], ", as required. ", StyleBox["\n\[EmptySquare]", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Exercise", FontWeight->"Bold"], ": Fill in all details in the last proof. You might wish to argue a bit \ more formally about the effect of adding or subtrating 1 in the binary \ expansion of a number. " }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell[" Efficiency", "Subsection", CellTags->"c:7"], Cell[TextData[{ "Note that computationally there is a huge difference between our various \ implementations of the survivor function ", Cell[BoxData[ \(TraditionalForm\`S\_1\)]], ", ", Cell[BoxData[ \(TraditionalForm\`S\_2\)]], " and ", Cell[BoxData[ \(TraditionalForm\`S\_3\)]], ". In the brute force simulation used in ", Cell[BoxData[ \(TraditionalForm\`S\_1\)]], ", we are running a list model of the situation and going through all the \ ", Cell[BoxData[ \(TraditionalForm\`n - 1\)]], " steps in the process, at each step handling a list of length ", Cell[BoxData[ \(TraditionalForm\`O(n)\)]], ", which produces an overall running time of ", Cell[BoxData[ \(TraditionalForm\`O(n\^2)\)]], ". It is not hard to custom-design lists that handle the operations needed \ in ", Cell[BoxData[ \(TraditionalForm\`O(1)\)]], " steps (in fact, a simple linked list will do), which brings the total \ running time down to linear in ", Cell[BoxData[ \(TraditionalForm\`n\)]], ".\nThe recursive function ", Cell[BoxData[ \(TraditionalForm\`S\_2\)]], " based on our equations is much better, there will be ", Cell[BoxData[ \(TraditionalForm\`\(\(O(\(log\_2\) n)\)\(\ \)\)\)]], "recursive calls, so that the total running time is ", Cell[BoxData[ \(TraditionalForm\`O(k\^2)\)]], " for a ", Cell[BoxData[ \(TraditionalForm\`k\)]], "-bit number. You have to convince yourself that the necessary operations \ during each call can actually be handled in ", Cell[BoxData[ \(TraditionalForm\`O(k)\)]], " steps. For machine sized integers this translates into constant time, \ since the number of bits there is limited to 32 (or perhaps 64). \nIn ", Cell[BoxData[ \(TraditionalForm\`S\_3\)]], ", there is only a conversion into binary, a rotation, and a conversion \ back into decimal. One can check that all these operations can be handled in \ ", Cell[BoxData[ \(TraditionalForm\`O(k)\)]], " steps for a ", Cell[BoxData[ \(TraditionalForm\`k\)]], "-bit number ", Cell[BoxData[ \(TraditionalForm\`n\)]], ". For machine sized integers this results again in a constant amount of \ time, but for truly large numbers ", Cell[BoxData[ \(TraditionalForm\`S\_3\)]], " is faster by a factor of ", Cell[BoxData[ \(TraditionalForm\`k\)]], " than ", Cell[BoxData[ \(TraditionalForm\`S\_2\)]], ". \nNow, who would want to compute ", Cell[BoxData[ \(TraditionalForm\`\(\(S(n)\)\(\ \)\)\)]], " for really large numbers ", Cell[BoxData[ \(TraditionalForm\`n\)]], "? \n" }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Exercise", FontWeight->"Bold"], ": Make sure you understand how one implements a linear time simulation \ using linked lists. \nHow hard is ", Cell[BoxData[ \(TraditionalForm\`S\_3\)]], " to implement in C?" }], "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Orbits, Cycles and Fixed Points", "Section", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:8"], Cell[CellGroupData[{ Cell[" Cycles, Transients and Periods", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:9"], Cell[TextData[{ StyleBox["We have already seen that fixed points can be very useful in \ computational tasks. A fixed point of some function ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(F\ : \ A\ \[LongRightArrow]\ A\)\)\)]], StyleBox[" is a point ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(x\ \[Element] \ A\)\)\)]], StyleBox[" such that ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`F(x)\ = \ x\)]], StyleBox[" (don't take the term point here too literal, any object can be \ a point). There is a natural generalization of this idea: cycles. \n \nA ", FontFamily->"Times"], StyleBox["cycle of ", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], Cell[BoxData[ \(TraditionalForm\`F\)]], StyleBox[" is a list ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`{\ x\_0, \ x\_1, \[Ellipsis], x\_\(n - 1\)}\)]], StyleBox[" of points such that ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`F(x\_i)\ = \ x\_\(i + 1\)\)]], StyleBox[", where the index is computed modulo ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\)]], StyleBox[". ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\)]], StyleBox[" is the ", FontFamily->"Times"], StyleBox["length", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[" of the cycle; it is also customary to speak of an ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\)]], StyleBox["-cycle", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[". The elements of a cycle are called ", FontFamily->"Times"], StyleBox["cyclic points", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[". So, a fixed point is simply a cycle of length 1.\n\nNote that \ the ", FontFamily->"Times"], StyleBox["orbit", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[" of any point x0 under F, i.e., the sequence ( Nest[ F, x0, \ t ] | t >= 0 ), can contain at most one cycle. In fact, if xt == Nest[ \ F, x0, t ] is the first point on a cycle, then the rest of the orbit simply \ consists of repeated traversals of the cycle. So, in a sense, orbits that \ contain cycles are finite: after an initial segment, the so-called ", FontFamily->"Times"], StyleBox["transient part", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[", we hit a cycle, and then we stay on that cycle, the ", FontFamily->"Times"], StyleBox["periodic part", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[" of the orbit. Therefore, these orbits are called ", FontFamily->"Times"], StyleBox["ultimately periodic", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[". In particular, a ", FontFamily->"Times"], StyleBox["periodic", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[" orbit is one where the very first point is already on a cycle, \ so that the transient part is empty. \n\nThe length of the cycle in an \ ultimately periodic orbit is called the ", FontFamily->"Times"], StyleBox["period length", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[" (or simply period) of the orbit, and the length of the transient \ part the ", FontFamily->"Times"], StyleBox["transient length", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[". \n\n\nNote that his terminology is also useful for arbitrary \ sequences x0, x1, x2, ..., xn,... rather that just orbits. \n\n\nHere is a \ simple example. Define", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(Clear[F, G]\), "\n", \(F[x_] := Mod[x + 1, 11]\), "\n", \(G[x_] := If[x < 5, x + 1, Mod[x - 4, 7] + 5]\)}], "Input", AspectRatioFixed->True], Cell[BoxData[{ \(NestList[F, 0, 30]\), "\n", \(NestList[G, 0, 30]\)}], "Input", AspectRatioFixed->True], Cell["\<\ We can see that the orbit of 0 under F is periodic with period 11, \ whereas the orbit of 0 under G is ultimately periodic, with period 7, and \ transient length 5. The last example uses numbers, but our concepts make sense for other \ functions as well. Consider for example the orbit of {1,2,3,...,6} under \ RotateLeft.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(TableForm[NestList[RotateLeft, Range[6], 15]]\)], "Input", AspectRatioFixed->True], Cell["\<\ Clearly, the orbit is periodic with period 6. In fact, all orbits \ must be periodic with period at most 6, since rotating a list of length 6 \ times brings it back into its original state. Do all lists of length 6 have \ period 6? \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(TableForm[NestList[RotateLeft, Mod[Range[6], 2], 15]]\), "\n", \(TableForm[NestList[RotateLeft, Mod[Range[6], 3], 15]]\)}], "Input", AspectRatioFixed->True], Cell["\<\ No, we can have periods 2 and 3. And, of course, we can have fixed \ points.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(TableForm[NestList[RotateLeft, Table[1, {6}], 15]]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["How about period 4? Suppose \n\n ", FontFamily->"Times"], StyleBox["Nest[ RotateLeft, L, 4 ] == L", FontFamily->"Times", FontWeight->"Bold"], StyleBox["\n \nfor some list L of length 6. What does that mean \ for the list elements? Make a list with symbolic elements, rotate it, and \ compare entries. ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(Clear[a]\), "\n", \(L = Array[a, {6}]\), "\n", \(LL = Nest[RotateLeft, L, 4]\), "\n", \(TableForm[Thread[{L, LL}]]\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["So, a1 == a5, a5 == a3, a3 == a1, and therefore a1 == a3 == a5. \ Likewise, a2 == a4 == a6. But then the period is at most 2. A similar \ argument shows that period 5 is also impossible, so that 1, 2, 3 and 6 are \ the only possible periods. \n\nThis suggests the following lemma. \n\n", FontFamily->"Times"], StyleBox["Lemma", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": The only possible periods of a list of length ", FontFamily->"Times"], StyleBox["n", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" under ", FontFamily->"Times"], StyleBox["RotateLeft", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" are the exactly the divisors of ", FontFamily->"Times"], StyleBox["n", FontFamily->"Times", FontWeight->"Bold"], StyleBox[". \n\nNon-Proof: \nWe postpone the hard part (to show that \ every period is a divisor) and show only that for every divisor p of n \ there is a list that has period p. It is easy to check that \n\n ", FontFamily->"Times"], StyleBox["Apply[ Join, Table[ Range[p], {n/p} ] ]", FontFamily->"Times", FontWeight->"Bold"], StyleBox["\n \nhas period p under RotateLeft. ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Computing Transients and Periods", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:10"], Cell[TextData[{ "The question arises how one can actually determine the transient length \ and the period of a given point x0 under some function F. The obvious \ approach is to compute Nest[ F, x0, t ] for t = 0,1, 2,... and so forth. \ If a point ever appears twice in this sequence, it must be cyclic and we are \ essentially done. If the orbit of x0 is in fact ultimately periodic, then \ this method will always work, at least in principle. In general, however, \ there is no hope to identify non-periodic orbits: after a finite \ computation, we only know a few initial values of the orbit, and if we have \ not found any cyclic points yet, that really means nothing. Perhaps the \ transient part is very long. Or, perhaps, the orbit is in fact non-periodic; \ we simply cannot tell. \n\nSo, here is a more modest goal: suppose we know \ that the orbit is ultimately periodic; compute the transient length and the \ period. \n\nThe following function ", ButtonBox["AnalyzeOrbit", ButtonStyle->"AddOnsLink"], " determines the transient part and the periodic part; see the package for \ the actual implementation." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(AnalyzeOrbit[F, 0]\), "\n", \(AnalyzeOrbit[G, 0]\), "\n", \(AnalyzeOrbit[#1 + 1 &, 0]\)}], "Input", AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Example: The Kac Ring Model", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:10"], Cell[TextData[{ "A very simple example of a deterministic reversible system in statistical \ mechanics is due to M. Kac (search for \"Kac ring\" on the web to see how it \ is used and why it is important). Consider a ring of length ", Cell[BoxData[ \(TraditionalForm\`n\)]], " where each position is occupied by a particle that has either up- or \ down-spin. At each step, the particles move counterclockwise by one \ position. Moreover, some of the positions are \"marked\"; whenever a \ particle arrives at a marked positions is flips its spin. \n\nIgnoring the \ physical aspects of the system, it can easily be modeled like so. We consider \ all circular binary lists of length ", Cell[BoxData[ \(TraditionalForm\`n\)]], ". Write ", Cell[BoxData[ \(TraditionalForm\`S\)]], " for the collection of all marked positions ", Cell[BoxData[ \(TraditionalForm\`s\)]], ", ", Cell[BoxData[ \(TraditionalForm\`0\ \[LessEqual] \ s\ < \ n\)]], ". To model the operation on this \"phase space\" ", Cell[BoxData[ FormBox[ SuperscriptBox[ StyleBox["2", FontWeight->"Bold"], \(\(\ \)\(n\)\)], TraditionalForm]]], " we use circular rotation together with bit-wise xor. Here is an \ implementation (using modular arithmetic for the xor operation). " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(nn\ = \ 100;\)\), "\n", \(\(next[L_List]\ := \ Mod[\ RotateLeft[L]\ + \ S, \ 2\ ];\)\)}], "Input"], Cell["\<\ We pick a collection of marked positions and a random \ configuration.\ \>", "Text"], Cell[BoxData[{ \(\(S\ = \ ToBitVector[{11, 30, 32, 50, 95}, Range[nn]];\)\), "\n", \(\(X\ = \ Table[\ RandomInteger[], {nn}];\)\)}], "Input"], Cell[TextData[{ "Here are the first 100 steps in the orbit of ", Cell[BoxData[ \(TraditionalForm\`X\)]], ". " }], "Text"], Cell[BoxData[{ \(\(orb\ = \ NestList[\ next, \ X, \ 100\ ];\)\), "\[IndentingNewLine]", \(\(orb\ // \ PlotMatrix;\)\)}], "Input"], Cell[TextData[{ "A moment's thought reveals that this system is reversible and has period \ at most ", Cell[BoxData[ \(TraditionalForm\`2 n\)]], " (when is the period ", Cell[BoxData[ \(TraditionalForm\`n\)]], "?)." }], "Text"], Cell[BoxData[ \(AnalyzeOrbit[next, X]\)], "Input"], Cell["\<\ The next plot shows the marked positions together with the orbit.\ \ \>", "Text"], Cell[BoxData[ \(\(PlotMatrix[\ \ \ 2 Table[S, {101}]\ + \ orb\ \ ];\)\)], "Input"], Cell[TextData[{ "Suppose we have ", Cell[BoxData[ \(TraditionalForm\`m\)]], " marked positions and write ", Cell[BoxData[ \(TraditionalForm\`x = m/n\)]], ". If we ignore the fact that these positions are fixed and do not move \ about, the probability that one particular particle has spin up at time ", Cell[BoxData[ \(TraditionalForm\`t + 1\)]], " is \n\n\t\t ", Cell[BoxData[ \(TraditionalForm\`p\_\(t + 1\)\ = \ \((1 - x)\)\ p\_\(\(\ \)\(t\)\) + \ \(\(x\)\(\ \)\((1 - p\_\(\(\ \)\(t\)\))\)\(\ \)\)\)]], "\n\t\t \nThis is a version of Boltzmann's famous Stosszahlenansatz. We \ can immediately solve this recurrence:\n\n\t\t", Cell[BoxData[ \(TraditionalForm\`p\_\(\(\ \)\(t\)\(\ \)\)\ = \ \((1 - 2 x)\)\^\(\(\ \ \)\(t\)\)\ \((p\_0\ - 1/2)\)\ + \ 1/2. \)]], "\n\t\t\nWe may safely assume ", Cell[BoxData[ \(TraditionalForm\`0\ < \ x\ < \ 1\)]], ", so we get an irreversible system with exponential decay and ", Cell[BoxData[ \(TraditionalForm\`p\_\(\(\ \)\(t\)\) \[Rule] \ 1/2\)]], " as ", Cell[BoxData[ \(TraditionalForm\`t\ \[Rule] \ \[Infinity]\)]], ". This clearly contradicts the observed behavior, here plotted for the \ first 400 steps (i.e., for two full periods). There is no asymptotic \ equilibrium." }], "Text"], Cell[BoxData[{ \(\(orb\ = \ NestList[\ next, \ X, 400\ ];\)\), "\n", \(\(ListPlot[\ \(Count[#, 1] &\)\ /@ \ orb, \ PlotStyle \[Rule] {Blue, PointSize[0.01]}];\)\)}], "Input"], Cell["\<\ This is not too surprising since our calculation fails to take into \ account any of the dependencies introduced by the stationary marked \ positions in the Kac model. \ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell[" Cubing Digits", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:11"], Cell[CellGroupData[{ Cell[" A Digit Cubing Function", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:12"], Cell[TextData[{ "Let us define a function ", StyleBox["digs3", "MR"], " which takes as input a positive integer, disassembles it into its digits \ (in decimal), cubes all the digits and returns as result the sum of the \ cubes. So for example\n\n\t\t\t", Cell[BoxData[ \(TraditionalForm\`digs3[\ 5\ ]\ = \ 125\)]], "\n\t\t\t", Cell[BoxData[ \(TraditionalForm\`digs3[111]\ = \ 3\)]], "\n\t\t\t", Cell[BoxData[ \(TraditionalForm\`digs3[123]\ = \ 36\)]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(Clear[digs3];\)\), "\n", \(digs3[x_Integer] := Plus @@ \(IntegerDigits[x]\^3\)\)}], "Input", AspectRatioFixed->True], Cell["Let's check:", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(digs3 /@ Range[20]\), "\n", \(digs3 /@ {5, 111, 123}\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ "Let us look at a plot of ", StyleBox["digs3[x]", "MR"], " for a few values of ", Cell[BoxData[ \(TraditionalForm\`x\)]], "." }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(tab500 = digs3 /@ Range[500];\)\), "\n", \(\(ListPlot[Take[tab500, 100], PlotStyle \[Rule] Blue];\)\)}], "Input", AspectRatioFixed->True], Cell["\<\ Pieces of parabolas, most likely cubic. The same is true on a \ larger scale.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(ListPlot[tab500, PlotStyle \[Rule] Blue];\)\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["From the picture it is clear that for some values of ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\)]], StyleBox[" we have ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`digs3(x)\ > \ x\)]], StyleBox[" and for others ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`digs3(x)\ < \ x\)]], StyleBox[". ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Questions", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:13"], Cell["\<\ Several questions arise: - Does equality ever occur? In other words, does digs3 have any fixed \ points? - What are the cyclic points for digs3? - What are the values of x for which digs3 is interesting? - In general, what can we say about the orbits of digs3? \ \>", "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" The Critical Range", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:14"], Cell[TextData[{ StyleBox["\nAnalyzing the orbits of digs3 is not as hopeless as it may \ seem. First off, note hat for sufficiently large ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\)]], StyleBox[" we always have ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\ > \ digs3(x)\)]], StyleBox[". For let ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\)]], StyleBox[" be a number with ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`k\)]], StyleBox[" decimal digits, so \n\t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\ = \ \[Sum]\+\(i = 0\)\%\(k - 1\)\ x\_i\ 10\^i\)]], StyleBox["\nwhere ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\_\(k - 1\)\)]], " > 0", StyleBox[". Then \n \t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\(digs3( x)\)\(\ \)\(=\)\(\ \ \)\(\[Sum]\+\(i = 0\)\%\(k - 1\)\ x\_i\%3\ \ \[LessEqual] \[Sum]\+\(i = 0\)\%\(k - 1\)\ 9\^3\ \ = 729\ k\)\(\ \)\)\)]], StyleBox["\n", FontFamily->"Times", FontWeight->"Bold"], StyleBox["On the other hand \n\t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\ \[GreaterEqual] \ \(x\_\(k - 1\)\) 10\^\(k - 1\)\ \[GreaterEqual] \ 10\^\(k - 1\)\)]], ".", StyleBox["\nHence, ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`digs3(x)\ \[GreaterEqual] \ x\)]], StyleBox[" implies ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`729\ k\ \[LessEqual] \ 10\^\(k - 1\)\)]], StyleBox[" ", FontFamily->"Times", FontWeight->"Bold"], StyleBox["or, equivalently,\n\t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`log\_10\ 729\ \ + \ 1\ \[LessEqual] \ k\ - \ log\_10\ k\)]], StyleBox["\nNote that ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(log\_10\ 729\ + \ 1\)\)\)]], StyleBox[" is approximately 3.86:", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(N[Log[10, 729] + 1]\)], "Input", AspectRatioFixed->True], Cell["\<\ Unfortunately, the right hand side is a little more complicated. \ Let us consider the difference between a number and its base 10 logarithm:\t\t\ \t\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(Clear[diff, x];\)\), "\n", \(\(diff[x_] := x - Log[10, x];\)\), "\n", \(\(Plot[diff[x], {x, 1, 10}, PlotStyle \[Rule] Red, GridLines \[Rule] Automatic];\)\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["It appears that certainly ", FontFamily->"Times"], StyleBox[" ", FontFamily->"Times", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`\(\(diff(x)\)\(>\)\(\ \)\(3.86\)\(\ \)\)\)]], StyleBox[" for ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\ \[GreaterEqual] \ 5\)]], StyleBox[". Let's verify this claim.", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(N[diff[5]]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ RowBox[{ SuperscriptBox["diff", "\[Prime]", MultilineFunction->None], "[", "x", "]"}]], "Input", AspectRatioFixed->True], Cell[TextData[{ "Hence the derivative of ", StyleBox["diff", "MR"], " is positive for ", Cell[BoxData[ \(TraditionalForm\`x\ > \ 1/log\ 10\)]], ", and we are done. So we know that for any number ", Cell[BoxData[ \(TraditionalForm\`x\)]], " with at least 5 decimal digits we have ", Cell[BoxData[ \(TraditionalForm\`digs3(x) < \ x\)]], ". Since ", Cell[BoxData[ \(TraditionalForm\`digs3(9999)\ = \ 2916\)]], " we can the determine the maximal number ", Cell[BoxData[ \(TraditionalForm\`x\_0\)]], " for which ", Cell[BoxData[ \(TraditionalForm\`digs3(x\_0)\ \[GreaterEqual] \ x\_0\)]], " as follows:" }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(x0 = 2916;\)\), "\n", \(\(While[digs3[x0] < x0, \(x0--\)];\)\), "\n", \(x0\), "\n", \(digs3[x0]\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["Hence, we have the following claim.\n\n", FontFamily->"Times"], StyleBox["Claim 1", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": The orbit of any ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\ > \ 1999\)]], StyleBox[" intersects ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\([1999]\)\)]], StyleBox[". \n\nWe will refer to ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`{1, ... , 1999}\)]], StyleBox[" as the ", FontFamily->"Times"], StyleBox["critical range", FontFamily->"Times", FontColor->RGBColor[0, 0, 1]], StyleBox[", since it clearly suffices to determine the behavior of digs3 on \ that range. ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Dissecting the Critical Range", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:15"], Cell["\<\ Since in particular all cycles intersect the critical range, we can \ try to find them by brute force search. For example, \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(NestList[digs3, 1999, 10]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "shows that there is a cycle ", Cell[BoxData[ \(TraditionalForm\`55\ \[Rule] \ \(250\ \[Rule] \ \(133\ \[Rule] \ 55\)\)\)]], " under digs3.\nLet's look at some more examples:" }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\((NestList[digs3, #1, 10] &)\) /@ Range[20]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "This list shows a number of fixed points: 1, 153, 370, 371 and a new \ cycle \n\t\t", Cell[BoxData[ \(TraditionalForm\`160\ \[Rule] \ \(217\ \[Rule] \ \(352\ \[Rule] \ 160\)\)\)]], " .", "\n\nTo systematically find all the cycles we use our program ", StyleBox["AnalyzeOrbit", "SmallText"], " from above. Note that we are counting on not having cycles longer than \ 500, which seems reasonable from the few examples we have seen. This will \ take a few moments. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(Timing[\(allcycs = \((AnalyzeOrbit[digs3, #1, Cycle \[Rule] True] &)\) /@ Range[1999];\)]\)], "Input", AspectRatioFixed->True], Cell["We extract the periodic parts.", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(cycs = Union[Sort /@ \(Last /@ allcycs\)];\)\), "\n", \(TableForm[cycs]\)}], "Input", AspectRatioFixed->True], Cell["\<\ Hence, there are 5 fixed points, 2 2-cyles, and 2 3-cycles. That's \ all. Now set\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(stop = Sort[First /@ cycs]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["Claim 2", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": Every orbit intersects ", FontFamily->"Times"], StyleBox["stop", FontFamily->"Times", FontWeight->"Bold"], StyleBox[". In particular, all orbits of digs3 are ultimately periodic. ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Digit Sums and Factorials", "Section", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:16"], Cell[CellGroupData[{ Cell[" Digits Sums", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:17"], Cell["\<\ Given a number, we know how to compute its binary expansion. Hence, \ we can count the number of 1's in the expansion (equivalently, we can simply \ add the binary digits). The result is the digit sum of the number in \ question. Here is the code. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(DigitSum[n_] := Plus @@ IntegerDigits[n, 2];\)\)], "Input", AspectRatioFixed->True], Cell["\<\ The behavior of the DigitSum function is rather surprisingly \ complicated. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(ds = DigitSum /@ Range[200]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(ListPlot[ds, PlotStyle \[Rule] Blue];\)\)], "Input", AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Prime Exponents and Factorials", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:18"], Cell[TextData[{ "Digit sums appear rather unexpectedly in some places. To give one \ example, let us introduce one more notion: the exponent of a prime in the \ factorization of a given number. In other words, given a positive integer n \ and a prime p, we would like to compute the largest number ", Cell[BoxData[ \(TraditionalForm\`k\)]], " such that ", Cell[BoxData[ \(TraditionalForm\`p\^\(\(\ \)\(k\)\)\)]], " divides ", Cell[BoxData[ \(TraditionalForm\`n\)]], ". We will write ", Cell[BoxData[ \(TraditionalForm\`\(\[Eta]\_p\)(n)\)]], " for this exponent.\n\nThe prime will usually be 2, but here is the \ general definition:" }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ Clear[PrimeExponent] PrimeExponent[p_][n_]:= Module[{nn=n,ee=0}, \t\tWhile[ Mod[nn,p]==0, \t\t\tee++; nn/=p ]; \t\tee ];\ \>", "Input", AspectRatioFixed->True], Cell[TextData[{ "Note the format of ", StyleBox["PrimeExponent", "SmallText"], ": for any ", Cell[BoxData[ \(TraditionalForm\`p\)]], ", ", StyleBox["PrimeExponent[p]", "SmallText"], " is a function! We could also have chosen the slightly more familiar \ format ", StyleBox["PrimeExponent[ p, n ]", "SmallText"], ", but our version is a little easier to use (on occasion, at least; see \ the computations below). \n\nAnother comment: it is tempting but inefficient \ to use ", StyleBox["FactorInteger", "SmallText"], " for this. Why?" }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(PrimeExponent[2] /@ Range[200]\), "\n", \(\(ListPlot[%, PlotStyle \[Rule] Blue];\)\)}], "Input", AspectRatioFixed->True], Cell[BoxData[{ \(PrimeExponent[3] /@ Range[200]\), "\n", \(\(ListPlot[%, PlotStyle \[Rule] Blue];\)\)}], "Input", AspectRatioFixed->True], Cell["\<\ Notice the regularity. How about the exponent of 2 in a factorial? \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(PrimeExponent[2]\)[\(100!\)]\), "\n", \(\(PrimeExponent[2]\)[\(200!\)]\), "\n", \(\(PrimeExponent[2]\)[\(500!\)]\), "\n", \(\(PrimeExponent[2]\)[\(1000!\)]\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["It is very tempting to form a conjecture that is somewhat vague \ at this point.\n\n", FontFamily->"Times"], StyleBox["Conjecture", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(\(\[Eta]\_\(\(\ \)\(2\)\)\)(\(n!\))\ = \ n\ - \ \[Epsilon]\)\)\)]], StyleBox[" where \[Epsilon] is some small number.\n \nThe \ question is: what is the small number? Can we prove a precise formula? Let's \ take another look at the picture from above:", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(ListPlot[PrimeExponent[2] /@ Range[100], PlotStyle \[Rule] RGBColor[0, 0, 1]];\)\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "The dots in the bottom row are 2 units apart, in the next row they are 4 \ apart, then 8, and so on. If we want to calculate ", StyleBox["PrimeExponent[2][100]", "SmallText"], ", we have to add up the values of the dots in the last graph. Or, we could \ place a few more dots and simply count the total number of dots. Like so: " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(todots[nn_] := Table[{nn, i}, {i, \(PrimeExponent[2]\)[nn]}]\)], "Input",\ AspectRatioFixed->True], Cell[BoxData[{ \(todots[10]\), "\n", \(todots[64]\), "\n", \(todots[100]\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(ListPlot[Flatten[todots /@ Range[100], 1], PlotStyle \[Rule] Blue, PlotRange \[Rule] {{0, 101}, {0, 7}}];\)\)], "Input", AspectRatioFixed->True], Cell["How many dots are there?", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(Length[Flatten[todots /@ Range[100], 1]]\), "\n", \(\(PrimeExponent[2]\)[\(100!\)]\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["Can't be a coincidence, right? But we need a proof here. \n\n\ It's not too hard to count the dots in general. At level 1, there are \ Floor[n/2], at level 2 there are Floor[n/4], and so forth. The sum is finite, \ since we Floor[n/2^i] will be 0 for sufficiently large i. In fact, there \ won't be more than Log[2,n] terms. In general, we have the following lemma. \ A proof is in the notes. \n\n\n", FontFamily->"Times"], StyleBox["Lemma 1", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": For all primes ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`p\)]], StyleBox[" and any positive ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\)]], StyleBox[": ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\[Eta]\_p\)(\(n!\))\ = \ \[Sum]\ \[LeftFloor]n/ p\^\(\(\ \)\(i\)\)\[RightFloor]\)]], ".\nThe summation can be truncated at ", Cell[BoxData[ \(TraditionalForm\`\[LeftFloor]\ \(log\_p\) n\[RightFloor]\)]], ". ", StyleBox["\n\nNow it is easy to calculate prime exponents in factorials. \ Here is the case of ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`p = 2\)]], StyleBox[". ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(floorsum[ n_] := \[Sum]\+\(i = 1\)\%\(Log[2, n]\)Floor[n\/2\^i]\), "\n", \(floorsum[100]\)}], "Input", AspectRatioFixed->True], Cell["Let's check some more:", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(floorsum /@ Range[200, 210]\), "\n", \(\((\(PrimeExponent[2]\)[\(#1!\)] &)\) /@ Range[200, 210]\)}], "Input", AspectRatioFixed->True], Cell["\<\ Seems to work fine. Also note that the second, brute force \ computation is slower. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" And more Digit Sums", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:19"], Cell[TextData[{ StyleBox["So, we have an elegant way to compute the exponent of 2 in a \ factorial. But there is still the question of the small difference ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ - \ \(\[Eta]\_\(\(\ \)\(2\)\)\)(n)\)]], ".", StyleBox[" It helps to look at the binary expansion of n to understand \ what this difference is:", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\((TableForm[#1, TableDepth \[Rule] 2] &)\)[ Table[{n - floorsum[n], IntegerDigits[n, 2]}, {n, 200, 220}]]\)], "Input", AspectRatioFixed->True], Cell["Right, it's exactly the digit sum!", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(Table[{n - floorsum[n], DigitSum[n]}, {n, 200, 220}]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["\nHere is a precise reformulation of our first conjecture. ", FontFamily->"Times"], StyleBox["\n\nLemma 2: ", FontFamily->"Times", FontWeight->"Bold"], StyleBox["For all ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ \[GreaterEqual] 1\)]], StyleBox[" we have ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ - \ \(\[Eta]\_\(\(\ \)\(2\)\)\)(n)\)]], StyleBox[" is the binary digit sum of ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\)]], ".", StyleBox[" ", FontFamily->"Times", FontWeight->"Bold"], StyleBox["\n\nProof:\nNote that the binary expansion of ", FontFamily->"Times"], StyleBox["Floor[n/2^i]", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" is the binary expansion of ", FontFamily->"Times"], StyleBox["n", FontFamily->"Times", FontWeight->"Bold"], StyleBox[", shifted to the right by ", FontFamily->"Times"], StyleBox["i", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" places (shifted, not rotated, the last i digits are truncated). \ Hence, each digit ", FontFamily->"Times"], StyleBox["1", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" that contributes ", FontFamily->"Times"], StyleBox["2^k", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" to ", FontFamily->"Times"], StyleBox["n", FontFamily->"Times", FontWeight->"Bold"], StyleBox[", contributes only ", FontFamily->"Times"], StyleBox["2^(k-1)", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" to the floor sum. Adding everything up, we get ", FontFamily->"Times"], StyleBox["n", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" minus the number of ", FontFamily->"Times"], StyleBox["1", FontFamily->"Times", FontWeight->"Bold"], StyleBox["'s in the binary expansion of ", FontFamily->"Times"], StyleBox["n", FontFamily->"Times", FontWeight->"Bold"], StyleBox[", i.e., ", FontFamily->"Times"], StyleBox["n - DigitSum[n]", FontFamily->"Times", FontWeight->"Bold"], StyleBox[". \nQED \n", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "Denominators of ", Cell[BoxData[ \(TraditionalForm\`\@\(\(x\)\(\[ThinSpace]\)\)\)]] }], "Section", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:20"], Cell[CellGroupData[{ Cell[" Denominators in a Square-Root Series", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:21"], Cell[TextData[{ "The next exploration is motivated by a standard technique in calculus: \ expanding a function into its Taylor series. For example, here is the Taylor \ series for a function ", Cell[BoxData[ \(TraditionalForm\`h\)]], ", expanded about ", Cell[BoxData[ \(TraditionalForm\`x\_0\ = \ 0\)]], ", to 5 terms. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(Clear[h]\), "\n", \(Series[h[x], {x, 0, 5}]\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["Thus, the n-th term in the expansion is of the form\n\n\t", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\(\[PartialD]\^n\( h(x\_0)\)\)\(\ \ \)\)\/\[PartialD]\ x\^n\ 1\/\(n!\)\ \((x\ - x\_0)\)\^n\)]], StyleBox["\n\nThe Mathematica notation for the n-th derivative of ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`h(x)\)]], StyleBox[" with respect to ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\)]], StyleBox[" is ", FontFamily->"Times"], Cell[BoxData[ FormBox[ StyleBox[\(D[\ h[x], {x, n}]\), "SmallText"], TraditionalForm]]], StyleBox[".\nThe last term in the expansion, ", FontFamily->"Times"], StyleBox["O[x]^6", "SmallText", FontFamily->"Times"], StyleBox[" indicates that the error in the expansion is no larger than \ some constant times ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`x\^6\)]], StyleBox[". Don't ask why the exponent is outside of the brackets, rather \ than inside (a lot of people think the error term should look like ", FontFamily->"Times"], StyleBox["O[x^6]", "SmallText", FontFamily->"Times"], StyleBox["). \n\nYou probably remember the series for Exp, Sin, Cos, and so \ forth. ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(exp = Series[Exp[x], {x, 0, 5}]\), "\n", \(Series[Sin[x], {x, 0, 11}]\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ "These series are useful for example to approximate functions that might \ otherwise be difficult to compute. Here is an approximation for the \ exponential function. Note that we can truncate the error term using the \ command Normal. Moreover, in order to get a real valued function we apply ", ButtonBox["N", ButtonStyle->"RefGuideLink"], ". Lastly, in order to avoid recomputing all of this every time we compute \ ", StyleBox["ee[x]", "MR"], " for some value of ", Cell[BoxData[ \(TraditionalForm\`x\)]], ", we use ", ButtonBox["Evaluate", ButtonStyle->"RefGuideLink"], " which forces the right hand side to be avaluated right away during \ function definition. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(ee[x_] := Evaluate[N[Normal[exp]]]\), "\n", \(Information["\", LongForm \[Rule] False]\), "\n", \(ee[1]\)}], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(Plot[{Exp[x], ee[x]}, {x, \(-3\), 3}, PlotStyle \[Rule] {Blue, Red}];\)\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "A fairly good match from -2 to 2. At any rate, here is the Taylor series \ for the square root of x, expanded about ", Cell[BoxData[ \(TraditionalForm\`x\_0 = \ 1\)]], ", to 10 terms. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(sqr = Series[\@x, {x, 1, 10}]\)], "Input", AspectRatioFixed->True], Cell[BoxData[{ \(Denominator /@ \(List @@ Normal[sqr]\)\), "\n", \(2\^Range[0, 18]\)}], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox["It appears that the denominators are all powers of 2. That's \ somewhat of a surprise, since a little calculation establishes the following \ proposition. \n\n", FontFamily->"Times"], StyleBox["Proposition", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": The absolute value of the ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\)]], StyleBox["-th coefficient, ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`n\ > \ 1\)]], StyleBox[", is ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\(\ \)\(\[CapitalPi]\_\(i < n\)\ \((2 i - 1)\)/ 2\^n \( n!\)\)\)\)]] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell["\<\ The proof is left as an exercise. At any rate, we can easily \ calculate these numbers. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(coeff[ n_] := \(\[Product]\+\(i = 1\)\%\(n - 1\)\((2\ i - 1)\)\)\/\(2\^n\ \ \(n!\)\)\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(coeff /@ Range[0, 10]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "Hence, every odd divisor of ", Cell[BoxData[ \(TraditionalForm\`\(n!\)\)]], " has to divide the numerator. Let's assume for the moment that this is \ in fact true, and that the denominators in the series are powers of 2. What \ are the exponents? Let's take a longer piece of the series, and truncate the \ error term. We take base-2 logarithms to make the numbers a little smaller. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[{ \(\(ser = Normal[Series[\@x, {x, 1, 60}]];\)\), "\n", \(logden = \((Log[2, #1] &)\) /@ \(Denominator /@ \(List @@ ser\)\)\), "\n", \(\(ListPlot[logden, PlotStyle \[Rule] RGBColor[0, 0, 1]];\)\)}], "Input",\ AspectRatioFixed->True], Cell["\<\ Vaguely linear, but there are lots of little jumps. Let's look at \ the differences between consecutive terms -- which would have to be constant \ if the sequence were indeed linear. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Differences", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:22"], Cell["\<\ Considering the differences between consecutive terms in a \ sequence, rather than the sequence itself, often simplifies matters greatly \ (differences will be discussed in a separate notebook later). Note that it \ suffices to understand the differences, the original sequence can always be \ reclaimed by adding up differences. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(diff = Rest[logden] - Most[logden]\)], "Input", AspectRatioFixed->True], Cell[BoxData[ \(\(ListPlot[diff, PlotStyle \[Rule] {Blue, PointSize[0.02]}];\)\)], "Input", AspectRatioFixed->True], Cell["\<\ There are lots of 1's, but clearly the differences are nowhere near \ constant. There is a lot of symmetry, though. The frequencies of the various elements in the sequence also show this \ symmetry (we have chosen 60 terms in the original series, so the ratios are \ not always exactly 2). \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(TableForm[\(({#1, Count[diff, #1]} &)\) /@ Union[diff]]\)], "Input", AspectRatioFixed->True], Cell["\<\ In fact, the picture should look very familiar: it is very similar \ to the picture for the prime exponenents from the first section in this \ notebook. If you remember that section, we you will probably suggest to take \ a look at binary expansions.\ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\((TableForm[#1, TableDepth \[Rule] 2] &)\)[\(({diff\[LeftDoubleBracket]#1\[RightDoubleBracket], IntegerDigits[#1, 2, 6]} &)\) /@ Range[60]]\)], "Input", AspectRatioFixed->True], Cell["\<\ A moment's introspection reveals the pattern: the number in the \ left column is the number of trailing 0's, plus 1. But the number of \ trailing 0's is none other than the prime exponent of 2 in that number. \ \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(\(PrimeExponent[p_]\)[ n_] := \[IndentingNewLine]Module[{ee = 0, nn = n}, \[IndentingNewLine]While[Mod[nn, p] \[Equal] 0, \(ee++\); nn /= p]; \[IndentingNewLine]ee\[IndentingNewLine]]\)], "Input"], Cell[BoxData[ \(Table[{diff\[LeftDoubleBracket] i\[RightDoubleBracket], \(PrimeExponent[2]\)[i], IntegerDigits[i, 2, 6]}, {i, 50}]\ // \ \(Curry[TableForm]\)[ TableDepth \[Rule] 2]\)], "Input", AspectRatioFixed->True], Cell["Looks right, but let's check:", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(PrimeExponent[2] /@ Range[Length[diff]] + 1 === diff\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "Hence, we have the following claim (note that we don't have a proof yet). \ \n\n", StyleBox["Claim 1", FontWeight->"Bold"], ": The ", Cell[BoxData[ \(TraditionalForm\`n\)]], StyleBox["-th difference for the sequence of the base-2 logarithms of the \ denominators of the square root series is ", FontFamily->"Times"], StyleBox["PrimeExponent[2][n]", "MR"], ". " }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Back to the denominators", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:23"], Cell["\<\ Now how about the original sequence, the logarithms of the \ denominators? \ \>", "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(logden\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "Perhaps the binary expansions will also produce a description of the \ denominators. The trick is to compare the (logarithm of the) ", Cell[BoxData[ \(TraditionalForm\`n\)]], "-th denominator to ", Cell[BoxData[ \(TraditionalForm\`2 n\)]], ", and the binary expansion of ", Cell[BoxData[ \(TraditionalForm\`n\)]], ". Note that the list ", StyleBox["logden", "MR"], " in Mathematica is indexed starting at 1(as are all lists), but the first \ term really is the 0-th denominator. " }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[BoxData[ \(Table[{i, IntegerDigits[i, 2, 8], 2\ i, logden\[LeftDoubleBracket]i + 1\[RightDoubleBracket]}, {i, 0, 50}]\ // \ \(Curry[TableForm]\)[TableDepth \[Rule] 2]\)], "Input", AspectRatioFixed->True], Cell[TextData[{ "This takes a bit of staring. Again, one would first make a vague \ observation like: ", StyleBox["logden[n]", "MR"], " is 2n minus a small number. Then, one hat to pin down the small number. \ After a while, one should come up with the following claim. \n\n", StyleBox["Claim 2: ", FontWeight->"Bold"], "For all", StyleBox[" ", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`n\ \[GreaterEqual] \ 1\)]], StyleBox[" ", FontWeight->"Bold"], "we have:", StyleBox[" ", FontWeight->"Bold"], Cell[BoxData[ \(TraditionalForm\`logden[n]\ = \ \ 2\ n\ - \ DigitSum[n]\)]], StyleBox[".", FontWeight->"Bold"] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["Exercise", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": Give proofs for claims 1 and 2.", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Problems", "Section", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:24"], Cell[CellGroupData[{ Cell[" Josephus", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:25"], Cell[CellGroupData[{ Cell[" Problem 1:", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:26"], Cell["\<\ Characterize the values of n for which n is the surivor. In other \ words, find all fixed points of S. Then characterize all n such that S[n] == n/2 and S[n] == 1. \ \>", \ "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Problem 2:", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:27"], Cell["\<\ Let S be the survivor function as defined above. Since 1 <= S[n] \ <= n by definition, repeated application of S must lead to a cycle \ (repeated application is utterly meaningless in terms of the original \ problem, but you can always iterate a function). Characterize all the cycles of S. \ \>", "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell[" Problem 3:", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:28"], Cell["\<\ Generalize the problem. For example, what happens if every third \ man is killed (this is supposedly the original version of the problem). How \ much of the analysis can be carried over? \ \>", "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[" Orbits, Cycles and Fixed Points", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:29"], Cell[CellGroupData[{ Cell["Problem 1", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:30"], Cell["\<\ Suppose {x1, x2, ..., xn } is a cycle of some function F. Why \ is it safe to assume that this list is primitive? \ \>", "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["Problem 2", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:31"], Cell[TextData[{ StyleBox["Give a more careful definition of transient length and period \ length. \n\nThen show how to construct a function ", FontFamily->"Times"], StyleBox["foo[t_,p_][n_]", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" such that for all t >= 0, p >= 1, the orbit of 0 under \ foo[t,p] has transient length t and period length p. ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["Problem 3", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:32"], Cell[TextData[{ StyleBox["Classify the points in the critical range according to which \ point in ", FontFamily->"Times"], StyleBox["stop", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" their orbit contains. \nRecall ", FontFamily->"Times"], StyleBox["stop == {1, 55, 136, 153, 160, 370, 371, 407, 919}", FontFamily->"Times", FontWeight->"Bold"], StyleBox[".", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["Problem 4", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:33"], Cell["\<\ Cubing the digits of the input is only one possibility. What \ happens if we square the digits instead of cubing them ?? Also, we used decimal digits. What happens if we choose a different number \ system, say octal or binary ??\ \>", "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["Problem 5", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:34"], Cell[TextData[{ StyleBox["Our program AnalyzeOrbit actually computes an initial segment \ of the orbit of a given point. If the points in question are complicate \ objects -- recall the list example -- this segment of the orbit can consume a \ lot of storage.\n\nHere is an approach to computing transient length and \ period length that uses only a constant amount of storage. As before, we \ assume that the orbit of x0 is in fact ultimately periodic. \n\nSuppose ", FontFamily->"Times"], StyleBox["F", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" is the given function. Define ", FontFamily->"Times"], StyleBox["G[x_] := F[F[x]]", FontFamily->"Times", FontWeight->"Bold"], StyleBox[". \n\n\n", FontFamily->"Times"], StyleBox["Claim", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": There is a positive ", FontFamily->"Times"], StyleBox[" t", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" such that \n\n ", FontFamily->"Times"], StyleBox["Nest[ F, x0, t ] === Nest[ G, x0, t ] ", FontFamily->"Times", FontWeight->"Bold"], StyleBox["(", FontFamily->"Times"], StyleBox["=== Nest[F,x0,2t]", FontFamily->"Times", FontWeight->"Bold"], StyleBox["). \n \nProof: \nThink of two particles moving along the \ orbit, a slow one corresponding to iterating F on x0, and a fast one \ corresponding to iterating G on x0. Since we assume that the orbit is \ ultimately periodic, there must be a time t0 when the slow particle has \ reached the cycle. Of course, at that time, the fast pariticle is already on \ the cycle. If they occupy the same position, we are done. Otherwise, at time \ t0 + 1, the fast particle will be one unit closer to the slow one (why?). \ Hence the particles must meet at time t, t < t0 + period. It is easy to \ ensure that t is positive. \nQED\n\n\n \n ", FontFamily->"Times"], StyleBox["Questions", FontFamily->"Times", FontWeight->"Bold"], StyleBox[":\n(1) Let ", FontFamily->"Times"], StyleBox["t > 0", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" be minimal as in the claim. how ", FontFamily->"Times"], StyleBox["xt = Nest[ F, x0, t ]", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" is a cyclic point in the orbit of ", FontFamily->"Times"], StyleBox["x0", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" under ", FontFamily->"Times"], StyleBox["F", FontFamily->"Times", FontWeight->"Bold"], StyleBox[". \nHence, we can compute the period. Once we have the period, \ say, p, we can compute the first cyclic point by finding the first \ intersection of the orbits of x0 and Nest[F,x0,p]. \n\n(2) Exploit these \ facts to constuct a \"memory less\" program that computes transient length \ and period length (of course, we cannot actually compute the pieces of the \ orbit without using memory proportional to their length). \n\n(3) Compare \ the efficiency of your program to the AnalyzeOrbit from above. ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[" Prime Exponents and Digit Sums", "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:35"], Cell[CellGroupData[{ Cell["Problem 1", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:36"], Cell[TextData[{ StyleBox["Give a more detailed proof for Lemma 1.\n\n", FontFamily->"Times"], StyleBox["Lemma 1", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": For all primes p and any positive n: \n", FontFamily->"Times"], StyleBox["PrimeExponent[p][ n! ] == Sum[ Floor[ n/p^i ], {i, \ Floor[Log[p,n]] } ]", FontFamily->"Times", FontWeight->"Bold"], StyleBox[".\n", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["Problem 2", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:37"], Cell[TextData[{ StyleBox["Print some tables that make illustrate the proof for Lemma 2. \n\ Fill in any gaps in the argument. \n\n", FontFamily->"Times"], StyleBox["Lemma 2: ", FontFamily->"Times", FontWeight->"Bold"], StyleBox["For all ", FontFamily->"Times"], StyleBox["n >= 0", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" we have ", FontFamily->"Times"], StyleBox[" PrimeExponent[2][n!] == n - DigitSum[n]. ", FontFamily->"Times", FontWeight->"Bold"], StyleBox["\n", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["Problem 3", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:38"], Cell["Can you generalize Lemma 2 to digit sums in other bases?", "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ " Denominators of ", Cell[BoxData[ \(TraditionalForm\`\@x\)]] }], "Subsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:39"], Cell[CellGroupData[{ Cell["Problem 1", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:40"], Cell[TextData[{ StyleBox["Prove the following proposition for the Taylor series of ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\@x\)]], StyleBox["\n\n", FontFamily->"Times"], StyleBox["Proposition", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": The absolute value of the ", FontFamily->"Times"], StyleBox["n", FontFamily->"Times", FontWeight->"Bold"], StyleBox["-th coefficient, ", FontFamily->"Times"], StyleBox["n > 1", FontFamily->"Times", FontWeight->"Bold"], StyleBox[", is \n ", FontFamily->"Times"], StyleBox["Product[ 2i-1,{i,n-1} ]/(2^n n!).", FontFamily->"Courier", FontWeight->"Bold"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["Problem 2", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:41"], Cell[TextData[{ StyleBox["Prove that the denominators in the Taylor series of ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\@x\)]], StyleBox[" are in fact powers of 2. \nThis is rather difficult. \n\n", FontFamily->"Times"], StyleBox["Hint", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": Use problem 1 and consider PrimeExponent[p] of the numerators \ and denominators of these fractions. Use the material on prime exponents in \ factorials from the first section. You will need to show that \n\n ", FontFamily->"Times"], StyleBox["PrimeExponent[p][ (2n-3)! ] >= PrimeExponent[p][ n! (n-2)! ]", FontFamily->"Times", FontWeight->"Bold"], StyleBox["\n \nfor all odd primes p. Do some testing to convince \ yourself that this is correct. Note that we cannot go down to ", FontFamily->"Times"], Cell[BoxData[ \(TraditionalForm\`\(\((2 n - 4)\)!\)\)]], StyleBox[" on the left, the assertion then fails. Our claim is barely \ true. ", FontFamily->"Times"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]], Cell[CellGroupData[{ Cell["Problem 3", "Subsubsection", Evaluatable->False, AspectRatioFixed->True, CellTags->"c:42"], Cell[TextData[{ StyleBox["Let ", FontFamily->"Times"], StyleBox["den", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" be the sequence of base-2 logarithms of the denominators of the \ square root series. Prove the two claims:\n", FontFamily->"Times"], StyleBox["Claim 1", FontFamily->"Times", FontWeight->"Bold"], StyleBox[": The ", FontFamily->"Times"], StyleBox["n", FontFamily->"Times", FontWeight->"Bold"], StyleBox["-th difference for the ", FontFamily->"Times"], StyleBox["den", FontFamily->"Times", FontWeight->"Bold"], StyleBox[" sequence is ", FontFamily->"Times"], StyleBox["PrimeExponent[2][n]", FontFamily->"Times", FontWeight->"Bold"], StyleBox[". \n", FontFamily->"Times"], StyleBox["Claim 2: ", FontFamily->"Times", FontWeight->"Bold"], StyleBox["For all", FontFamily->"Times"], StyleBox[" n >= 1 ", FontFamily->"Times", FontWeight->"Bold"], StyleBox["we have:", FontFamily->"Times"], StyleBox[" den[n] == 2 n - DigitSum[n].", FontFamily->"Times", FontWeight->"Bold"] }], "Text", Evaluatable->False, AspectRatioFixed->True] }, Closed]] }, Closed]] }, Closed]] }, Open ]] }, FrontEndVersion->"5.0 for X", ScreenRectangle->{{0, 1280}, {0, 1024}}, WindowToolbars->{}, CellGrouping->Automatic, WindowSize->{1012, 996}, WindowMargins->{{Automatic, 1}, {Automatic, 0}}, PrintingStartingPageNumber->341, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, 128}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, CharacterEncoding->Automatic, Magnification->1.5, StyleDefinitions -> "Classic.nb" ] (******************************************************************* 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->{ "c:1"->{ Cell[1828, 55, 118, 3, 205, "Title", Evaluatable->False, CellTags->"c:1"]}, "c:2"->{ Cell[1971, 62, 116, 3, 88, "Section", Evaluatable->False, CellTags->"c:2"]}, "c:3"->{ Cell[2112, 69, 107, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:3"]}, "c:4"->{ Cell[6982, 243, 98, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:4"]}, "c:5"->{ Cell[10506, 361, 125, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:5"]}, "c:6"->{ Cell[16824, 570, 107, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:6"]}, "c:7"->{ Cell[24020, 813, 52, 1, 28, "Subsection", CellTags->"c:7"]}, "c:8"->{ Cell[27125, 914, 117, 3, 47, "Section", Evaluatable->False, CellTags->"c:8"]}, "c:9"->{ Cell[27267, 921, 120, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:9"]}, "c:10"->{ Cell[34806, 1145, 123, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:10"], Cell[36323, 1181, 119, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:10"]}, "c:11"->{ Cell[40806, 1318, 104, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:11"]}, "c:12"->{ Cell[40935, 1325, 117, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:12"]}, "c:13"->{ Cell[43140, 1412, 103, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:13"]}, "c:14"->{ Cell[43621, 1431, 112, 3, 28, "Subsubsection", Evaluatable->False, CellTags->"c:14"]}, "c:15"->{ Cell[48966, 1619, 123, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:15"]}, "c:16"->{ Cell[51440, 1710, 112, 3, 47, "Section", Evaluatable->False, CellTags->"c:16"]}, "c:17"->{ Cell[51577, 1717, 102, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:17"]}, "c:18"->{ Cell[52494, 1753, 121, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:18"]}, "c:19"->{ Cell[58736, 1959, 110, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:19"]}, "c:20"->{ Cell[62072, 2080, 193, 7, 47, "Section", Evaluatable->False, CellTags->"c:20"]}, "c:21"->{ Cell[62290, 2091, 127, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:21"]}, "c:22"->{ Cell[68291, 2286, 102, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:22"]}, "c:23"->{ Cell[71595, 2390, 115, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:23"]}, "c:24"->{ Cell[73787, 2471, 95, 3, 47, "Section", Evaluatable->False, CellTags->"c:24"]}, "c:25"->{ Cell[73907, 2478, 99, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:25"]}, "c:26"->{ Cell[74031, 2485, 104, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:26"]}, "c:27"->{ Cell[74419, 2502, 104, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:27"]}, "c:28"->{ Cell[74931, 2521, 104, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:28"]}, "c:29"->{ Cell[75347, 2538, 122, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:29"]}, "c:30"->{ Cell[75494, 2545, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:30"]}, "c:31"->{ Cell[75826, 2560, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:31"]}, "c:32"->{ Cell[76436, 2582, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:32"]}, "c:33"->{ Cell[77068, 2608, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:33"]}, "c:34"->{ Cell[77512, 2626, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:34"]}, "c:35"->{ Cell[80851, 2716, 121, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:35"]}, "c:36"->{ Cell[80997, 2723, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:36"]}, "c:37"->{ Cell[81635, 2749, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:37"]}, "c:38"->{ Cell[82395, 2780, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:38"]}, "c:39"->{ Cell[82669, 2793, 173, 7, 40, "Subsection", Evaluatable->False, CellTags->"c:39"]}, "c:40"->{ Cell[82867, 2804, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:40"]}, "c:41"->{ Cell[83791, 2841, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:41"]}, "c:42"->{ Cell[85041, 2878, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:42"]} } *) (*CellTagsIndex CellTagsIndex->{ {"c:1", 87291, 2959}, {"c:2", 87394, 2963}, {"c:3", 87498, 2967}, {"c:4", 87605, 2971}, {"c:5", 87712, 2975}, {"c:6", 87821, 2979}, {"c:7", 87930, 2983}, {"c:8", 88012, 2986}, {"c:9", 88118, 2990}, {"c:10", 88228, 2994}, {"c:11", 88439, 3001}, {"c:12", 88551, 3005}, {"c:13", 88666, 3009}, {"c:14", 88781, 3013}, {"c:15", 88896, 3017}, {"c:16", 89011, 3021}, {"c:17", 89120, 3025}, {"c:18", 89232, 3029}, {"c:19", 89344, 3033}, {"c:20", 89456, 3037}, {"c:21", 89565, 3041}, {"c:22", 89677, 3045}, {"c:23", 89789, 3049}, {"c:24", 89901, 3053}, {"c:25", 90009, 3057}, {"c:26", 90120, 3061}, {"c:27", 90235, 3065}, {"c:28", 90350, 3069}, {"c:29", 90465, 3073}, {"c:30", 90577, 3077}, {"c:31", 90692, 3081}, {"c:32", 90807, 3085}, {"c:33", 90922, 3089}, {"c:34", 91037, 3093}, {"c:35", 91152, 3097}, {"c:36", 91264, 3101}, {"c:37", 91379, 3105}, {"c:38", 91494, 3109}, {"c:39", 91609, 3113}, {"c:40", 91721, 3117}, {"c:41", 91836, 3121}, {"c:42", 91951, 3125} } *) (*NotebookFileOutline Notebook[{ Cell[1754, 51, 49, 0, 40, "SmallText"], Cell[CellGroupData[{ Cell[1828, 55, 118, 3, 205, "Title", Evaluatable->False, CellTags->"c:1"], Cell[CellGroupData[{ Cell[1971, 62, 116, 3, 88, "Section", Evaluatable->False, CellTags->"c:2"], Cell[CellGroupData[{ Cell[2112, 69, 107, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:3"], Cell[2222, 74, 327, 10, 70, "Text", Evaluatable->False], Cell[2552, 86, 1257, 41, 70, "Text", Evaluatable->False], Cell[3812, 129, 2133, 76, 70, "Text", Evaluatable->False], Cell[5948, 207, 997, 31, 70, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[6982, 243, 98, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:4"], Cell[7083, 248, 195, 5, 70, "Text", Evaluatable->False], Cell[7281, 255, 472, 10, 70, "Text", Evaluatable->False], Cell[7756, 267, 212, 4, 70, "Text"], Cell[7971, 273, 730, 19, 70, "Text", Evaluatable->False], Cell[8704, 294, 152, 5, 70, "Text", Evaluatable->False], Cell[8859, 301, 96, 2, 70, "Input"], Cell[8958, 305, 147, 3, 70, "Input"], Cell[9108, 310, 138, 4, 70, "Text"], Cell[9249, 316, 110, 2, 70, "Input"], Cell[9362, 320, 82, 2, 70, "Input"], Cell[9447, 324, 177, 3, 70, "Input"], Cell[9627, 329, 842, 27, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[10506, 361, 125, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:5"], Cell[10634, 366, 355, 11, 70, "Text", Evaluatable->False], Cell[10992, 379, 134, 3, 70, "Input"], Cell[11129, 384, 1373, 41, 70, "Text", Evaluatable->False], Cell[12505, 427, 134, 3, 70, "Input"], Cell[12642, 432, 1114, 35, 70, "Text", Evaluatable->False], Cell[13759, 469, 2160, 64, 70, "Text", Evaluatable->False], Cell[15922, 535, 210, 5, 70, "Input"], Cell[16135, 542, 132, 4, 70, "Input"], Cell[16270, 548, 79, 2, 70, "Text", Evaluatable->False], Cell[16352, 552, 435, 13, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[16824, 570, 107, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:6"], Cell[16934, 575, 459, 10, 70, "Text", Evaluatable->False], Cell[17396, 587, 352, 13, 70, "Text"], Cell[17751, 602, 830, 23, 70, "Text", Evaluatable->False], Cell[18584, 627, 171, 4, 70, "Input"], Cell[18758, 633, 200, 5, 70, "Text", Evaluatable->False], Cell[18961, 640, 115, 2, 70, "Input"], Cell[19079, 644, 99, 2, 70, "Text", Evaluatable->False], Cell[19181, 648, 238, 4, 70, "Input"], Cell[19422, 654, 1081, 37, 70, "Text", Evaluatable->False], Cell[20506, 693, 3224, 107, 70, "Text", Evaluatable->False], Cell[23733, 802, 250, 6, 70, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[24020, 813, 52, 1, 28, "Subsection", CellTags->"c:7"], Cell[24075, 816, 2735, 82, 70, "Text", Evaluatable->False], Cell[26813, 900, 263, 8, 70, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[27125, 914, 117, 3, 47, "Section", Evaluatable->False, CellTags->"c:8"], Cell[CellGroupData[{ Cell[27267, 921, 120, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:9"], Cell[27390, 926, 3824, 104, 593, "Text", Evaluatable->False], Cell[31217, 1032, 173, 4, 97, "Input"], Cell[31393, 1038, 114, 3, 74, "Input"], Cell[31510, 1043, 398, 10, 143, "Text", Evaluatable->False], Cell[31911, 1055, 104, 2, 51, "Input"], Cell[32018, 1059, 305, 7, 68, "Text", Evaluatable->False], Cell[32326, 1068, 184, 3, 74, "Input"], Cell[32513, 1073, 148, 5, 43, "Text", Evaluatable->False], Cell[32664, 1080, 109, 2, 51, "Input"], Cell[32776, 1084, 454, 12, 168, "Text", Evaluatable->False], Cell[33233, 1098, 190, 5, 120, "Input"], Cell[33426, 1105, 1343, 35, 393, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[34806, 1145, 123, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:10"], Cell[34932, 1150, 1195, 20, 343, "Text", Evaluatable->False], Cell[36130, 1172, 156, 4, 97, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[36323, 1181, 119, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:10"], Cell[36445, 1186, 1397, 33, 268, "Text", Evaluatable->False], Cell[37845, 1221, 138, 3, 74, "Input"], Cell[37986, 1226, 94, 3, 43, "Text"], Cell[38083, 1231, 152, 2, 74, "Input"], Cell[38238, 1235, 133, 5, 43, "Text"], Cell[38374, 1242, 149, 3, 74, "Input"], Cell[38526, 1247, 250, 9, 43, "Text"], Cell[38779, 1258, 54, 1, 51, "Input"], Cell[38836, 1261, 91, 3, 43, "Text"], Cell[38930, 1266, 88, 1, 51, "Input"], Cell[39021, 1269, 1355, 33, 318, "Text"], Cell[40379, 1304, 194, 3, 74, "Input"], Cell[40576, 1309, 193, 4, 68, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[40806, 1318, 104, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:11"], Cell[CellGroupData[{ Cell[40935, 1325, 117, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:12"], Cell[41055, 1330, 554, 17, 168, "Text", Evaluatable->False], Cell[41612, 1349, 146, 3, 78, "Input"], Cell[41761, 1354, 76, 2, 43, "Text", Evaluatable->False], Cell[41840, 1358, 118, 3, 74, "Input"], Cell[41961, 1363, 217, 9, 43, "Text", Evaluatable->False], Cell[42181, 1374, 167, 3, 74, "Input"], Cell[42351, 1379, 149, 5, 43, "Text", Evaluatable->False], Cell[42503, 1386, 104, 2, 51, "Input"], Cell[42610, 1390, 493, 17, 43, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[43140, 1412, 103, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:13"], Cell[43246, 1417, 338, 9, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[43621, 1431, 112, 3, 28, "Subsubsection", Evaluatable->False, CellTags->"c:14"], Cell[43736, 1436, 2170, 68, 305, "Text", Evaluatable->False], Cell[45909, 1506, 78, 2, 51, "Input"], Cell[45990, 1510, 222, 6, 68, "Text", Evaluatable->False], Cell[46215, 1518, 236, 5, 97, "Input"], Cell[46454, 1525, 480, 16, 43, "Text", Evaluatable->False], Cell[46937, 1543, 69, 2, 51, "Input"], Cell[47009, 1547, 154, 4, 51, "Input"], Cell[47166, 1553, 737, 24, 93, "Text", Evaluatable->False], Cell[47906, 1579, 173, 5, 120, "Input"], Cell[48082, 1586, 847, 28, 168, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[48966, 1619, 123, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:15"], Cell[49092, 1624, 195, 5, 68, "Text", Evaluatable->False], Cell[49290, 1631, 84, 2, 51, "Input"], Cell[49377, 1635, 281, 8, 68, "Text", Evaluatable->False], Cell[49661, 1645, 103, 2, 51, "Input"], Cell[49767, 1649, 577, 14, 168, "Text", Evaluatable->False], Cell[50347, 1665, 161, 3, 51, "Input"], Cell[50511, 1670, 94, 2, 43, "Text", Evaluatable->False], Cell[50608, 1674, 139, 3, 74, "Input"], Cell[50750, 1679, 153, 5, 43, "Text", Evaluatable->False], Cell[50906, 1686, 85, 2, 51, "Input"], Cell[50994, 1690, 385, 13, 43, "Text", Evaluatable->False] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[51440, 1710, 112, 3, 47, "Section", Evaluatable->False, CellTags->"c:16"], Cell[CellGroupData[{ Cell[51577, 1717, 102, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:17"], Cell[51682, 1722, 322, 7, 93, "Text", Evaluatable->False], Cell[52007, 1731, 107, 2, 51, "Input"], Cell[52117, 1735, 148, 5, 43, "Text", Evaluatable->False], Cell[52268, 1742, 86, 2, 51, "Input"], Cell[52357, 1746, 100, 2, 51, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[52494, 1753, 121, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:18"], Cell[52618, 1758, 740, 20, 168, "Text", Evaluatable->False], Cell[53361, 1780, 171, 8, 150, "Input"], Cell[53535, 1790, 625, 18, 143, "Text", Evaluatable->False], Cell[54163, 1810, 148, 3, 74, "Input"], Cell[54314, 1815, 148, 3, 74, "Input"], Cell[54465, 1820, 140, 6, 93, "Text", Evaluatable->False], Cell[54608, 1828, 233, 5, 120, "Input"], Cell[54844, 1835, 679, 18, 168, "Text", Evaluatable->False], Cell[55526, 1855, 150, 3, 51, "Input"], Cell[55679, 1860, 413, 8, 93, "Text", Evaluatable->False], Cell[56095, 1870, 121, 3, 51, "Input"], Cell[56219, 1875, 126, 4, 97, "Input"], Cell[56348, 1881, 177, 3, 74, "Input"], Cell[56528, 1886, 88, 2, 43, "Text", Evaluatable->False], Cell[56619, 1890, 148, 3, 74, "Input"], Cell[56770, 1895, 1351, 37, 299, "Text", Evaluatable->False], Cell[58124, 1934, 162, 4, 120, "Input"], Cell[58289, 1940, 86, 2, 43, "Text", Evaluatable->False], Cell[58378, 1944, 161, 3, 74, "Input"], Cell[58542, 1949, 157, 5, 43, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[58736, 1959, 110, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:19"], Cell[58849, 1964, 468, 12, 68, "Text", Evaluatable->False], Cell[59320, 1978, 182, 4, 74, "Input"], Cell[59505, 1984, 98, 2, 43, "Text", Evaluatable->False], Cell[59606, 1988, 111, 2, 51, "Input"], Cell[59720, 1992, 2303, 82, 318, "Text", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[62072, 2080, 193, 7, 47, "Section", Evaluatable->False, CellTags->"c:20"], Cell[CellGroupData[{ Cell[62290, 2091, 127, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:21"], Cell[62420, 2096, 404, 12, 68, "Text", Evaluatable->False], Cell[62827, 2110, 109, 3, 74, "Input"], Cell[62939, 2115, 1392, 39, 278, "Text", Evaluatable->False], Cell[64334, 2156, 135, 3, 74, "Input"], Cell[64472, 2161, 781, 20, 143, "Text", Evaluatable->False], Cell[65256, 2183, 179, 4, 97, "Input"], Cell[65438, 2189, 141, 3, 51, "Input"], Cell[65582, 2194, 276, 8, 68, "Text", Evaluatable->False], Cell[65861, 2204, 88, 2, 66, "Input"], Cell[65952, 2208, 131, 3, 78, "Input"], Cell[66086, 2213, 753, 23, 118, "Text", Evaluatable->False], Cell[66842, 2238, 160, 5, 43, "Text", Evaluatable->False], Cell[67005, 2245, 151, 4, 86, "Input"], Cell[67159, 2251, 80, 2, 51, "Input"], Cell[67242, 2255, 476, 10, 93, "Text", Evaluatable->False], Cell[67721, 2267, 275, 6, 113, "Input"], Cell[67999, 2275, 255, 6, 68, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[68291, 2286, 102, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:22"], Cell[68396, 2291, 403, 8, 93, "Text", Evaluatable->False], Cell[68802, 2301, 93, 2, 51, "Input"], Cell[68898, 2305, 130, 3, 51, "Input"], Cell[69031, 2310, 365, 8, 93, "Text", Evaluatable->False], Cell[69399, 2320, 114, 2, 51, "Input"], Cell[69516, 2324, 322, 7, 93, "Text", Evaluatable->False], Cell[69841, 2333, 242, 5, 74, "Input"], Cell[70086, 2340, 284, 7, 68, "Text", Evaluatable->False], Cell[70373, 2349, 246, 4, 143, "Input"], Cell[70622, 2355, 255, 5, 74, "Input"], Cell[70880, 2362, 93, 2, 43, "Text", Evaluatable->False], Cell[70976, 2366, 111, 2, 51, "Input"], Cell[71090, 2370, 468, 15, 118, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[71595, 2390, 115, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:23"], Cell[71713, 2395, 147, 5, 43, "Text", Evaluatable->False], Cell[71863, 2402, 65, 2, 51, "Input"], Cell[71931, 2406, 594, 17, 93, "Text", Evaluatable->False], Cell[72528, 2425, 237, 4, 74, "Input"], Cell[72768, 2431, 745, 24, 143, "Text", Evaluatable->False], Cell[73516, 2457, 222, 8, 43, "Text", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[73787, 2471, 95, 3, 47, "Section", Evaluatable->False, CellTags->"c:24"], Cell[CellGroupData[{ Cell[73907, 2478, 99, 3, 42, "Subsection", Evaluatable->False, CellTags->"c:25"], Cell[CellGroupData[{ Cell[74031, 2485, 104, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:26"], Cell[74138, 2490, 244, 7, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[74419, 2502, 104, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:27"], Cell[74526, 2507, 368, 9, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[74931, 2521, 104, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:28"], Cell[75038, 2526, 260, 6, 70, "Text", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[75347, 2538, 122, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:29"], Cell[CellGroupData[{ Cell[75494, 2545, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:30"], Cell[75599, 2550, 190, 5, 43, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[75826, 2560, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:31"], Cell[75931, 2565, 468, 12, 118, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[76436, 2582, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:32"], Cell[76541, 2587, 490, 16, 68, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[77068, 2608, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:33"], Cell[77173, 2613, 302, 8, 118, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[77512, 2626, 102, 3, 42, "Subsubsection", Evaluatable->False, CellTags->"c:34"], Cell[77617, 2631, 3185, 79, 868, "Text", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[80851, 2716, 121, 3, 28, "Subsection", Evaluatable->False, CellTags->"c:35"], Cell[CellGroupData[{ Cell[80997, 2723, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:36"], Cell[81102, 2728, 496, 16, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[81635, 2749, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:37"], Cell[81740, 2754, 618, 21, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[82395, 2780, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:38"], Cell[82500, 2785, 120, 2, 70, "Text", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[82669, 2793, 173, 7, 40, "Subsection", Evaluatable->False, CellTags->"c:39"], Cell[CellGroupData[{ Cell[82867, 2804, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:40"], Cell[82972, 2809, 782, 27, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[83791, 2841, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:41"], Cell[83896, 2846, 1108, 27, 70, "Text", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[85041, 2878, 102, 3, 70, "Subsubsection", Evaluatable->False, CellTags->"c:42"], Cell[85146, 2883, 1186, 44, 70, "Text", Evaluatable->False] }, Closed]] }, Closed]] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)