(*********************************************************************** 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[ 34810, 1170]*) (*NotebookOutlinePosition[ 35477, 1194]*) (* CellTagsIndexPosition[ 35433, 1190]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " Conversations 2: Alternative Expressions for Sequences with ", StyleBox["Mathematica", FontSlant->"Italic"] }], "Title"], Cell[TextData[{ "One of ", StyleBox["Mathematica", FontSlant->"Italic"], "'s strengths is its adaptibility to various programming styles." }], "Subsubtitle"], Cell[CellGroupData[{ Cell["\<\ by Robert Dickau\ \>", "Subtitle"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " gives us many ways to accomplish a task. This adaptibility gives authors \ the opportunity to use expressions that optimize different criteria. If the \ audience includes students who have had traditional procedural programming, \ then the author might use procedural structures. [Maeder]. On the other hand, \ the author might be writing to optimize speed. In any case, it's useful for \ authors and students to see variations on ", StyleBox["Mathematica", FontSlant->"Italic"], " code." }], "Text"], Cell[TextData[{ "In Martin's sequence article, the author defines a function ", StyleBox["gaps", FontFamily->"Courier"], " as" }], "Text"], Cell[BoxData[ \(\(gaps[s_List]\ := \n\ \ \ \ \ Table[s[\([k]\)]\ - \ s[\([k\ - \ 1]\)], \ {k, \ 2, \ Length[s]}]; \)\)], "Input"], Cell[TextData[{ "The author then defines a function to recursively apply ", StyleBox["gaps", FontFamily->"Courier"], " a given number of times." }], "Text"], Cell[BoxData[ \(recursiveGaps[s_List, \ 1] := gaps[s]; \n recursiveGaps[s_List, \ m_]\ := \ gaps[recursiveGaps[s, m - 1]]; \)], "Input"], Cell["Instead, what about", "Text"], Cell[BoxData[ \(\(\ \ \(gaps[s_List] := Rest[s - RotateRight[s]]; \)\)\)], "Input"], Cell["or perhaps", "Text"], Cell[BoxData[ \(gaps[s_List] := Drop[s, 1]\ - \ Drop[s, \(-1\)]\)], "Input"], Cell[TextData[{ "as a possible expression? And then, selecting one of the above, we can \ write a function ", StyleBox["fixedPointForGaps", FontFamily->"Courier"], " as a variation on the ", StyleBox["recursiveGaps", FontFamily->"Courier"], " function." }], "Text"], Cell[BoxData[ \(\(\ fixedPointForGaps[L_] := \n\ \ \ \ \ FixedPointList[gaps, L, 25, \n\t\t\ \ SameTest\ -> \ \((Apply[SameQ, #]&)\)]\)\)], "Input"], Cell[TextData[{ "Let's follow Martin's use of the ", StyleBox["Mathematica", FontSlant->"Italic"], " function Table to generate a list." }], "Text"], Cell[BoxData[ \(seq1[n_]\ := \ Table[\((a\ \((a + 1)\))\)/2, \ {a, \ 1, \ n}]\)], "Input"], Cell[TextData[{ "Then we apply the ", StyleBox["fixedPointForGaps", FontFamily->"Courier"], " function and arrange the results in a table." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(fixedPointForGaps[seq1[9]] // TableForm\)], "Input"], Cell[BoxData[ InterpretationBox[GridBox[{ {"1", "3", "6", "10", "15", "21", "28", "36", "45"}, {"2", "3", "4", "5", "6", "7", "8", "9", \(""\)}, {"1", "1", "1", "1", "1", "1", "1", \(""\), \(""\)}, {"0", "0", "0", "0", "0", "0", \(""\), \(""\), \(""\)} }, RowSpacings->1, ColumnSpacings->3, RowAlignments->Baseline, ColumnAlignments->{Left}], TableForm[ {{1, 3, 6, 10, 15, 21, 28, 36, 45}, {2, 3, 4, 5, 6, 7, 8, 9}, {1, 1, 1, 1, 1, 1, 1}, {0, 0, 0, 0, 0, 0}}]]], "Output"] }, Open ]], Cell["Parenthetically, I prefer this expression: ", "Text"], Cell[BoxData[ StyleBox[ \(seq1[n_]\ := \ \((a \((a\ + \ 1)\))\)/2\ /. \ a\ -> \ Range[n]\), FontFamily->"Courier"]], "Input"], Cell[TextData[{ "The ", StyleBox["Range", FontFamily->"Courier"], " function is often overlooked as a useful way of generating a list, or a \ list of powers as shown in the next expression:" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(fixedPointForGaps[Range[8]^5] // TableForm\)], "Input"], Cell[OutputFormData[ "\<\ TableForm[{{1, 32, 243, 1024, 3125, 7776, 16807, 32768}, {31, 211, 781, 2101, 4651, 9031, 15961}, {180, 570, 1320, 2550, 4380, 6930}, {390, 750, 1230, 1830, 2550}, {360, 480, 600, 720}, {120, 120, 120}, {0, 0}}]\ \>", "\<\ 1 32 243 1024 3125 7776 16807 32768 31 211 781 2101 4651 9031 15961 180 570 1320 2550 4380 6930 390 750 1230 1830 2550 360 480 600 720 120 120 120 0 0\ \>"], "Output"] }, Open ]], Cell[TextData[{ "Some of the ", StyleBox["Mathematica", FontSlant->"Italic"], " functions used above can also be combined to generate the polygonal, \ sometimes called \"figurate\" numbers. [", "http://www.astro.virginia.edu:80/~eww6n/math/PolygonalNumber.html]" }], "Text"], Cell[BoxData[ \(\(\ \(polygonNumbers[n_, lvl_] := \n\t\ Rest[FoldList[Plus, 0, \n\t\t\tRange[1, lvl*\((n - 2)\), n - 2]]]; \)\)\)], "Input"], Cell["Here are the first ten square numbers:", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(polygonNumbers[4, 10]\)], "Input"], Cell[BoxData[ \({1, 4, 9, 16, 25, 36, 49, 64, 81, 100}\)], "Output"] }, Open ]], Cell["Here are the first ten hexagonal numbers:", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(polygonNumbers[6, 10]\)], "Input"], Cell[BoxData[ \({1, 6, 15, 28, 45, 66, 91, 120, 153, 190}\)], "Output"] }, Open ]], Cell["\<\ Now let's try to find the polynomials that generate the numbers for \ a particular class.\ \>", "Text"], Cell[BoxData[ \(polygonPolynomial[s_]\ := \n\ \ \(\(Fit[polygonNumbers[s, 10], \n\t\t\ \ \ \ \ \ \ \ {1, n, n^2}, n] // \n\t\tChop\) // Rationalize\) // Together\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ \(polygonPolynomial[3]\)], "Input"], Cell[BoxData[ \(1\/2\ \((n + n\^2)\)\)], "Output"] }, Open ]], Cell["\<\ This works for triangular numbers. The formula for hexagonal \ numbers is given by\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(polygonPolynomial[6]\)], "Input"], Cell[BoxData[ \(\(-n\) + 2\ n\^2\)], "Output"] }, Open ]], Cell[TextData[{ "Exploration with various values should suggest to students that for an \ s-sided polygon, the polynomial is ", Cell[BoxData[ \(TraditionalForm\`1\/2\ \((\((s - 2)\)\ n\^2 - \((s - 4)\)\ n)\)\)], "Text"], "." }], "Text"], Cell[TextData[{ "Finally, using ", StyleBox["Mathematica", FontSlant->"Italic"], " code shown in the initialization cells at the end of the article, we can \ see the polygonal numbers using the showPolygon function. For example, the \ seventh triangular number:" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(showPolygon[3, 7]; \)\)], "Input"], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: 1.1547 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.87037 0.10582 0.57735 0.10582 [ [ 0 0 0 0 ] [ 1 1.1547 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 m 1 0 L 1 1.1547 L 0 1.1547 L closepath clip newpath 1 0 0 r .03 w .97619 .57735 Mdot 1 .857 0 r .81746 .48571 Mdot .81746 .66899 Mdot .286 1 0 r .65873 .39406 Mdot .65873 .57735 Mdot .65873 .76064 Mdot 0 1 .571 r .5 .30242 Mdot .5 .48571 Mdot .5 .66899 Mdot .5 .85228 Mdot 0 .571 1 r .34127 .21078 Mdot .34127 .39406 Mdot .34127 .57735 Mdot .34127 .76064 Mdot .34127 .94392 Mdot .286 0 1 r .18254 .11914 Mdot .18254 .30242 Mdot .18254 .48571 Mdot .18254 .66899 Mdot .18254 .85228 Mdot .18254 1.03556 Mdot 1 0 .857 r .02381 .02749 Mdot .02381 .21078 Mdot .02381 .39406 Mdot .02381 .57735 Mdot .02381 .76064 Mdot .02381 .94392 Mdot .02381 1.12721 Mdot % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{102.375, 118.188}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg"], ImageRangeCache->{{{0, 101.375}, {117.188, 0}} -> {-8.22505, -5.46207, 0.0932193, 0.0932193}}] }, Open ]], Cell["Here is the fifth square number:", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(showPolygon[4, 5]; \)\)], "Input"], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.857143 0.119048 0.5 0.119048 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 m 1 0 L 1 1 L 0 1 L closepath clip newpath 1 0 0 r .03 w .97619 .5 Mdot .8 1 0 r .7381 .5 Mdot .7381 .5 Mdot .85714 .38095 Mdot .85714 .61905 Mdot 0 1 .4 r .5 .5 Mdot .5 .5 Mdot .61905 .38095 Mdot .61905 .61905 Mdot .7381 .2619 Mdot .7381 .7381 Mdot 0 .4 1 r .2619 .5 Mdot .2619 .5 Mdot .38095 .38095 Mdot .38095 .61905 Mdot .5 .2619 Mdot .5 .7381 Mdot .61905 .14286 Mdot .61905 .85714 Mdot .8 0 1 r .02381 .5 Mdot .02381 .5 Mdot .14286 .38095 Mdot .14286 .61905 Mdot .2619 .2619 Mdot .2619 .7381 Mdot .38095 .14286 Mdot .38095 .85714 Mdot .5 .02381 Mdot .5 .97619 Mdot % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{102.375, 118.188}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHgOol000eoo`=T 7aEoo`<1WaEoo`<3k1Eoo`=Wh0ioo`003Goo0f@O5Goo0`6O5Goo0`?/5Goo0fOP3Woo001VOol006Io o`00IWoo001VOol006Ioo`00IWoo001VOol006Ioo`00IWoo000017ooI1mT7f@O5Goo0`6O5Goo0`?/ 5Goo0fOP5Goo0g`00Woo000017ooI1mT7f@O5Goo0`6O5Goo0`?/5Goo0fOP5Goo0g`00Woo000017oo I1mT7f@O5Goo0`6O5Goo0`?/5Goo0fOP5Goo0g`00Woo001VOol006Ioo`00IWoo001VOol006Ioo`00 IWoo001VOol006Ioo`00IWoo000=Ool3I1lEOol30IlEOol30n`EOol3In0>Ool000eoo`=T7aEoo`<1 WaEoo`<3k1Eoo`=Wh0ioo`003Goo0f@O5Goo0`6O5Goo0`?/5Goo0fOP3Woo001VOol006Ioo`00IWoo 001VOol006Ioo`00IWoo001VOol006Ioo`00IWoo000IOol3I1lEOol30IlEOol30n`JOol001Uoo`=T 7aEoo`<1WaEoo`<3k1Yoo`006Goo0f@O5Goo0`6O5Goo0`?/6Woo001VOol006Ioo`00IWoo001VOol0 06Ioo`00IWoo001VOol006Ioo`00IWoo000UOol3I1lEOol30IlVOol002Eoo`=T7aEoo`<1WbIoo`00 9Goo0f@O5Goo0`6O9Woo001VOol006Ioo`00IWoo001VOol006Ioo`00IWoo001VOol006Ioo`00IWoo 000aOol3I1lbOol0035oo`=T7c9oo`00"], ImageRangeCache->{{{0, 101.375}, {117.188, 0}} -> {-7.20002, -4.85515, 0.0828612, 0.0828612}}] }, Open ]], Cell["Here is the ninth pentagonal number:", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(showPolygon[5, 9]; \)\)], "Input"], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: 1.05146 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.910383 0.0658079 0.525731 0.0658079 [ [ 0 0 0 0 ] [ 1 1.05146 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 m 1 0 L 1 1.05146 L 0 1.05146 L closepath clip newpath 1 0 0 r .03 w .97619 .52573 Mdot 1 .667 0 r .85714 .48705 Mdot .85714 .56441 Mdot .93072 .46314 Mdot .93072 .58832 Mdot .667 1 0 r .7381 .44837 Mdot .7381 .52573 Mdot .7381 .60309 Mdot .81167 .42446 Mdot .81167 .627 Mdot .88525 .40056 Mdot .88525 .65091 Mdot 0 1 0 r .61905 .40969 Mdot .61905 .48705 Mdot .61905 .56441 Mdot .61905 .64177 Mdot .69262 .38578 Mdot .69262 .66568 Mdot .7662 .36188 Mdot .7662 .68959 Mdot .83977 .33797 Mdot .83977 .71349 Mdot 0 1 .667 r .5 .37101 Mdot .5 .44837 Mdot .5 .52573 Mdot .5 .60309 Mdot .5 .68045 Mdot .57358 .3471 Mdot .57358 .70436 Mdot .64715 .3232 Mdot .64715 .72827 Mdot .72073 .29929 Mdot .72073 .75217 Mdot .7943 .27538 Mdot .7943 .77608 Mdot 0 .667 1 r .38095 .33233 Mdot .38095 .40969 Mdot .38095 .48705 Mdot .38095 .56441 Mdot .38095 .64177 Mdot .38095 .71914 Mdot .38095 .71914 Mdot .45453 .30842 Mdot .45453 .74304 Mdot .5281 .28451 Mdot .5281 .76695 Mdot .60168 .26061 Mdot .60168 .79085 Mdot .67525 .81476 Mdot .67525 .2367 Mdot .74883 .83867 Mdot .74883 .2128 Mdot 0 0 1 r .2619 .29365 Mdot .2619 .37101 Mdot .2619 .44837 Mdot .2619 .52573 Mdot .2619 .60309 Mdot .2619 .68045 Mdot .2619 .75782 Mdot .33548 .26974 Mdot .33548 .78172 Mdot .40906 .24583 Mdot .40906 .80563 Mdot .48263 .22193 Mdot .48263 .82953 Mdot .55621 .19802 Mdot .55621 .85344 Mdot .62978 .17412 Mdot .62978 .87735 Mdot .70336 .15021 Mdot .70336 .90125 Mdot .667 0 1 r .14286 .25496 Mdot .14286 .33233 Mdot .14286 .40969 Mdot .14286 .48705 Mdot .14286 .56441 Mdot .14286 .64177 Mdot .14286 .71914 Mdot .14286 .7965 Mdot .21643 .23106 Mdot .21643 .8204 Mdot .29001 .20715 Mdot .29001 .84431 Mdot .36358 .18325 Mdot .36358 .86822 Mdot .43716 .15934 Mdot .43716 .89212 Mdot .51073 .13543 Mdot .51073 .91603 Mdot .58431 .11153 Mdot .58431 .93993 Mdot .65789 .08762 Mdot .65789 .96384 Mdot 1 0 .667 r .02381 .21628 Mdot .02381 .29365 Mdot .02381 .37101 Mdot .02381 .44837 Mdot .02381 .52573 Mdot .02381 .60309 Mdot .02381 .68045 Mdot .02381 .75782 Mdot .02381 .83518 Mdot .09738 .19238 Mdot .09738 .85908 Mdot .17096 .16847 Mdot .17096 .88299 Mdot .24454 .14457 Mdot .24454 .9069 Mdot .31811 .12066 Mdot .31811 .9308 Mdot .39169 .09675 Mdot .39169 .95471 Mdot .46526 .07285 Mdot .46526 .97862 Mdot .53884 .04894 Mdot .53884 1.00252 Mdot .61241 .02503 Mdot .61241 1.02643 Mdot % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{102.375, 118.188}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHgOol000eoo`=D7aEoo`<2_aEoo`<3h1Eo o`=nX0ioo`00IWoo000017ooO1El5G`E5Goo0`0O5Goo0`?e5Goo0eOP5Goo0g`00Woo000017ooO1El 5G`E5Goo0`0O5Goo0`?e5Goo0eOP5Goo0g`00Woo000017ooO1El5G`E5Goo0`0O5Goo0`?e5Goo0eOP 5Goo0g`00Woo001VOol000eoo`=D7aEoo`<2_aEoo`<3h1Eoo`=nX0ioo`003Goo0e@O5Goo0`:o5Goo 0`?P5Goo0gjP3Woo000=Ool3E1lEOol30[lEOol30n0EOol3OZ05Ool3OZ06Ool005eoo`=nX0Ioo`00 00Aoog`EO1El5AEoo`<07aEoo`<3mAEoo`=Gh15oo`=nX0Ioo`0000Aoog`EO1El5AEoo`<07aEoo`<3 mAEoo`=Gh1Yoo`0000Aoog`EO1El5AEoo`<07aEoo`<3mAEoo`=Gh0Eoo`=Gh19oo`00DGoo0eOP4Woo 000=Ool3E1lEOol30[lEOol30n0AOol3En0BOol000eoo`=D7aEoo`<2_aEoo`<3h1Qoo`=Gh0]oo`00 3Goo0e@O5Goo0`:o5Goo0`?P1Goo0`?P47oo0eOP2goo0015Ool30n0@Ool3En0;Ool00004Ooml5G`E O1DEOol301lEOol30oDAOol30n0NOol00004Ooml5G`EO1DEOol301lEOol30oDHOol30n0GOol00004 Ooml5G`EO1DEOol301lEOol30oD5Ool30oD@Ool30n0GOol003Uoo`<3mA1oo`<3h0Eoo`<3h0moo`00 3Goo0e@O5Goo0`:o4Goo0`?e17oo0`?e4Goo0`?P3goo000=Ool3E1lEOol30[lHOol30oDAOol30n0? Ool000eoo`=D7aEoo`<2_`Eoo`<2_a1oo`<3mB=oo`0000Aoog`EO1El5AEoo`<07a5oo`<2_aQoo`<3 mA]oo`0000Aoog`EO1El5AEoo`<07a5oo`<2_`Aoo`<2_a5oo`<3mA]oo`0000Aoog`EO1El5AEoo`<0 7aQoo`<2_a5oo`<3m@Aoo`<3mAAoo`008Goo0`0O47oo0`:o67oo0`?e57oo000=Ool3E1lAOol301lG Ool30[lAOol30oDDOol000eoo`=D7a5oo`<07`Aoo`<07a1oo`<2_bQoo`003Goo0e@O67oo0`0O47oo 0`:o1Goo0`:o87oo000DOol3E1lAOol301lHOol30[lPOol00004Ooml5G`EO1D@Ool3E1lHOol301lA Ool30[lPOol00004Ooml5G`EO1D@Ool3E1l5Ool3E1l@Ool301lHOol30[lIOol00004Ooml5G`EO1DH Ool3E1l@Ool301l5Ool301l@Ool30[lIOol000Qoo`=l5A5oo`=D7aQoo`<07a1oo`<2_aUoo`0027oo 0g`E67oo0e@O4Goo0`0O;7oo0008Ool3O1D5Ool3O1D@Ool3E1lHOol301lUOol0011oo`=l5A1oo`=D 7`Eoo`=D7a1oo`<07bEoo`0047oo0g`E67oo0e@O47oo0`0O1Goo0`0O7Goo000GOol3O1DAOol3E1l4 Ool3E1lAOol301lMOol001Moo`=l5AQoo`=D7a5oo`<07aeoo`005goo0g`E1Goo0g`E47oo0e@O"], ImageRangeCache->{{{0, 101.375}, {117.188, 0}} -> {-13.834, -8.78309, 0.149898, 0.149898}}] }, Open ]], Cell["And here is the tenth hexagonal number:", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(showPolygon[6, 10]; \)\)], "Input"], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .86603 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.92328 0.0529101 0.433013 0.0529101 [ [ 0 0 0 0 ] [ 1 .86603 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 0 m 1 0 L 1 .86603 L 0 .86603 L closepath clip newpath 1 0 0 r .03 w .97619 .43301 Mdot 1 .6 0 r .87037 .43301 Mdot .87037 .43301 Mdot .89683 .38719 Mdot .89683 .47883 Mdot .94974 .38719 Mdot .94974 .47883 Mdot .8 1 0 r .76455 .43301 Mdot .76455 .43301 Mdot .79101 .38719 Mdot .79101 .47883 Mdot .81746 .34137 Mdot .81746 .52466 Mdot .87037 .34137 Mdot .87037 .52466 Mdot .92328 .34137 Mdot .92328 .52466 Mdot .2 1 0 r .65873 .43301 Mdot .65873 .43301 Mdot .68519 .38719 Mdot .68519 .47883 Mdot .71164 .34137 Mdot .71164 .52466 Mdot .7381 .29555 Mdot .7381 .57048 Mdot .79101 .29555 Mdot .79101 .57048 Mdot .84392 .29555 Mdot .84392 .57048 Mdot .89683 .29555 Mdot .89683 .57048 Mdot 0 1 .4 r .55291 .43301 Mdot .55291 .43301 Mdot .57937 .38719 Mdot .57937 .47883 Mdot .60582 .34137 Mdot .60582 .52466 Mdot .63228 .29555 Mdot .63228 .57048 Mdot .65873 .24973 Mdot .65873 .6163 Mdot .71164 .24973 Mdot .71164 .6163 Mdot .76455 .24973 Mdot .76455 .6163 Mdot .81746 .24973 Mdot .81746 .6163 Mdot .87037 .24973 Mdot .87037 .6163 Mdot 0 1 1 r .44709 .43301 Mdot .44709 .43301 Mdot .47354 .38719 Mdot .47354 .47883 Mdot .5 .34137 Mdot .5 .52466 Mdot .52646 .29555 Mdot .52646 .57048 Mdot .55291 .24973 Mdot .55291 .6163 Mdot .57937 .20391 Mdot .57937 .66212 Mdot .63228 .20391 Mdot .63228 .66212 Mdot .68519 .20391 Mdot .68519 .66212 Mdot .7381 .20391 Mdot .7381 .66212 Mdot .79101 .20391 Mdot .79101 .66212 Mdot .84392 .20391 Mdot .84392 .66212 Mdot 0 .4 1 r .34127 .43301 Mdot .34127 .43301 Mdot .36772 .38719 Mdot .36772 .47883 Mdot .39418 .34137 Mdot .39418 .52466 Mdot .42063 .29555 Mdot .42063 .57048 Mdot .44709 .24973 Mdot .44709 .6163 Mdot .47354 .20391 Mdot .47354 .66212 Mdot .5 .15808 Mdot .5 .70794 Mdot .55291 .15808 Mdot .55291 .70794 Mdot .60582 .15808 Mdot .60582 .70794 Mdot .65873 .15808 Mdot .65873 .70794 Mdot .71164 .15808 Mdot .71164 .70794 Mdot .76455 .15808 Mdot .76455 .70794 Mdot .81746 .15808 Mdot .81746 .70794 Mdot .2 0 1 r .23545 .43301 Mdot .23545 .43301 Mdot .2619 .38719 Mdot .2619 .47883 Mdot .28836 .34137 Mdot .28836 .52466 Mdot .31481 .29555 Mdot .31481 .57048 Mdot .34127 .6163 Mdot .34127 .24973 Mdot .36772 .66212 Mdot .36772 .20391 Mdot .39418 .15808 Mdot .39418 .70794 Mdot .42063 .11226 Mdot .42063 .75376 Mdot .47354 .11226 Mdot .47354 .75376 Mdot .52646 .11226 Mdot .52646 .75376 Mdot .57937 .11226 Mdot .57937 .75376 Mdot .63228 .11226 Mdot .63228 .75376 Mdot .68519 .11226 Mdot .68519 .75376 Mdot .7381 .11226 Mdot .7381 .75376 Mdot .79101 .11226 Mdot .79101 .75376 Mdot .8 0 1 r .12963 .43301 Mdot .12963 .43301 Mdot .15608 .38719 Mdot .15608 .47883 Mdot .18254 .34137 Mdot .18254 .52466 Mdot .20899 .29555 Mdot .20899 .57048 Mdot .23545 .24973 Mdot .23545 .6163 Mdot .2619 .66212 Mdot .2619 .20391 Mdot .28836 .15808 Mdot .28836 .70794 Mdot .31481 .11226 Mdot .31481 .75376 Mdot .34127 .06644 Mdot .34127 .79958 Mdot .39418 .06644 Mdot .39418 .79958 Mdot .44709 .06644 Mdot .44709 .79958 Mdot .5 .06644 Mdot .5 .79958 Mdot .55291 .06644 Mdot .55291 .79958 Mdot .60582 .06644 Mdot .60582 .79958 Mdot .65873 .06644 Mdot .65873 .79958 Mdot .71164 .06644 Mdot .71164 .79958 Mdot .76455 .06644 Mdot .76455 .79958 Mdot 1 0 .6 r .02381 .43301 Mdot .02381 .43301 Mdot .05026 .38719 Mdot .05026 .47883 Mdot .07672 .34137 Mdot .07672 .52466 Mdot .10317 .29555 Mdot .10317 .57048 Mdot .12963 .24973 Mdot .12963 .6163 Mdot .15608 .20391 Mdot .15608 .66212 Mdot .18254 .15808 Mdot .18254 .70794 Mdot .20899 .11226 Mdot .20899 .75376 Mdot .23545 .06644 Mdot .23545 .79958 Mdot .2619 .02062 Mdot .2619 .84541 Mdot .2619 .02062 Mdot .31481 .84541 Mdot .31481 .02062 Mdot .36772 .84541 Mdot .36772 .02062 Mdot .42063 .84541 Mdot .42063 .02062 Mdot .47354 .02062 Mdot .47354 .84541 Mdot .52646 .84541 Mdot .52646 .02062 Mdot .57937 .84541 Mdot .57937 .02062 Mdot .63228 .84541 Mdot .63228 .02062 Mdot .68519 .84541 Mdot .68519 .02062 Mdot .7381 .84541 Mdot .7381 .02062 Mdot % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{102.375, 118.188}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHgOol3O1<8 Ool3I1l8Ool361l8Ool30Il7Ool30ol3Ool30ol2Ool30ol2Ool30ol3Ool30ol2Ool30ol?Ool006Io o`0037oo0g`C1goo0f@O27oo0aPO27oo0`6O27oo0`?o1goo0`?/0goo0`?/0Woo0`?/0Woo0`?/0goo 0`?/37oo000Ool3O1<8Ool3 I1l8Ool361l8Ool30Il7Ool30ol3Ool30ol2Ool30ol2Ool30ol3Ool30ol2Ool30ol?Ool000ioo`=l 4`Qoo`=T7`Qoo`"], ImageRangeCache->{{{0, 101.375}, {117.188, 0}} -> {-17.4501, -10.9241, 0.186438, 0.186438}}] }, Open ]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " code for showing polygonal numbers" }], "Subsection"], Cell[BoxData[ \(verts[n_] := \n\t Table[{Cos[t], Sin[t]}, {t, 0, 1.99 \[Pi], 2 \[Pi]/n}]\)], "Input", InitializationCell->True], Cell[BoxData[ \(dist[{{x1_, y1_}, {x2_, y2_}}] := \@\(\((x1 - x2)\)\^2 + \((y1 - y2)\)\^2\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(angle[{{x1_, y1_}, {x2_, y2_}}] := With[{ang = N[ArcTan[x1 - x2, y1 - y2]]}, \n\t\t If[ang < 0, ang + 2.0 \[Pi], ang]]\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(dots[n_, lvl_] := \n\t Module[{allverts = verts[n], v, angs, ds, \n \t\t\t\ \ \ \ \ \ \ \ \ \ \ \ \ \ rays, forinterp, units}, \n\t\t\ v = Rest[allverts]; \n\t\tds = Map[dist[{{1.0, 0.0}, #}]&, v]; angs = Map[angle[{#, {1.0, 0.0}}]&, v]; rays = lvl*ds*Map[{Cos[#], Sin[#]}&, angs]; rays = Chop@Map[{1, 0} + #&, rays]; \n forinterp = Partition[rays, 2, 1]; \n units = Map[Subtract@@#&, forinterp]/lvl; \n Union[Flatten[ Map[Transpose[#[\([1]\)] + #[\([2]\)]*\n \t\t\t\t\t\t\t\t{Range[0, lvl], Range[0, lvl]}]&, \n \t\t\t\t\tTranspose[{Last/@forinterp, units}]], 1]]\n\t\t]; \)\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(showPolygon[sides_, lvl_] := \n\t Show[Graphics[{PointSize[0.03], Hue[0], Point[{1, 0}], \n\t\t\t\t Table[{Hue[n/lvl], Point/@dots[sides, n]}, {n, 1, lvl - 1}]}], \n \t\tAspectRatio -> Automatic]; \)\)], "Input", InitializationCell->True], Cell[CellGroupData[{ Cell["REFERENCE", "Subsubsection"], Cell[TextData[{ "Maeder, R. E. ", StyleBox["The", FontSlant->"Italic"], " ", StyleBox["Mathematica", FontSlant->"Italic"], " ", StyleBox["Programmer", FontSlant->"Italic"], ". AP Professional, London, 1994" }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["ABOUT THE AUTHOR", "Subsubsection"], Cell[TextData[{ "Robert Dickau is a former member of the technical staff in the ", StyleBox["Mathematica", FontSlant->"Italic"], " Education group at Wolfram Research, Inc., whose four years of experience \ with ", StyleBox["Mathematica", FontSlant->"Italic"], " includes writing and teaching ", StyleBox["Mathematica", FontSlant->"Italic"], " training courses, delivering Mathemtica seminars and demonstrations \ worldwide, and providing technical and marketing support for authors of ", StyleBox["Mathematica-based ", FontSlant->"Italic"], "books, articles, courseware, and packages. He received a Master's degree \ in actuarial science from the University of Illinois and a Bachelor's degree \ in mathematics from California Polytechnic University.\n\nRobert Dickau\n\ pops@prairienet.org" }], "Text"] }, Open ]] }, Open ]] }, Open ]] }, Open ]] }, FrontEndVersion->"NeXT 3.0", ScreenRectangle->{{0, 1053}, {0, 832}}, AutoGeneratedPackage->None, WindowSize->{609, 679}, WindowMargins->{{Automatic, 158}, {Automatic, -4}} ] (*********************************************************************** Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. ***********************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1731, 51, 198, 6, 174, "Title"], Cell[1932, 59, 167, 5, 51, "Subsubtitle"], Cell[CellGroupData[{ Cell[2124, 68, 45, 3, 89, "Subtitle"], Cell[2172, 73, 580, 12, 94, "Text"], Cell[2755, 87, 148, 5, 30, "Text"], Cell[2906, 94, 148, 3, 39, "Input"], Cell[3057, 99, 166, 5, 30, "Text"], Cell[3226, 106, 148, 3, 39, "Input"], Cell[3377, 111, 35, 0, 30, "Text"], Cell[3415, 113, 87, 1, 25, "Input"], Cell[3505, 116, 26, 0, 30, "Text"], Cell[3534, 118, 81, 1, 25, "Input"], Cell[3618, 121, 283, 9, 46, "Text"], Cell[3904, 132, 169, 3, 53, "Input"], Cell[4076, 137, 158, 5, 30, "Text"], Cell[4237, 144, 98, 2, 25, "Input"], Cell[4338, 148, 161, 5, 30, "Text"], Cell[CellGroupData[{ Cell[4524, 157, 72, 1, 25, "Input"], Cell[4599, 160, 580, 13, 72, "Output"] }, Open ]], Cell[5194, 176, 60, 0, 30, "Text"], Cell[5257, 178, 145, 3, 25, "Input"], Cell[5405, 183, 212, 6, 46, "Text"], Cell[CellGroupData[{ Cell[5642, 193, 75, 1, 25, "Input"], Cell[5720, 196, 500, 21, 83, "Output"] }, Open ]], Cell[6235, 220, 286, 7, 46, "Text"], Cell[6524, 229, 156, 3, 52, "Input"], Cell[6683, 234, 54, 0, 30, "Text"], Cell[CellGroupData[{ Cell[6762, 238, 54, 1, 25, "Input"], Cell[6819, 241, 72, 1, 24, "Output"] }, Open ]], Cell[6906, 245, 57, 0, 30, "Text"], Cell[CellGroupData[{ Cell[6988, 249, 54, 1, 25, "Input"], Cell[7045, 252, 75, 1, 24, "Output"] }, Open ]], Cell[7135, 256, 113, 3, 30, "Text"], Cell[7251, 261, 199, 3, 66, "Input"], Cell[CellGroupData[{ Cell[7475, 268, 53, 1, 25, "Input"], Cell[7531, 271, 54, 1, 41, "Output"] }, Open ]], Cell[7600, 275, 106, 3, 30, "Text"], Cell[CellGroupData[{ Cell[7731, 282, 53, 1, 25, "Input"], Cell[7787, 285, 50, 1, 27, "Output"] }, Open ]], Cell[7852, 289, 253, 7, 52, "Text"], Cell[8108, 298, 284, 7, 46, "Text"], Cell[CellGroupData[{ Cell[8417, 309, 56, 1, 25, "Input"], Cell[8476, 312, 3042, 98, 127, 1135, 70, "GraphicsData", "PostScript", "Graphics"] }, Open ]], Cell[11533, 413, 48, 0, 30, "Text"], Cell[CellGroupData[{ Cell[11606, 417, 56, 1, 25, "Input"], Cell[11665, 420, 2780, 95, 127, 1043, 69, "GraphicsData", "PostScript", "Graphics"] }, Open ]], Cell[14460, 518, 52, 0, 30, "Text"], Cell[CellGroupData[{ Cell[14537, 522, 56, 1, 25, "Input"], Cell[14596, 525, 6940, 217, 127, 2841, 162, "GraphicsData", "PostScript", "Graphics"] }, Open ]], Cell[21551, 745, 55, 0, 30, "Text"], Cell[CellGroupData[{ Cell[21631, 749, 57, 1, 25, "Input"], Cell[21691, 752, 10131, 320, 127, 4387, 245, "GraphicsData", "PostScript", "Graphics"] }, Open ]], Cell[CellGroupData[{ Cell[31859, 1077, 125, 4, 43, "Subsection"], Cell[31987, 1083, 141, 3, 37, "Input", InitializationCell->True], Cell[32131, 1088, 143, 3, 35, "Input", InitializationCell->True], Cell[32277, 1093, 195, 4, 53, "Input", InitializationCell->True], Cell[32475, 1099, 767, 15, 204, "Input", InitializationCell->True], Cell[33245, 1116, 288, 5, 66, "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[33558, 1125, 34, 0, 40, "Subsubsection"], Cell[33595, 1127, 244, 11, 30, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[33876, 1143, 41, 0, 40, "Subsubsection"], Cell[33920, 1145, 838, 19, 158, "Text"] }, Open ]] }, Open ]] }, Open ]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)