(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 3.0, MathReader 3.0, or any compatible application. The data for the notebook starts with the line of stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. ***********************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 37759, 1024]*) (*NotebookOutlinePosition[ 38814, 1060]*) (* CellTagsIndexPosition[ 38770, 1056]*) (*WindowFrame->Normal*) Notebook[{ Cell[TextData["\nChapter Ten:\n\nAdditional Examples"], "Title", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["10.1 Animating the Derivative"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Clear[h, t]\n\nDo[Plot[{(Sin[t+h] - Sin[t])/h, Cos[t]}, {t, -5, 5},\n\t\ PlotRange->{{-5, 5}, {-1, 1}}, Ticks->{Automatic, {-1, 1}},\n\t\ PlotStyle->{{}, Dashing[{.02, .02}]}], {h, 1, .1, -.1}]"], "Input", AspectRatioFixed->True], Cell[TextData[ "DerivativeApproximationMovie[\n f_, xmin_, xmax_, ymin_, ymax_, \ h0_:1, h1_:.1, n_:9] :=\nBlock[{ff, ffder},\n\tff[t_] := f /. x -> t;\n\t\ ffder[t_] := D[f, x] /. x -> t;\n\tDo[Plot[{(ff[t+h] - ff[t])/h, ffder[t]}, \ {t, xmin, xmax},\n\t\tPlotRange->{{xmin, xmax}, {ymin, ymax}},\n\t\t\ PlotStyle->{{}, Dashing[{.02}]}],\n\t{h, h0, h1, (h1 - h0)/(n - 1)}]]"], "Input", AspectRatioFixed->True], Cell[TextData[ "DerivativeApproximationMovie[x^10, 0, 1, 0, 30, 1, .02, 10]"], "Input", AspectRatioFixed->True], Cell[TextData[ "f[x_] := Sin[x];\nxmin = -2; xmax = 2; delta = (xmax - xmin)/10;\nplotf = \ Plot[f[x], {x, xmin, xmax}, DisplayFunction->Identity];\nplotder[t_] := \ Plot[f'[x], {x, xmin - delta/100, t},\n\t\t\t\t\t\t\t\t\ DisplayFunction->Identity];\nyrange = PlotRange[Plot[{f[x], f'[x]}, {x, xmin, \ xmax},\n\t\tPlotRange->All, DisplayFunction->Identity]][[2]];\n\n\ Do[Show[plotf, plotder[t],\n\t\tGraphics[{Line[{{t, f[t]} - delta/3 {1, \ f'[t]},\n {t, f[t]} + delta/3 {1, f'[t]}}],\n \t\t\ Dashing[{.008}], Thickness[.003],\n \t\tLine[{{t, f[t]}, {t, f'[t]}}]}],\n \ \tPlotRange->{{xmin - delta/3, xmax + delta/3}, yrange},\n \t\ DisplayFunction->$DisplayFunction],\n{t, xmin, xmax, delta}]"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["10.2 Billiard Paths on Elliptical Tables"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Clear[f]; \n{a, b} = {2, 1};\npi = N[Pi];\nf[t_] := {a Cos[t], b Sin[t]}; \ Attributes[f] = Listable;\nellipse = ParametricPlot[f[t], {t, 0, 2 Pi}];\n\ foci = {{Sqrt[a^2-b^2], 0}, {-Sqrt[a^2-b^2], 0}};\n\nslope1[t0_, t1_] := \ Divide @@ Reverse[f[t1] - f[t0]] /;\n\t\t\t\t\t\t\t\t\t \t t0+t1 != 2 \ pi;\nslope2[t1_] := -b Cot[t1] / a /; t1 != 0 && t1 != pi;\n\n\ slope3[t0_, t1_] :=\n\tTan[2 ArcTan[slope2[t1]] - ArcTan[slope1[t0,t1]]] /; \n\ \t\t\t\t\t t1 != 0 && t1 != pi && t0+t1 != 2 pi;\nslope3[t0_, t1_] := \ -slope1[t0, t1] /; t1 == 0 || t1 == pi;\nslope3[t0_, t1_] := Tan[2 \ ArcTan[slope2[t1]] - pi/2] /;\n\t\t\t\t\t\t\t\t\t\t t0+t1 == 2 pi;\n\n\ newpoint[{t0_, t1_}] := {t1,\n First[Select[ArcTan[b x, a y] /. \n \ N[Solve[(x/a)^2 + (y/b)^2 == 1 && \n\t y - f[t1][[2]] == (x - \ f[t1][[1]]) slope3[t0, t1]]], \n\t Abs[# - t1] > 10^-15 & ]]}\n\n\ BilliardPath[start_, n_] := Show[ellipse, Graphics[{\n\tThickness[.0001], \ PointSize[.02],\n\tPoint /@ f[start], Point /@ foci,\n Line[f[First /@ \ NestList[newpoint, N[start], n]]]}]]"], "Input", AspectRatioFixed->True], Cell[TextData["BilliardPath[{Pi - .2, Pi/2}, 35];"], "Input", AspectRatioFixed->True], Cell[TextData["BilliardPath[{Pi + .5, Pi/2 - .6}, 35];"], "Input", AspectRatioFixed->True], Cell[TextData[ "BilliardPath[{Pi+ArcCos[Sqrt[3]/2], ArcCos[-Sqrt[3]/2]}, 4];"], "Input", AspectRatioFixed->True], Cell[TextData["BilliardPath[{Pi, Pi/2}, 8];"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["10.3 The Art Gallery Theorem"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "SignedArea[{{x1_,y1_}, {x2_,y2_}, {x3_,y3_}}] :=\n\tChop[Det[{{x1,y1,1}, \ {x2,y2,1}, {x3,y3,1}}]/2.]\n\nOrientation[{{x1_,y1_}, {x2_,y2_}, {x3_,y3_}}] \ :=\n\tSign[Chop[Det[{{x1,y1,1}, {x2,y2,1}, {x3,y3,1}}]]]\n\n\ Leftmost[polygon_] :=\n\t\tFirst@First@Position[polygon, \ First[Sort[polygon]]]\n \t\t\nOrientation[polygon_] := Block[{n = \ Length[polygon]}, \tOrientation[polygon[[Leftmost[polygon] + {-1,0,1} /.\n\t\t\ {0 -> n, n+1 -> 1}]]]] \t\t/; Length[polygon] > 3"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["SignedArea[{{0,0}, {0,1}, {1,0}}]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ -0.5\ \>", "\<\ -0.5\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Orientation[{{0,0}, {5,0}, {0,5}}]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 1\ \>", "\<\ 1\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["LeftOf[p_, q_, r_] := Orientation[{p, q, r}] == 1 "], "Input", AspectRatioFixed->True], Cell[TextData[ "norm[p_] := Sqrt[p.p]\n\nBetween[p_, q_, r_] := Orientation[{p, q, r}] == 0 \ &&\n\t (r-p) . (q-p) >= 0 && norm[r-p] <= norm[q-p]\n\nIntersect[{a_, \ b_}, {c_, d_}] := \n\t (LeftOf[a,b,c] ~Xor~ LeftOf[a,b,d]) &&\n\t \ (LeftOf[c,d,a] ~Xor~ LeftOf[c,d,b]) ||\n\t \n\t Between[a,b,c] || \ Between[a,b,d] ||\n\t Between[c,d,a] || Between[c,d,b]"], "Input", AspectRatioFixed->True], Cell[TextData[ "randompoint := Random[]*\n\t\t{Cos[angle = Random[Real, 2 Pi//N]], \ Sin[angle]};\n\ngood[point_] := And @@ Table[\n\t!Intersect[walk[[{i, i+1}]], \ {Last@walk, point}],\n\t\t{i, Length@walk - 2}]\n\t\t\ngoodlaststep[walk_] := \ And @@ Table[\n\t!Intersect[walk[[{i, i+1}]], {Last@walk, First@walk}],\n\t\t\ {i, 2, Length@walk - 2}]\n\nRandomPolygon[n_, maxpts_:40] := (\n\twalk = \ {{0., 0.}, randompoint}; j = 2;\n\tDo[While[\n\t\t j++ < maxpts && !good[new \ = Last[walk]+randompoint]];\n \t AppendTo[walk, new], {n - 3}];\n\t\ While[j++ < maxpts &&\n (!good[new = Last[walk]+randompoint] ||\n \ !goodlaststep[Append[walk, new]])];\n\tIf[j > maxpts, 0, Join[walk, {new, \ First@walk}]])\n\nShowRandomPolygon[n_, maxpts_:40] := \n\tIf[!NumberQ[temp = \ RandomPolygon[n, maxpts]],\n\tShow[Graphics[Line[temp]], PlotRange->All]]"], "Input", AspectRatioFixed->True], Cell[TextData["ShowRandomPolygon[12, 50]"], "Input", AspectRatioFixed->True], Cell[TextData[ "MakeCounterclockwise[polygon_] := \n\tIf[Orientation[polygon] == -1, \ Reverse[polygon], polygon]\n\n(* ConvexVertex[polygon_, i_] :=\n\t\t\t\t\ Orientation[polygon[[{i-1, i, i+1}]]] == 1 \n\t\t\t\t\nPreceding, from book, \ would have been better as follows. Book\nversion doesn't work on first and \ last vertices *)\n\nConvexVertex[polygon_, i_] := Block[{n = Length @ \ polygon},\n\tOrientation[polygon[[\n\t(i + Range[-1,1]) /. {0 -> n, n+1 -> \ 1}]]] == 1]\n\n\nConvexVertex[polygon_] := Block[{i = 2},\n\t\t\t\t\ While[!ConvexVertex[polygon, i], i++]; i]\n\nInside[{p_, q_, r_}, point_] := \ \n\t!LeftOf[q, p, point] && !LeftOf[r, q, point] &&\n\t!LeftOf[p, r, point] \n\ \nPolygonDiagonal[polygon_] :=\n Block[{i = ConvexVertex[polygon], \ invertices},\n invertices = Select[ Drop[polygon, {i-1, i+1}],\n\t\t\t\t\t \ Inside[polygon[[{i-1, i, i+1}]], #] &];\n If[invertices == {}, {i-1, i+1},\n \ Prepend[\n Flatten@Position[polygon, Last@Sort[invertices, \n\t \ SignedArea[{polygon[[i-1]], #1, polygon[[i+1]]}] <=\n\t \ SignedArea[{polygon[[i-1]], #2, polygon[[i+1]]}] &]],\n i]]]\n\n\ Triangulate[polygon_] := {} /; Length[polygon] == 3\n\nTriangulate[polygon_] \ := Block[{diag, poly1, poly2},\n\tdiag = PolygonDiagonal[polygon];\n\tpoly1 = \ Take[polygon, diag]; \n\tpoly2 = Drop[polygon, {1+diag[[1]], diag[[2]]-1}];\n\ \tJoin[Triangulate[poly1], Triangulate[poly2],\n \t\t\t\t{polygon[[diag]]}]]\n\ \nShowTriangulation[polygon_]:= \n\tBlock[{ccwpolygon = \ MakeCounterclockwise[polygon]},\n\tShow[Graphics[\n\t{Line[Append[polygon, \ polygon[[1]]]],\n\t Map[Line, Triangulate[ccwpolygon]]}],\n\t\t\t\t\t\t \ AspectRatio->1, PlotRange->All]]"], "Input", AspectRatioFixed->True], Cell[TextData[ "test = {{1.2, 1}, {0, 0}, {1.2, 0}, {2, .1}, {1, .2}, {2, .3},\n {1, \ .4}, {2, .5}, {1.1, .55}, {2, .7}, {1, .7}, {2, .9}};"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["ConvexVertex[test]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 2\ \>", "\<\ 2\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["PolygonDiagonal[test]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {2, 11}\ \>", "\<\ {2, 11}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["ShowTriangulation[test];"], "Input", AspectRatioFixed->True], Cell[TextData[ "Show[Graphics[Line[{{0,0}, {0,1}, {1, 1}, {1, 0}, {0,0}}],\n\t\t\t\ AspectRatio->1]];"], "Input", AspectRatioFixed->True], Cell[TextData[ "posn[polygon_, diag_] :=\n\t Flatten[Map[Position[polygon, #] &, \ diag]]\n\nconvert[polygon_, diags_]:=\n\t{Range[Length@polygon], \ Map[posn[polygon, #] &, diags]} \n\t\t\t\t \nColor[verts_, diags_] := {verts, \ {1,2,3}} /; Length[verts] == 3\n\nColor[verts_, diags_]:= Block[{i = 1, \ oldcolors},\n\n While[!FreeQ[diags, verts[[++i]]]];\n\t\n\t(* preceding \ finds the ear i-1, i, i+1, since that is\n\t where a vertex is not on any \ diagonal *)\n\n\toldcolors = Color[\n\t\tComplement[verts, {verts[[i]]}],\n\t\ \tComplement[diags, {{verts[[i-1]], verts[[i+1]]}}]];\n\n\t(* preceding \ deletes vertex i and colors by recursion;\n\t following colors vertex i \ appropriately *)\n\n\t{Append[oldcolors[[1]], verts[[i]]],\n\t\ Append[oldcolors[[2]], 6 -\n\t oldcolors[[2,\n \t \ First@First@Position[oldcolors[[1]], verts[[i-1]]]]] -\n \t oldcolors[[2,\n \ \t First@First@Position[oldcolors[[1]], verts[[i+1]]]]]]}]\n\n\ ThreeColor[polygon_] :=\n Block[{ccwpoly = MakeCounterclockwise[polygon]},\ \n {Color @@ convert[ccwpoly, Triangulate[ccwpoly]], ccwpoly}]\n\t\n\ Guards[polygon_] := Block[{coloring, ccw, colorclass, i},\n {coloring, ccw} \ = ThreeColor[polygon];\n colorclass = First@Sort[Table[\n (First /@ \ Select[Transpose[coloring], #[[2]]==i &]), {i, 3}],\n \ Length[#1] < Length[#2]&];\n Show[Graphics[{Line[Append[polygon, \ First[polygon]]],\n \t\t PointSize[.04], Point /@ ccw[[colorclass]]}],\n\ \t\t\t\t\t\t PlotRange->All, AspectRatio->1]]"], "Input", AspectRatioFixed->True], Cell[TextData["Guards[test]"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData[{ StyleBox["GuardsAndColors, a ", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier"], StyleBox["routine to show all 3 colors", Evaluatable->False, AspectRatioFixed->True] }], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "GuardsAndColors[polygon_]:=Block[{coloring, ccw, i, colorclasses},\n \ {coloring, ccw} = ThreeColor[polygon];\n\n colorclasses = Sort[\nTable[(First \ /@ Select[Transpose[coloring], #[[2]]==i &]), {i, 3}],\n \ Length[#1] < Length[#2]&];\n \ Show[Graphics[Line[Append[polygon,polygon[[1]]]]],\n\t\ Graphics@Prepend[Point/@ccw[[colorclasses[[1]]]],\n\t\t\t\t\t\t\t\t\t\ PointSize@.06],\n\tGraphics@Prepend[Point/@ccw[[colorclasses[[2]]]],\n\t\t\t\t\ \t\t\t\t\tPointSize@.04],\n\tGraphics[{GrayLevel@.4,\n\t\t\t\ Prepend[Point/@ccw[[colorclasses[[3]]]],\n\t\t\tPointSize@.04]}],\n\t\t\t\t\t\ \tPlotRange->All,AspectRatio->1]]\n"], "Input", AspectRatioFixed->True]}, Open]], Cell[TextData["GuardsAndColors[test]"], "Input", AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["10.4 Rational Enumeration"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "\n(* 2.0 note: Digits has been replaced by IntegerDigits \n and RealDigits \ *)\n\nIndex[q_Rational] := (\nt = Join@@{Digits@Numerator[q], {10}, \ Digits@Denominator[q]}) .\n (11^Range[Length[t] - 1, 0, -1]) \t\t /; \ Positive[q]\n \nIndex[n_Integer] := (t =\nJoin@@{Digits@n, {10,1}}) . \ (11^Range[Length[t]-1, 0, -1]) /;\n \t\t\t\t\t\t\t\t\t\t\t !Negative[n]\n\n\ Off[Power::infy];\n\nInverseIndex[n_] := Block[{temp, t}, \n \ttemp = Take[t \ = Characters[ToString@BaseForm[n,11]],\n\tFirst @ First @ Position[t, \ \"\\n\"] - 1] /. \"a\"-> \"/\";\n If[First[temp] == \"/\", Return[\"Failure\ \"]];\n temp = ToExpression[StringJoin@@temp];\n If[!NumberQ[temp] || \ Index[temp] != n, \"Failure\", temp]] /; \t\t\t\t\t\t\t\t\t\t\t !Negative[n]\n\ \n(* preceding code changed from first printing of book so that\nit works in \ both versions 1.2 and 2.0 *) \n\nInverseIndex[111] = 0;\n\n\ SetAttributes[{Index, InverseIndex}, Listable]\n\t\t\t\t\t\t\t\t\t"], "Input",\ AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Index[345/1001]\t"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 66500754\ \>", "\<\ 66500754\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["InverseIndex[66500754]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 345/1001\ \>", "\<\ 345 ---- 1001\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Index[Range[0,20]/20]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {111, 2563, 2552, 5225, 236, 235, 5214, 10549, 357, 13211, 233, 17204, 478, 19866, 10538, 477, 599, 25190, 13200, 27852, 232}\ \>", "\<\ {111, 2563, 2552, 5225, 236, 235, 5214, 10549, 357, 13211, 233, 17204, 478, 19866, 10538, 477, 599, 25190, 13200, 27852, 232}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["InverseIndex[%]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {0, 1/20, 1/10, 3/20, 1/5, 1/4, 3/10, 7/20, 2/5, 9/20, 1/2, 11/20, 3/5, 13/20, 7/10, 3/4, 4/5, 17/20, 9/10, 19/20, 1}\ \>", "\<\ 1 1 3 1 1 3 7 2 9 1 11 3 13 7 3 4 17 9 {0, --, --, --, -, -, --, --, -, --, -, --, -, --, --, -, -, --, --, 20 10 20 5 4 10 20 5 20 2 20 5 20 10 4 5 20 10 19 --, 1} 20\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Select[InverseIndex[Range[1000]], NumberQ]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {0, 1, 1/2, 1/3, 1/4, 1/5, 1/6, 1/7, 1/8, 1/9, 2, 2/3, 2/5, 2/7, 2/9, 3, 3/2, 3/4, 3/5, 3/7, 3/8, 4, 4/3, 4/5, 4/7, 4/9, 5, 5/2, 5/3, 5/4, 5/6, 5/7, 5/8, 5/9, 6, 6/5, 6/7, 7, 7/2, 7/3, 7/4, 7/5, 7/6, 7/8, 7/9}\ \>", "\<\ 1 1 1 1 1 1 1 1 2 2 2 2 3 3 3 3 3 4 {0, 1, -, -, -, -, -, -, -, -, 2, -, -, -, -, 3, -, -, -, -, -, 4, -, 2 3 4 5 6 7 8 9 3 5 7 9 2 4 5 7 8 3 4 4 4 5 5 5 5 5 5 5 6 6 7 7 7 7 7 7 7 -, -, -, 5, -, -, -, -, -, -, -, 6, -, -, 7, -, -, -, -, -, -, -} 5 7 9 2 3 4 6 7 8 9 5 7 2 3 4 5 6 8 9\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData["10.5 Algebraic Numbers"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["x /. Solve[x^3 - 9 x^2 + 27 x - 31 == 0]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {3 + 4^(1/3), 3 - 4^(1/3)/2 + ((-3)^(1/2)*4^(1/3))/2, 3 - 4^(1/3)/2 - ((-3)^(1/2)*4^(1/3))/2}\ \>", "\<\ 1/3 1/3 1/3 1/3 1/3 4 Sqrt[-3] 4 4 Sqrt[-3] 4 {3 + 4 , 3 - ---- + -------------, 3 - ---- - -------------} 2 2 2 2\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["Clear[n, t]"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["version 2.0 notes"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Because 2.0 treats powers differently, some of this code may be subject to \ shortening. But it does work."], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "polynomial::usage = \"polynomial[alg] returns a polynomial in x with \ integer coefficients for which the algebraic integer alg is a root.\";\n\n\ polynomial[n_Integer] := x - n\n\npolynomial[z_Complex] := x^2 - 2 Re[z] x + \ Abs[z]^2\n\npolynomial[e_ + f_] := polysum[{polynomial[e], polynomial[f]}]\n\n\ polynomial[e_ ^ x_ * f_ ^ x_] := polynomial[(e f)^x]\n\npolynomial[e_ * f_] \ := polyprod[{polynomial[e], polynomial[f]}]\n\npolysum[{p_, q_}] := \ Resultant[q /. x -> t, p /. x -> x-t, t]\n\npolysum[list_] := \ polysum[{First@list, polysum[Rest@list]}] /;\n\t\t\t\t\t\t\t\t\t \ Length[list] > 2\n\ndegree[p_] := Length[CoefficientList[p, x]] - 1\n\n\ polyprod[{p_, q_}] := \n Expand[(p /. x -> 0) ^ degree[q] *\n\t \ Resultant[t^degree[p] (p /. x -> x/t), q /. x -> t, t]]\n\npolyprod[list_] := \ \n\npolyprod[{First@list, polyprod[Rest@list]}] /; Length[list] > 2\n\n\ polynomial[e_ ^ n_Integer?Positive] := polynomial[Expand[e^n]]\n\n\ polynomial[e_ ^ q_Rational] :=\n polynomial[Expand[e ^ Numerator[q]]] /. x \ -> x^Denominator[q]\n\npolynomial[e_ ^ x_ * f_ ^ x_] := polynomial[(e f)^x]\n\ \npolynomial[q_Rational] := x - q\n\npolynomial[e_ ^ n_Integer?Negative] := \ Block[{\n\ttemp = polynomial[e ^ -n]},\n Expand[(x ^ degree[temp]) * \ (temp /. x -> 1/x)]] "], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["polynomial[Sqrt[2]+Sqrt[3]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 1 - 10*x^2 + x^4\ \>", "\<\ 2 4 1 - 10 x + x\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["polynomial[Sqrt[2] * Sqrt[3]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ -6 + x^2\ \>", "\<\ 2 -6 + x\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["polynomial[ (Sqrt[3] + Sqrt[2]) ^ (1/5) ]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 1 - 10*x^10 + x^20\ \>", "\<\ 10 20 1 - 10 x + x\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData[ "polynomial[ (1 + 19 Sqrt[3]) ^ (1/3) * (Sqrt[2] + 5) ]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ 3343512549106142947921171684 + 157464942249763543893320*x^3 - 1497114925457468151136*x^6 - 11961154756028780*x^9 + 19292185090369*x^12\ \>", "\<\ 3 3343512549106142947921171684 + 157464942249763543893320 x - 6 9 12 1497114925457468151136 x - 11961154756028780 x + 19292185090369 x\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData[ "polynomial[ Sqrt[Sqrt[3] + Sqrt[2]] * (5 + I) ^ (1/3) ]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ 43608742899428874059776 - 88122915739663788605440*x^12 + 89789103725867369521152*x^24 - 192839264512061440*x^36 + 208827064576*x^48\ \>", "\<\ 12 43608742899428874059776 - 88122915739663788605440 x + 24 36 89789103725867369521152 x - 192839264512061440 x + 48 208827064576 x\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData[ "r = (1 + 1/Sqrt[2]) / (Sqrt[3] + 5 ^ (1/3)); polynomial[r]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ 1/4096 - (27*x^2)/1024 - (25*x^3)/256 + (999*x^4)/1024 - (315*x^5)/32 - (877*x^6)/256 + (945*x^7)/32 + (6741*x^8)/256 - (1165*x^9)/32 + (243*x^10)/4 + (45*x^11)/8 + x^12/16\ \>", "\<\ 2 3 4 5 6 7 8 1 27 x 25 x 999 x 315 x 877 x 945 x 6741 x ---- - ----- - ----- + ------ - ------ - ------ + ------ + ------- - 4096 1024 256 1024 32 256 32 256 9 10 11 12 1165 x 243 x 45 x x ------- + ------- + ------ + --- 32 4 8 16\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["% /. x -> N[r, 50]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ 0.\ \>", "\<\ 0.\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData[ "10.6 The Riemann Zeta Function \n\t\t\t(some cells take lots of time)"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Zeta[Range[2, 16, 2]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {Pi^2/6, Pi^4/90, Pi^6/945, Pi^8/9450, Pi^10/93555, (691*Pi^12)/638512875, (2*Pi^14)/18243225, (3617*Pi^16)/325641566250}\ \>", "\<\ 2 4 6 8 10 12 14 16 Pi Pi Pi Pi Pi 691 Pi 2 Pi 3617 Pi {---, ---, ---, ----, -----, ---------, --------, ------------} 6 90 945 9450 93555 638512875 18243225 325641566250\ \>"], "Output",\ Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["Plot[Zeta[n], {n,-10,10}]"], "Input", AspectRatioFixed->True], Cell[TextData["Show[%, PlotRange->{{-10, 0}, {-.1, .1}}]"], "Input", AspectRatioFixed->True], Cell[TextData[ "Plot3D[Abs[Zeta[x+I y]], {x, -4, 4}, {y, -10, 40},\n\t PlotPoints->{70, \ 110}, ViewPoint->{8, 1, 3}, \n\t PlotRange->{0, 5}, Lighting->False,\n\t \ Shading->False, Boxed->False,\n\t BoxRatios->{5, 10, 2}, \ AxesLabel->{\"x\", \"y\", None},\n\t AxesEdge->{{+1, -1}, Automatic, \ Automatic},\n\t Ticks->{Automatic, Range[0, 30, 10], Range[0, 4]}]"], "Input", AspectRatioFixed->True], Cell[TextData[ "Plot3D[1/Abs[Zeta[x+I y]], {x, -4, 4}, {y, -10, 40},\n\t PlotPoints->{70, \ 110}, ViewPoint->{7, 2, 3}, \n\t PlotRange->{0, 5}, Lighting->False,\n\t \ Shading->False, Boxed->False,\n\t AxesLabel->{\"x\", \"y\", None},\n\t \ AxesEdge->{{+1, -1}, Automatic, Automatic},\n\t BoxRatios->{5, 10, 2},\n\t \ Ticks->{Automatic, Range[0, 30, 10], Range[0, 4]}]"], "Input", AspectRatioFixed->True], Cell[TextData[ "zeta[t_] := {Re[temp = Zeta[N[t]]], Im[temp]}\nAttributes[zeta] = Listable"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["zeta[1/2 + I {0,1,2,3,4,5}]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {{-1.460354508809586814, 0}, {0.1439364270771890638, -0.722099743531673091}, {0.4405456503408294377, -0.3116463384357397267}, {0.5327366709742328859, -0.0788965134258333792}, {0.606783764522437267, 0.09111213997251502796}, {0.7018123711656866319, 0.2310380083914199254}}\ \>", "\<\ {{-1.46035, 0}, {0.143936, -0.7221}, {0.440546, -0.311646}, {0.532737, -0.0788965}, {0.606784, 0.0911121}, {0.701812, 0.231038}}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "ParametricPlot[zeta[.5 + I t], {t, 0, 26}]\nParametricPlot[zeta[.5 + I t], \ {t, 7004.1, 7005.32},\n\t\t\t\t\t\t\t\t\t\tMaxBend->20]"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["version 2.0 notes"], "Subsection", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[{ StyleBox["The ", Evaluatable->False, AspectRatioFixed->True], StyleBox["Z", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[" function will be built-in as ", Evaluatable->False, AspectRatioFixed->True], StyleBox["RiemannSiegelZ[]", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"] }], "Text", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "Z[t_] := Exp[I (Im[Log[Gamma[1/4 + I t/2]]] - t/2 Log[Pi])]*\n\t\t Zeta[1/2 \ + I t]//N"], "Input", AspectRatioFixed->True], Cell[TextData["Plot[Z[t]], {t, 0, 100}]"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["Z[100]\t\t\t\t\t\t\t"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ 2.692697056664463589 - 8.36682204638852789*10^-17*I\ \>", "\<\ -17 2.6927 - 8.36682 10 I\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData["Z[10000]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ -0.3413947242129591266 - 4.711788188891015416*10^-11*I\ \>", "\<\ -11 -0.341395 - 4.71179 10 I\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "Plot[Chop[Z[t], 10.^-6], {t, 7004.1, 7005.3},\n\tTicks->{{7004.1, \ 7004.7,7005.3}, {-1.4, -1, -.6}},\n\tAxes->{7005, 0}]"], "Input", AspectRatioFixed->True], Cell[TextData[ "Show[%, PlotRange->{{7005, 7005.15}, {-.1, .03}},\n \t Ticks->{{7005.03, \ 7005.08, 7005.13}, {-.1, -.02, .02}}]"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData[ "approximatezeros = First[Transpose[ \n\t{{14.1745, 0.00813295}, {20.9543, \ 0.00813295},\n\t {25.0456, 0.00813295}, {30.4812, -0.00619712},\n\t {32.936, \ -0.00619712}, {37.6117, 0.00813295}}]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {14.1745, 20.9543, 25.0456, 30.4812, 32.936, 37.6117}\ \>", "\<\ {14.1745, 20.9543, 25.0456, 30.4812, 32.936, 37.6117}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData[ "Chop[t] /. Map[FindRoot[Zeta[1/2 + I t], {t, # + {-.3, +.3}},\n\t\t\ AccuracyGoal->20, WorkingPrecision->30] &, \n approximatezeros]"], "Input", AspectRatioFixed->True], Cell[OutputFormData["\<\ {14.1347251417346937904572519836, 21.0220396387715549926284795962 - 7.1*10^-27*I, 25.0108575801456887632137933244 + 4.5912*10^-24*I, 30.424876125859513210311922958 - 2.92689*10^-22*I, 32.935061587739189690662368964, 37.586178158825671257217763481}\ \>", "\<\ {14.1347251417346937904572519836, -27 21.0220396387715549926284795962 - 7.1 10 I, -24 25.0108575801456887632137933244 + 4.5912 10 I, -22 30.424876125859513210311922958 - 2.92689 10 I, 32.935061587739189690662368964, 37.586178158825671257217763481}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData[ "Z /@ {14.134725141734693790457251983500000000,\n \ 14.134725141734693790457251983600000000,\n \ 14.134725141734693790457251983700000000}"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {-(4.954894706168968684*10^-29) + 5.194898414117200852*10^-39*I, 2.976709626791436727*10^-29 + 2.781310039052427275*10^-39*I, 1.090831396037848245*10^-28 + 2.34586097642786818*10^-39*I}\ \>", "\<\ -29 -39 -29 -39 {-4.95489 10 + 5.1949 10 I, 2.97671 10 + 2.78131 10 I, -28 -39 1.09083 10 + 2.34586 10 I}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]]}, Open]], Cell[CellGroupData[{Cell[TextData[ "10.7 The Influence of the Complex Zeros of z on the Distribution of Primes \ (some cells take lots of time)"], "Section", Evaluatable->False, AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData["N[LogIntegral[10^100], 50]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ 4.3619719871407031590995091132291646115387572117165*10^97\ \>", "\<\ 97 4.3619719871407031590995091132291646115387572117165 10\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[CellGroupData[{Cell[TextData[ "zeros = N[Re[t],20] /. \n\tMap[FindRoot[Zeta[1/2 + I t], {t, # + {-.3, \ +.3}},\n \tAccuracyGoal->20, WorkingPrecision->30] &, \n \t\t\ approximatezeros]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {14.134725141734693790, 21.022039638771554993, 25.010857580145688763, 30.424876125859513210, 32.935061587739189691, 37.586178158825671257, 40.918719012147495187, 43.327073280914999519, 48.005150881167159728, 49.773832477672302182, 52.970321477714460644, 56.446247697063394804, 59.347044002602353080, 60.831778524609809844, 65.112544048081606661, 67.079810529494173714, 69.546401711173979253, 72.067157674481907583, 75.704690699083933168, 77.144840068874805373, 79.337375020249367923, 82.910380854086030183, 84.735492980517050106, 87.425274613125229407, 88.809111207634465424, 92.491899270558484296, 94.651344040519886967, 95.870634228245309759, 98.831194218193692233, 101.317851005731391229, 103.725538040478339416, 105.446623052326094494, 107.168611184276407515, 111.029535543169674525, 111.874659176992637086, 114.320220915452712766, 116.226680320857554382, 118.790782865976217323, 121.370125002420645919, 122.946829293552588201, 42963930368.47235049, 127.516683879596495124, 129.57870419995605099, 131.08768853093265672, 133.49773720299758645, 134.75650975337387133, 138.11604205453344320, 139.73620895212138895, 141.12370740402112376, 143.11184580762063274}\ \>", "\<\ {14.13472514173469379, 21.022039638771554993, 25.010857580145688763, 30.42487612585951321, 32.935061587739189691, 37.586178158825671257, 40.918719012147495187, 43.327073280914999519, 48.005150881167159728, 49.773832477672302182, 52.970321477714460644, 56.446247697063394804, 59.34704400260235308, 60.831778524609809844, 65.112544048081606661, 67.079810529494173714, 69.546401711173979253, 72.067157674481907583, 75.704690699083933168, 77.144840068874805373, 79.337375020249367923, 82.910380854086030183, 84.735492980517050106, 87.425274613125229407, 88.809111207634465424, 92.491899270558484296, 94.651344040519886967, 95.870634228245309759, 98.831194218193692233, 101.317851005731391229, 103.725538040478339416, 105.446623052326094494, 107.168611184276407515, 111.029535543169674525, 111.874659176992637086, 114.320220915452712766, 116.226680320857554382, 118.790782865976217323, 10 121.370125002420645919, 122.946829293552588201, 4.29639 10 , 127.516683879596495124, 129.57870419995605099, 131.08768853093265672, 133.49773720299758645, 134.75650975337387133, 138.1160420545334432, 139.73620895212138895, 141.12370740402112376, 143.11184580762063274}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData["rho = 1/2 + I zeros;"], "Input", AspectRatioFixed->True], Cell[CellGroupData[{Cell[TextData[ "list = Table[N[MoebiusMu[n]/n], {n, 154}];\nMoebiusIndices = \ Select[Range[154], list[[#]] != 0 &]\nMoebiusData = -2 \ list[[MoebiusIndices]]"], "Input", AspectRatioFixed->True], Cell[OutputFormData[ "\<\ {-2., 1., 0.6666666666666666667, 0.4, -0.3333333333333333333, 0.2857142857142857143, -0.2, 0.1818181818181818182, 0.1538461538461538462, -0.1428571428571428571, -0.1333333333333333333, 0.1176470588235294118, 0.1052631578947368421, -0.09523809523809523809, -0.09090909090909090909, 0.08695652173913043478, -0.07692307692307692307, 0.06896551724137931034, 0.06666666666666666667, 0.06451612903225806451, -0.06060606060606060606, -0.05882352941176470589, -0.05714285714285714285, 0.05405405405405405405, -0.05263157894736842105, -0.05128205128205128205, 0.04878048780487804878, 0.04761904761904761904, 0.04651162790697674419, -0.04347826086956521739, 0.04255319148936170213, -0.03921568627450980392, 0.03773584905660377358, -0.03636363636363636363, -0.03508771929824561404, -0.03448275862068965517, 0.03389830508474576271, 0.03278688524590163934, -0.03225806451612903226, -0.03076923076923076923, 0.03030303030303030303, 0.02985074626865671642, -0.02898550724637681159, 0.02857142857142857143, 0.02816901408450704225, 0.02739726027397260274, -0.02702702702702702703, -0.02597402597402597402, 0.02564102564102564102, 0.02531645569620253164, -0.02439024390243902439, 0.0240963855421686747, -0.02352941176470588235, -0.02325581395348837209, -0.02298850574712643678, 0.02247191011235955056, -0.02197802197802197802, -0.02150537634408602151, -0.02127659574468085106, -0.02105263157894736842, 0.02061855670103092783, 0.01980198019801980198, 0.01960784313725490196, 0.0194174757281553398, 0.01904761904761904762, -0.01886792452830188679, 0.01869158878504672897, 0.01834862385321100917, 0.01818181818181818182, -0.01801801801801801802, 0.01769911504424778761, 0.01754385964912280702, -0.01739130434782608696, -0.01694915254237288136, -0.01680672268907563025, -0.01639344262295081967, -0.01626016260162601626, 0.01574803149606299213, -0.01550387596899224806, 0.01538461538461538462, 0.01526717557251908397, -0.01503759398496240602, -0.01492537313432835821, 0.01459854014598540146, 0.0144927536231884058, 0.01438848920863309353, -0.01418439716312056738, -0.01408450704225352113, -0.01398601398601398601, -0.01379310344827586207, -0.01369863013698630137, 0.01342281879194630873, 0.01324503311258278146, 0.01298701298701298701}\ \>", "\<\ {-2., 1., 0.666667, 0.4, -0.333333, 0.285714, -0.2, 0.181818, 0.153846, -0.142857, -0.133333, 0.117647, 0.105263, -0.0952381, -0.0909091, 0.0869565, -0.0769231, 0.0689655, 0.0666667, 0.0645161, -0.0606061, -0.0588235, -0.0571429, 0.0540541, -0.0526316, -0.0512821, 0.0487805, 0.047619, 0.0465116, -0.0434783, 0.0425532, -0.0392157, 0.0377358, -0.0363636, -0.0350877, -0.0344828, 0.0338983, 0.0327869, -0.0322581, -0.0307692, 0.030303, 0.0298507, -0.0289855, 0.0285714, 0.028169, 0.0273973, -0.027027, -0.025974, 0.025641, 0.0253165, -0.0243902, 0.0240964, -0.0235294, -0.0232558, -0.0229885, 0.0224719, -0.021978, -0.0215054, -0.0212766, -0.0210526, 0.0206186, 0.019802, 0.0196078, 0.0194175, 0.0190476, -0.0188679, 0.0186916, 0.0183486, 0.0181818, -0.018018, 0.0176991, 0.0175439, -0.0173913, -0.0169492, -0.0168067, -0.0163934, -0.0162602, 0.015748, -0.0155039, 0.0153846, 0.0152672, -0.0150376, -0.0149254, 0.0145985, 0.0144928, 0.0143885, -0.0141844, -0.0140845, -0.013986, -0.0137931, -0.0136986, 0.0134228, 0.013245, 0.012987}\ \>"], "Output", Evaluatable->False, AspectRatioFixed->True]}, Open]], Cell[TextData[ "T[x_, k_] := MoebiusData .\n Re[ ExpIntegralEi[rho[[k]] / MoebiusIndices * \ Log[N[x]]] ]"], "Input", AspectRatioFixed->True], Cell[TextData[ "domain = Range[12., 100, 88./150]\nT1 = T[domain, 1];"], "Input", AspectRatioFixed->True], Cell[TextData["ListPlot[Transpose[{domain, T1}], PlotJoined->True]"], "Input", AspectRatioFixed->True], Cell[TextData[ "start = 1\nDo[T[domain, i] >>> \"T.Data\", {i, start, start + 3}]"], "Input",\ AspectRatioFixed->True], Cell[TextData[ "(* Needs RiemannR from Appendix *)\n\nRiemannData = RiemannR[domain] + \ N[ArcTan[Pi/Log[Domain]]/Pi]\n"], "Input", AspectRatioFixed->True], Cell[TextData[{ StyleBox[" following assumes ", Evaluatable->False, AspectRatioFixed->True], StyleBox["data", Evaluatable->False, AspectRatioFixed->True, FontFamily->"Courier", FontWeight->"Bold"], StyleBox[ " has been built as indicated in the text. This entire computation took me \ two weeks of computing two or three tables of T values each night!", Evaluatable->False, AspectRatioFixed->True] }], "Text", Evaluatable->False, AspectRatioFixed->True], Cell[TextData[ "Scan[ListPlot[Transpose[{domain, #}], PlotJoined->True,\n\t\t\ PlotRange->{{10, 100}, {5, 27}}, Axes->{10, 5},\n\t\tTicks->{Range[20, 100, \ 10], Automatic}] &, \n\tAccumulate[Plus, Prepend[data, RiemannData]]];"], "Input", AspectRatioFixed->True]}, Open]] }, FrontEndVersion->"Macintosh 3.0", ScreenRectangle->{{0, 640}, {0, 460}}, WindowToolbars->{}, CellGrouping->Manual, WindowSize->{520, 365}, WindowMargins->{{44, Automatic}, {Automatic, 16}}, PrivateNotebookOptions->{"ColorPalette"->{RGBColor, -1}}, ShowCellLabel->True, ShowCellTags->False, RenderingOptions->{"ObjectDithering"->True, "RasterDithering"->False}, MacintoshSystemPageSetup->"\<\ AVU/IFiQKFD000000V1e009POM0000000ORWP095TlP0AP1Y06`0I@1^0642H7D0 0V1ml0000001n:MP0TFCb000000000000000009PM@0000000000000000000000 00000000000000000000000000000000\>" ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1711, 51, 112, 2, 70, "Title", Evaluatable->False], Cell[CellGroupData[{ Cell[1846, 55, 106, 2, 70, "Section", Evaluatable->False], Cell[1955, 59, 250, 4, 70, "Input"], Cell[2208, 65, 424, 7, 70, "Input"], Cell[2635, 74, 113, 2, 70, "Input"], Cell[2751, 78, 761, 11, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[3544, 91, 117, 2, 70, "Section", Evaluatable->False], Cell[3664, 95, 1138, 16, 70, "Input"], Cell[4805, 113, 87, 1, 70, "Input"], Cell[4895, 116, 92, 1, 70, "Input"], Cell[4990, 119, 114, 2, 70, "Input"], Cell[5107, 123, 81, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[5220, 126, 105, 2, 70, "Section", Evaluatable->False], Cell[5328, 130, 528, 8, 70, "Input"], Cell[CellGroupData[{ Cell[5879, 140, 86, 1, 70, "Input"], Cell[5968, 143, 110, 6, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[6110, 151, 87, 1, 70, "Input"], Cell[6200, 154, 104, 6, 70, "Output", Evaluatable->False] }, Closed]], Cell[6316, 162, 103, 1, 70, "Input"], Cell[6422, 165, 406, 6, 70, "Input"], Cell[6831, 173, 897, 13, 70, "Input"], Cell[7731, 188, 78, 1, 70, "Input"], Cell[7812, 191, 1727, 24, 70, "Input"], Cell[9542, 217, 183, 3, 70, "Input"], Cell[CellGroupData[{ Cell[9748, 222, 71, 1, 70, "Input"], Cell[9822, 225, 104, 6, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[9958, 233, 74, 1, 70, "Input"], Cell[10035, 236, 116, 6, 70, "Output", Evaluatable->False] }, Closed]], Cell[10163, 244, 77, 1, 70, "Input"], Cell[10243, 247, 139, 3, 70, "Input"], Cell[10385, 252, 1577, 22, 70, "Input"], Cell[11965, 276, 65, 1, 70, "Input"], Cell[CellGroupData[{ Cell[12053, 279, 290, 10, 70, "Subsection", Evaluatable->False], Cell[12346, 291, 695, 11, 70, "Input"] }, Closed]], Cell[13053, 304, 74, 1, 70, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[13159, 307, 102, 2, 70, "Section", Evaluatable->False], Cell[13264, 311, 1025, 15, 70, "Input"], Cell[CellGroupData[{ Cell[14312, 328, 70, 1, 70, "Input"], Cell[14385, 331, 118, 6, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[14535, 339, 75, 1, 70, "Input"], Cell[14613, 342, 123, 8, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[14768, 352, 74, 1, 70, "Input"], Cell[14845, 355, 362, 11, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[15239, 368, 68, 1, 70, "Input"], Cell[15310, 371, 449, 15, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[15791, 388, 95, 1, 70, "Input"], Cell[15889, 391, 734, 17, 70, "Output", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[16664, 410, 99, 2, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[16786, 414, 93, 1, 70, "Input"], Cell[16882, 417, 439, 12, 70, "Output", Evaluatable->False] }, Closed]], Cell[17333, 431, 64, 1, 70, "Input"], Cell[CellGroupData[{ Cell[17420, 434, 97, 2, 70, "Subsection", Evaluatable->False], Cell[17520, 438, 181, 4, 70, "Text", Evaluatable->False] }, Closed]], Cell[17713, 444, 1334, 19, 70, "Input"], Cell[CellGroupData[{ Cell[19070, 465, 80, 1, 70, "Input"], Cell[19153, 468, 146, 7, 70, "Output", Evaluatable->False], Cell[CellGroupData[{ Cell[19322, 477, 82, 1, 70, "Input"], Cell[19407, 480, 124, 7, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[19563, 489, 94, 1, 70, "Input"], Cell[19660, 492, 151, 7, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[19843, 501, 108, 2, 70, "Input"], Cell[19954, 505, 511, 15, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[20497, 522, 111, 2, 70, "Input"], Cell[20611, 526, 504, 17, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[21147, 545, 112, 2, 70, "Input"], Cell[21262, 549, 688, 18, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[21982, 569, 71, 1, 70, "Input"], Cell[22056, 572, 106, 6, 70, "Output", Evaluatable->False] }, Closed]] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[22212, 580, 150, 4, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[22385, 586, 74, 1, 70, "Input"], Cell[22462, 589, 475, 12, 70, "Output", Evaluatable->False] }, Closed]], Cell[22949, 603, 78, 1, 70, "Input"], Cell[23030, 606, 94, 1, 70, "Input"], Cell[23127, 609, 420, 7, 70, "Input"], Cell[23550, 618, 426, 6, 70, "Input"], Cell[23979, 626, 131, 3, 70, "Input"], Cell[CellGroupData[{ Cell[24133, 631, 80, 1, 70, "Input"], Cell[24216, 634, 524, 15, 70, "Output", Evaluatable->False] }, Closed]], Cell[24752, 651, 186, 3, 70, "Input"], Cell[CellGroupData[{ Cell[24961, 656, 97, 2, 70, "Subsection", Evaluatable->False], Cell[25061, 660, 499, 19, 70, "Text", Evaluatable->False] }, Closed]], Cell[25572, 681, 141, 3, 70, "Input"], Cell[25716, 686, 77, 1, 70, "Input"], Cell[CellGroupData[{ Cell[25816, 689, 73, 1, 70, "Input"], Cell[25892, 692, 202, 9, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[26126, 703, 61, 1, 70, "Input"], Cell[26190, 706, 211, 9, 70, "Output", Evaluatable->False] }, Closed]], Cell[26413, 717, 175, 3, 70, "Input"], Cell[26591, 722, 170, 3, 70, "Input"], Cell[CellGroupData[{ Cell[26784, 727, 247, 4, 70, "Input"], Cell[27034, 733, 210, 8, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[27276, 743, 198, 4, 70, "Input"], Cell[27477, 749, 773, 23, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[28282, 774, 200, 4, 70, "Input"], Cell[28485, 780, 495, 14, 70, "Output", Evaluatable->False] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[29021, 796, 186, 4, 70, "Section", Evaluatable->False], Cell[CellGroupData[{ Cell[29230, 802, 79, 1, 70, "Input"], Cell[29312, 805, 272, 9, 70, "Output", Evaluatable->False] }, Closed]], Cell[CellGroupData[{ Cell[29616, 816, 217, 4, 70, "Input"], Cell[29836, 822, 2616, 61, 70, "Output", Evaluatable->False] }, Closed]], Cell[32464, 885, 73, 1, 70, "Input"], Cell[CellGroupData[{ Cell[32560, 888, 199, 4, 70, "Input"], Cell[32762, 894, 3555, 82, 70, "Output", Evaluatable->False] }, Closed]], Cell[36329, 978, 146, 3, 70, "Input"], Cell[36478, 983, 107, 2, 70, "Input"], Cell[36588, 987, 104, 1, 70, "Input"], Cell[36695, 990, 121, 3, 70, "Input"], Cell[36819, 995, 157, 3, 70, "Input"], Cell[36979, 1000, 497, 16, 70, "Text", Evaluatable->False], Cell[37479, 1018, 268, 5, 70, "Input"] }, Closed]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)