(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "NeXT Mathematica Notebook Front End Version 2.2"; NeXTStandardFontEncoding; fontset = title, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e8, 24, "Times"; ; fontset = subtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e6, 18, "Times"; ; fontset = subsubtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, L1, e6, 14, "Times"; ; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, L1, a20, 18, "Times"; ; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, L1, a15, 14, "Times"; ; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L1, a12, 12, "Times"; ; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L1, 12, "Courier"; ; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; ; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L1, 12, "Courier"; ; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, L1, 12, "Courier"; ; fontset = name, inactive, noPageBreakInGroup, nohscroll, preserveAspect, M7, italic, B65535, L1, 10, "Times"; ; fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, L1, 12, "Times"; ; fontset = leftheader, 12; fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, italic, L1, 12, "Times"; ; fontset = leftfooter, 12; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12, "Courier"; ; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12; paletteColors = 128; automaticGrouping; currentKernel; ] :[font = title; inactive; preserveAspect; startGroup] Programming with Mathematica ;[s] 2:0,0;17,1;28,-1; 2:1,21,16,Times,1,24,0,0,0;1,22,17,Times,3,24,0,0,0; :[font = subtitle; inactive; preserveAspect; plain; bold; italic; fontName = "Times"] Mathematica Days University of Michigan Ann Arbor, Michigan 11 Sept 93 and Boston University Boston, Massachusetts 18 Sept 93 ;[s] 4:0,0;11,1;73,2;77,3;129,-1; 4:1,17,13,Times,3,18,0,0,0;1,16,12,Times,1,18,0,0,0;1,16,12,Times,0,18,0,0,0;1,16,12,Times,1,18,0,0,0; :[font = subsubtitle; inactive; preserveAspect; plain; fontName = "Times"] Paul Wellin Department of Mathematics Sonoma State University Rohnert Park, CA 94928 USA wellin@sonoma.edu :[font = section; inactive; Cclosed; preserveAspect; startGroup] 1 Examples :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1.1 Mean and Variance :[font = input; preserveAspect] mean[p_] := Apply[Plus, p] / Length[p] :[font = input; preserveAspect] variance[p_] := mean[ (p - mean[p])^2 ] :[font = input; preserveAspect] data = Table[Random[Integer, {1, 100}], {1000}]; :[font = input; Cclosed; preserveAspect; startGroup] mean[data] //N :[font = output; output; inactive; preserveAspect; endGroup] 50.05200000000001 ;[o] 50.052 :[font = input; Cclosed; preserveAspect; startGroup] variance[data] //N :[font = output; output; inactive; preserveAspect; endGroup; endGroup] 862.849296 ;[o] 862.849 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1.2 Harmonic Numbers :[font = input; preserveAspect] harmonic[n_] := Sum[1/j, {j, 1, n}] :[font = input; Cclosed; preserveAspect; startGroup] harmonic[100] :[font = output; output; inactive; preserveAspect; endGroup] 14466636279520351160221518043104131447711/ 2788815009188499086581352357412492142272 ;[o] 14466636279520351160221518043104131447711 ----------------------------------------- 2788815009188499086581352357412492142272 :[font = input; Cclosed; preserveAspect; startGroup] N[%] :[font = output; output; inactive; preserveAspect; endGroup] 5.187377517639621 ;[o] 5.18738 :[font = input; Cclosed; preserveAspect; startGroup] harmonic[1000] :[font = output; output; inactive; preserveAspect; endGroup] 533629132822947850455910456240429804096524722803842600\ 971013492484562688894971017575060979019850356914090\ 887315504680983784421721178850094643023443265660225\ 021002784256328520814055449412104425101426727702947\ 747127089179639677796104532246924268664688882815820\ 719848971051107968732493191555293970175089315645199\ 760857344730141832840117244122806490743077037366831\ 700558002936592350885893602352858528081607595747378\ 36655413175508131522517/ 7128865274665093053166384155714272920668358861885893\ 040452001991154324087581111499476444151913871586911\ 717817019575256512980264067621009251465871004305131\ 072686268143200196609974862745937188343705015434452\ 523739745298963145674982128236956232823794011068809\ 262317708861979540791247754558049326475737829923352\ 751796735248042463638051137034331214781746850878453\ 485678021888075373249921995672056932029099390891687\ 487672697950931603520000 ;[o] 533629132822947850455910456240429804096524722803842600\ 971013492484562688894971017575060979019850356914090\ 887315504680983784421721178850094643023443265660225\ 021002784256328520814055449412104425101426727702947\ 747127089179639677796104532246924268664688882815820\ 719848971051107968732493191555293970175089315645199\ 760857344730141832840117244122806490743077037366831\ 700558002936592350885893602352858528081607595747378\ 36655413175508131522517 / 7128865274665093053166384155714272920668358861885893\ 040452001991154324087581111499476444151913871586911\ 717817019575256512980264067621009251465871004305131\ 072686268143200196609974862745937188343705015434452\ 523739745298963145674982128236956232823794011068809\ 262317708861979540791247754558049326475737829923352\ 751796735248042463638051137034331214781746850878453\ 485678021888075373249921995672056932029099390891687\ 487672697950931603520000 :[font = input; Cclosed; preserveAspect; startGroup] N[%] :[font = output; output; inactive; preserveAspect; endGroup] 7.485470860550345 ;[o] 7.48547 :[font = input; preserveAspect] harmonic[10^4] :[font = input; preserveAspect] nHarmonic[n_] := NSum[1/j, {j, 1, n}] :[font = input; Cclosed; preserveAspect; startGroup] nHarmonic[10^4] :[font = output; output; inactive; preserveAspect; endGroup] 9.78760603580882 ;[o] 9.78761 :[font = input; Cclosed; preserveAspect; startGroup] nHarmonic[10^12] :[font = output; output; inactive; preserveAspect; endGroup] 28.20823678059502 ;[o] 28.2082 :[font = input; Cclosed; preserveAspect; startGroup] nHarmonic[10^15] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] 35.11599205957665 ;[o] 35.116 :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1.3 Perfect Numbers :[font = text; inactive; preserveAspect] Perfect numbers are defined as those numbers equal to the sum of their "proper" divisors. :[font = input; Cclosed; preserveAspect; startGroup] Divisors[6] :[font = output; output; inactive; preserveAspect; endGroup] {1, 2, 3, 6} ;[o] {1, 2, 3, 6} :[font = input; Cclosed; preserveAspect; startGroup] Drop[Divisors[6], -1] :[font = output; output; inactive; preserveAspect; endGroup] {1, 2, 3} ;[o] {1, 2, 3} :[font = input; Cclosed; preserveAspect; startGroup] Apply[Plus, %] :[font = output; output; inactive; preserveAspect; endGroup] 6 ;[o] 6 :[font = input; preserveAspect] perfectQ[n_] := Apply[Plus, Divisors[n]] == 2n :[font = input; Cclosed; preserveAspect; startGroup] perfectQ[6] :[font = output; output; inactive; preserveAspect; endGroup] True ;[o] True :[font = input; Cclosed; preserveAspect; startGroup] perfectQ[7] :[font = output; output; inactive; preserveAspect; endGroup] False ;[o] False :[font = input; Cclosed; preserveAspect; startGroup] Trace[perfectQ[7]] :[font = output; output; inactive; preserveAspect; endGroup] {HoldForm[perfectQ[7]], HoldForm[Apply[Plus, Divisors[7]] == 2*7], {{HoldForm[Divisors[7]], HoldForm[{1, 7}]}, HoldForm[Apply[Plus, {1, 7}]], HoldForm[1 + 7], HoldForm[8]}, {HoldForm[2*7], HoldForm[14]}, HoldForm[8 == 14], HoldForm[False]} ;[o] {perfectQ[7], Apply[Plus, Divisors[7]] == 2 7, {{Divisors[7], {1, 7}}, Apply[Plus, {1, 7}], 1 + 7, 8}, {2 7, 14}, 8 == 14, False} :[font = input; Cclosed; preserveAspect; startGroup] TracePrint[perfectQ[7]] :[font = print; inactive; preserveAspect] perfectQ[7] perfectQ 7 Apply[Plus, Divisors[7]] == 2 7 Equal Apply[Plus, Divisors[7]] Apply Plus Divisors[7] Divisors 7 {1, 7} List 1 7 Apply[Plus, {1, 7}] 1 + 7 Plus 1 7 8 2 7 Times 2 7 14 8 == 14 False :[font = output; output; inactive; preserveAspect; endGroup] False ;[o] False :[font = input; preserveAspect] perfect[n_] := Select[Range[n], perfectQ] :[font = input; Cclosed; preserveAspect; startGroup] perfect[500] :[font = output; output; inactive; preserveAspect; endGroup] {6, 28, 496} ;[o] {6, 28, 496} :[font = text; inactive; preserveAspect] The following function makes an assumption about perfect numbers which is as yet, unproven: that there are no odd perfect numbers. It is known there are none below 10^300. :[font = input; preserveAspect] perfect2[n_?EvenQ, m_] := Select[Range[n,m,2], perfectQ] :[font = input; Cclosed; preserveAspect; startGroup] perfect2[3, 500] :[font = output; output; inactive; preserveAspect; endGroup] Perfect2[3, 500] ;[o] Perfect2[3, 500] :[font = input; Cclosed; preserveAspect; startGroup] perfect2[2, 500] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] {6, 28, 496} ;[o] {6, 28, 496} :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1.4 Root Plotting :[font = input; preserveAspect] plotRoots[poly_, z_, opts___] := ListPlot[{Re[z], Im[z]} /. NSolve[poly == 0, z], PlotStyle -> {PointSize[.02], RGBColor[1,0,0]}, opts] :[font = input; Cclosed; preserveAspect; startGroup] p5 = x^5 - 1 :[font = output; output; inactive; preserveAspect; endGroup] -1 + x^5 ;[o] 5 -1 + x :[font = input; Cclosed; preserveAspect; startGroup] plotRoots[p5, x] :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 282; pictureHeight = 174] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.449727 0.526463 0.309017 0.309447 [ [(-0.75)] .05488 .30902 0 2 Msboxa [(-0.5)] .1865 .30902 0 2 Msboxa [(-0.25)] .31811 .30902 0 2 Msboxa [(0.25)] .58134 .30902 0 2 Msboxa [(0.5)] .71296 .30902 0 2 Msboxa [(0.75)] .84457 .30902 0 2 Msboxa [(1)] .97619 .30902 0 2 Msboxa [(-0.75)] .43723 .07693 1 0 Msboxa [(-0.5)] .43723 .15429 1 0 Msboxa [(-0.25)] .43723 .23166 1 0 Msboxa [(0.25)] .43723 .38638 1 0 Msboxa [(0.5)] .43723 .46374 1 0 Msboxa [(0.75)] .43723 .5411 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .05488 .30902 m .05488 .31527 L s P [(-0.75)] .05488 .30902 0 2 Mshowa p .002 w .1865 .30902 m .1865 .31527 L s P [(-0.5)] .1865 .30902 0 2 Mshowa p .002 w .31811 .30902 m .31811 .31527 L s P [(-0.25)] .31811 .30902 0 2 Mshowa p .002 w .58134 .30902 m .58134 .31527 L s P [(0.25)] .58134 .30902 0 2 Mshowa p .002 w .71296 .30902 m .71296 .31527 L s P [(0.5)] .71296 .30902 0 2 Mshowa p .002 w .84457 .30902 m .84457 .31527 L s P [(0.75)] .84457 .30902 0 2 Mshowa p .002 w .97619 .30902 m .97619 .31527 L s P [(1)] .97619 .30902 0 2 Mshowa p .001 w .0812 .30902 m .0812 .31277 L s P p .001 w .10753 .30902 m .10753 .31277 L s P p .001 w .13385 .30902 m .13385 .31277 L s P p .001 w .16017 .30902 m .16017 .31277 L s P p .001 w .21282 .30902 m .21282 .31277 L s P p .001 w .23914 .30902 m .23914 .31277 L s P p .001 w .26547 .30902 m .26547 .31277 L s P p .001 w .29179 .30902 m .29179 .31277 L s P p .001 w .34443 .30902 m .34443 .31277 L s P p .001 w .37076 .30902 m .37076 .31277 L s P p .001 w .39708 .30902 m .39708 .31277 L s P p .001 w .4234 .30902 m .4234 .31277 L s P p .001 w .47605 .30902 m .47605 .31277 L s P p .001 w .50237 .30902 m .50237 .31277 L s P p .001 w .5287 .30902 m .5287 .31277 L s P p .001 w .55502 .30902 m .55502 .31277 L s P p .001 w .60767 .30902 m .60767 .31277 L s P p .001 w .63399 .30902 m .63399 .31277 L s P p .001 w .66031 .30902 m .66031 .31277 L s P p .001 w .68664 .30902 m .68664 .31277 L s P p .001 w .73928 .30902 m .73928 .31277 L s P p .001 w .76561 .30902 m .76561 .31277 L s P p .001 w .79193 .30902 m .79193 .31277 L s P p .001 w .81825 .30902 m .81825 .31277 L s P p .001 w .8709 .30902 m .8709 .31277 L s P p .001 w .89722 .30902 m .89722 .31277 L s P p .001 w .92354 .30902 m .92354 .31277 L s P p .001 w .94987 .30902 m .94987 .31277 L s P p .001 w .02856 .30902 m .02856 .31277 L s P p .001 w .00223 .30902 m .00223 .31277 L s P p .002 w 0 .30902 m 1 .30902 L s P p .002 w .44973 .07693 m .45598 .07693 L s P [(-0.75)] .43723 .07693 1 0 Mshowa p .002 w .44973 .15429 m .45598 .15429 L s P [(-0.5)] .43723 .15429 1 0 Mshowa p .002 w .44973 .23166 m .45598 .23166 L s P [(-0.25)] .43723 .23166 1 0 Mshowa p .002 w .44973 .38638 m .45598 .38638 L s P [(0.25)] .43723 .38638 1 0 Mshowa p .002 w .44973 .46374 m .45598 .46374 L s P [(0.5)] .43723 .46374 1 0 Mshowa p .002 w .44973 .5411 m .45598 .5411 L s P [(0.75)] .43723 .5411 1 0 Mshowa p .001 w .44973 .01504 m .45348 .01504 L s P p .001 w .44973 .03051 m .45348 .03051 L s P p .001 w .44973 .04599 m .45348 .04599 L s P p .001 w .44973 .06146 m .45348 .06146 L s P p .001 w .44973 .0924 m .45348 .0924 L s P p .001 w .44973 .10788 m .45348 .10788 L s P p .001 w .44973 .12335 m .45348 .12335 L s P p .001 w .44973 .13882 m .45348 .13882 L s P p .001 w .44973 .16977 m .45348 .16977 L s P p .001 w .44973 .18524 m .45348 .18524 L s P p .001 w .44973 .20071 m .45348 .20071 L s P p .001 w .44973 .21618 m .45348 .21618 L s P p .001 w .44973 .24713 m .45348 .24713 L s P p .001 w .44973 .2626 m .45348 .2626 L s P p .001 w .44973 .27807 m .45348 .27807 L s P p .001 w .44973 .29354 m .45348 .29354 L s P p .001 w .44973 .32449 m .45348 .32449 L s P p .001 w .44973 .33996 m .45348 .33996 L s P p .001 w .44973 .35543 m .45348 .35543 L s P p .001 w .44973 .37091 m .45348 .37091 L s P p .001 w .44973 .40185 m .45348 .40185 L s P p .001 w .44973 .41732 m .45348 .41732 L s P p .001 w .44973 .4328 m .45348 .4328 L s P p .001 w .44973 .44827 m .45348 .44827 L s P p .001 w .44973 .47921 m .45348 .47921 L s P p .001 w .44973 .49469 m .45348 .49469 L s P p .001 w .44973 .51016 m .45348 .51016 L s P p .001 w .44973 .52563 m .45348 .52563 L s P p .001 w .44973 .55657 m .45348 .55657 L s P p .001 w .44973 .57205 m .45348 .57205 L s P p .001 w .44973 .58752 m .45348 .58752 L s P p .001 w .44973 .60299 m .45348 .60299 L s P p .002 w .44973 0 m .44973 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p 1 0 0 r p .02 w .97619 .30902 Mdot .02381 .12713 Mdot .61241 .60332 Mdot .61241 .01472 Mdot .02381 .49091 Mdot P P % End of Graphics MathPictureEnd :[font = output; output; inactive; preserveAspect; endGroup] Graphics["<<>>"] ;[o] -Graphics- :[font = input; preserveAspect] p[n_] := Apply[Plus, Table[z^j, {j, 0, n}]] :[font = input; Cclosed; preserveAspect; startGroup] p[2] :[font = output; output; inactive; preserveAspect; endGroup] 1 + z + z^2 ;[o] 2 1 + z + z :[font = input; Cclosed; preserveAspect; startGroup] Do[ plotRoots[p[i], z, Axes->False, AspectRatio->Automatic], {i,20}]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; Cclosed; preserveAspect; pictureLeft = 34; pictureWidth = 221; pictureHeight = 221; startGroup; infiniteLoop; loopDistance = 1] %! %%Creator: Mathematica %%AspectRatio: 1 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 1.452381 0.952381 0.5 0.952381 [ [ 0 0 0 0 ] [ 1 1 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P .02381 0 m .97619 0 L .97619 1 L .02381 1 L closepath clip newpath p 1 0 0 r p .02 w .5 .5 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 119; pictureHeight = 412] %! %%Creator: Mathematica %%AspectRatio: 3.4641 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 1.452381 1.904762 1.732051 1.904762 [ [ 0 0 0 0 ] [ 1 3.4641 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 3.4641 L 0 3.4641 L closepath clip newpath p 1 0 0 r p .02 w .5 .08248 Mdot .5 3.38162 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 156; pictureHeight = 313] %! %%Creator: Mathematica %%AspectRatio: 2 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.97619 0.952381 1 0.952381 [ [ 0 0 0 0 ] [ 1 2 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 2 L 0 2 L closepath clip newpath p 1 0 0 r p .02 w .02381 1 Mdot .97619 .04762 Mdot .97619 1.95238 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 169; pictureHeight = 289] %! %%Creator: Mathematica %%AspectRatio: 1.7013 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.712959 0.851835 0.850651 0.851835 [ [ 0 0 0 0 ] [ 1 1.7013 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.7013 L 0 1.7013 L closepath clip newpath p 1 0 0 r p .02 w .02381 .34995 Mdot .02381 1.35135 Mdot .97619 .04051 Mdot .97619 1.66079 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 206; pictureHeight = 238] %! %%Creator: Mathematica %%AspectRatio: 1.1547 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.65873 0.634921 0.57735 0.634921 [ [ 0 0 0 0 ] [ 1 1.1547 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.1547 L 0 1.1547 L closepath clip newpath p 1 0 0 r p .02 w .02381 .57735 Mdot .34127 .02749 Mdot .34127 1.12721 Mdot .97619 .02749 Mdot .97619 1.12721 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 196; pictureHeight = 250] %! %%Creator: Mathematica %%AspectRatio: 1.27905 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.586675 0.624734 0.639524 0.624734 [ [ 0 0 0 0 ] [ 1 1.27905 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.27905 L 0 1.27905 L closepath clip newpath p 1 0 0 r p .02 w .02381 .36846 Mdot .02381 .91059 Mdot .44766 .03045 Mdot .44766 1.24859 Mdot .97619 .15109 Mdot .97619 1.12796 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 204; pictureHeight = 239] %! %%Creator: Mathematica %%AspectRatio: 1.17157 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.581701 0.557892 0.585786 0.557892 [ [ 0 0 0 0 ] [ 1 1.17157 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.17157 L 0 1.17157 L closepath clip newpath p 1 0 0 r p .02 w .02381 .58579 Mdot .18721 .1913 Mdot .18721 .98028 Mdot .5817 .02789 Mdot .5817 1.14368 Mdot .97619 .1913 Mdot .97619 .98028 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 206; pictureHeight = 238] %! %%Creator: Mathematica %%AspectRatio: 1.1547 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.548477 0.55834 0.57735 0.55834 [ [ 0 0 0 0 ] [ 1 1.1547 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.1547 L 0 1.1547 L closepath clip newpath p 1 0 0 r p .02 w .02381 .38639 Mdot .02381 .76831 Mdot .26931 .09381 Mdot .26931 1.06089 Mdot .64543 .02749 Mdot .64543 1.12721 Mdot .97619 .21846 Mdot .97619 .93624 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 216; pictureHeight = 227] %! %%Creator: Mathematica %%AspectRatio: 1.05146 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.550273 0.526463 0.525731 0.526463 [ [ 0 0 0 0 ] [ 1 1.05146 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.05146 L 0 1.05146 L closepath clip newpath p 1 0 0 r p .02 w .02381 .52573 Mdot .12436 .21628 Mdot .12436 .83518 Mdot .38759 .02503 Mdot .38759 1.02643 Mdot .71296 .02503 Mdot .71296 1.02643 Mdot .97619 .21628 Mdot .97619 .83518 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 211; pictureHeight = 232] %! %%Creator: Mathematica %%AspectRatio: 1.09935 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.531267 0.528881 0.549673 0.528881 [ [ 0 0 0 0 ] [ 1 1.09935 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.09935 L 0 1.09935 L closepath clip newpath p 1 0 0 r p .02 w .02381 .40067 Mdot .02381 .69868 Mdot .18492 .14997 Mdot .18492 .94937 Mdot .456 .02617 Mdot .456 1.07317 Mdot .75097 .06859 Mdot .75097 1.03076 Mdot .97619 .26374 Mdot .97619 .83561 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 214; pictureHeight = 229] %! %%Creator: Mathematica %%AspectRatio: 1.0718 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.534189 0.510379 0.535898 0.510379 [ [ 0 0 0 0 ] [ 1 1.0718 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.0718 L 0 1.0718 L closepath clip newpath p 1 0 0 r p .02 w .02381 .5359 Mdot .09219 .28071 Mdot .09219 .79109 Mdot .279 .0939 Mdot .279 .9779 Mdot .53419 .02552 Mdot .53419 1.04628 Mdot .78938 .0939 Mdot .78938 .9779 Mdot .97619 .28071 Mdot .97619 .79109 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 214; pictureHeight = 229] %! %%Creator: Mathematica %%AspectRatio: 1.0695 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.521928 0.513026 0.53475 0.513026 [ [ 0 0 0 0 ] [ 1 1.0695 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.0695 L 0 1.0695 L closepath clip newpath p 1 0 0 r p .02 w .02381 .41197 Mdot .02381 .65753 Mdot .13792 .19455 Mdot .13792 .87495 Mdot .34001 .05506 Mdot .34001 1.01444 Mdot .58377 .02546 Mdot .58377 1.04404 Mdot .81336 .11254 Mdot .81336 .95696 Mdot .97619 .29633 Mdot .97619 .77317 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 218; pictureHeight = 224] %! %%Creator: Mathematica %%AspectRatio: 1.02572 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.524807 0.500998 0.512858 0.500998 [ [ 0 0 0 0 ] [ 1 1.02572 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.02572 L 0 1.02572 L closepath clip newpath p 1 0 0 r p .02 w .02381 .51286 Mdot .07342 .29548 Mdot .07342 .73023 Mdot .21244 .12116 Mdot .21244 .90455 Mdot .41332 .02442 Mdot .41332 1.0013 Mdot .63629 .02442 Mdot .63629 1.0013 Mdot .83717 .12116 Mdot .83717 .90455 Mdot .97619 .29548 Mdot .97619 .73023 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 216; pictureHeight = 227] %! %%Creator: Mathematica %%AspectRatio: 1.05146 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.516262 0.503454 0.525731 0.503454 [ [ 0 0 0 0 ] [ 1 1.05146 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.05146 L 0 1.05146 L closepath clip newpath p 1 0 0 r p .02 w .02381 .42106 Mdot .02381 .63041 Mdot .10896 .22981 Mdot .10896 .82165 Mdot .26453 .08973 Mdot .26453 .96174 Mdot .46364 .02503 Mdot .46364 1.02643 Mdot .67184 .04692 Mdot .67184 1.00454 Mdot .85314 .15159 Mdot .85314 .89987 Mdot .97619 .32096 Mdot .97619 .7305 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 217; pictureHeight = 226] %! %%Creator: Mathematica %%AspectRatio: 1.03957 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.518841 0.495031 0.519783 0.495031 [ [ 0 0 0 0 ] [ 1 1.03957 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.03957 L 0 1.03957 L closepath clip newpath p 1 0 0 r p .02 w .02381 .51978 Mdot .06149 .33034 Mdot .06149 .70922 Mdot .1688 .16974 Mdot .1688 .86982 Mdot .3294 .06243 Mdot .3294 .97713 Mdot .51884 .02475 Mdot .51884 1.01481 Mdot .70828 .06243 Mdot .70828 .97713 Mdot .86888 .16974 Mdot .86888 .86982 Mdot .97619 .33034 Mdot .97619 .70922 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 217; pictureHeight = 226] %! %%Creator: Mathematica %%AspectRatio: 1.03969 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.512555 0.497211 0.519845 0.497211 [ [ 0 0 0 0 ] [ 1 1.03969 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.03969 L 0 1.03969 L closepath clip newpath p 1 0 0 r p .02 w .02381 .42848 Mdot .02381 .61121 Mdot .08982 .2581 Mdot .08982 .78159 Mdot .21292 .12306 Mdot .21292 .91663 Mdot .37649 .04161 Mdot .37649 .99808 Mdot .55843 .02475 Mdot .55843 1.01493 Mdot .73418 .07476 Mdot .73418 .96493 Mdot .88 .18488 Mdot .88 .85481 Mdot .97619 .34023 Mdot .97619 .69946 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 220; pictureHeight = 223] %! %%Creator: Mathematica %%AspectRatio: 1.01543 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.514805 0.490996 0.507713 0.490996 [ [ 0 0 0 0 ] [ 1 1.01543 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.01543 L 0 1.01543 L closepath clip newpath p 1 0 0 r p .02 w .02381 .50771 Mdot .05342 .33978 Mdot .05342 .67564 Mdot .13868 .19211 Mdot .13868 .82332 Mdot .26931 .0825 Mdot .26931 .93293 Mdot .42954 .02418 Mdot .42954 .99125 Mdot .60007 .02418 Mdot .60007 .99125 Mdot .7603 .0825 Mdot .7603 .93293 Mdot .89093 .19211 Mdot .89093 .82332 Mdot .97619 .33978 Mdot .97619 .67564 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 218; pictureHeight = 225] %! %%Creator: Mathematica %%AspectRatio: 1.03157 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.509992 0.492905 0.515783 0.492905 [ [ 0 0 0 0 ] [ 1 1.03157 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.03157 L 0 1.03157 L closepath clip newpath p 1 0 0 r p .02 w .02381 .43465 Mdot .02381 .59691 Mdot .07649 .28119 Mdot .07649 .75038 Mdot .17616 .15314 Mdot .17616 .87842 Mdot .31199 .06439 Mdot .31199 .96717 Mdot .46929 .02456 Mdot .46929 1.007 Mdot .63099 .03796 Mdot .63099 .99361 Mdot .77959 .10314 Mdot .77959 .92843 Mdot .89896 .21303 Mdot .89896 .81853 Mdot .97619 .35574 Mdot .97619 .67583 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 218; pictureHeight = 224] %! %%Creator: Mathematica %%AspectRatio: 1.02509 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.511946 0.488136 0.512543 0.488136 [ [ 0 0 0 0 ] [ 1 1.02509 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.02509 L 0 1.02509 L closepath clip newpath p 1 0 0 r p .02 w .02381 .51254 Mdot .0477 .3617 Mdot .0477 .66339 Mdot .11704 .22562 Mdot .11704 .79946 Mdot .22503 .11763 Mdot .22503 .90745 Mdot .3611 .0483 Mdot .3611 .97679 Mdot .51195 .02441 Mdot .51195 1.00068 Mdot .66279 .0483 Mdot .66279 .97679 Mdot .79886 .11763 Mdot .79886 .90745 Mdot .90686 .22562 Mdot .90686 .79946 Mdot .97619 .3617 Mdot .97619 .66339 Mdot P P % End of Graphics MathPictureEnd :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 218; pictureHeight = 224; endGroup; endGroup; endGroup; infiniteLoop; loopDistance = -1] %! %%Creator: Mathematica %%AspectRatio: 1.02572 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.508145 0.489806 0.512858 0.489806 [ [ 0 0 0 0 ] [ 1 1.02572 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 1.02572 L 0 1.02572 L closepath clip newpath p 1 0 0 r p .02 w .02381 .43986 Mdot .02381 .58586 Mdot .06684 .30034 Mdot .06684 .72538 Mdot .14909 .17971 Mdot .14909 .84601 Mdot .26324 .08867 Mdot .26324 .93704 Mdot .39915 .03533 Mdot .39915 .99038 Mdot .54475 .02442 Mdot .54475 1.0013 Mdot .68709 .05691 Mdot .68709 .96881 Mdot .81353 .12991 Mdot .81353 .8958 Mdot .91284 .23694 Mdot .91284 .78878 Mdot .97619 .36849 Mdot .97619 .65723 Mdot P P % End of Graphics MathPictureEnd :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1.5 CardDeck :[font = input; Cclosed; preserveAspect; startGroup] deck = Flatten[Outer[List, {c,d,h,s}, Join[Range[2, 10], {J,Q,K,A}]], 1] :[font = output; output; inactive; preserveAspect; endGroup] {{c, 2}, {c, 3}, {c, 4}, {c, 5}, {c, 6}, {c, 7}, {c, 8}, {c, 9}, {c, 10}, {c, J}, {c, Q}, {c, K}, {c, A}, {d, 2}, {d, 3}, {d, 4}, {d, 5}, {d, 6}, {d, 7}, {d, 8}, {d, 9}, {d, 10}, {d, J}, {d, Q}, {d, K}, {d, A}, {h, 2}, {h, 3}, {h, 4}, {h, 5}, {h, 6}, {h, 7}, {h, 8}, {h, 9}, {h, 10}, {h, J}, {h, Q}, {h, K}, {h, A}, {s, 2}, {s, 3}, {s, 4}, {s, 5}, {s, 6}, {s, 7}, {s, 8}, {s, 9}, {s, 10}, {s, J}, {s, Q}, {s, K}, {s, A}} ;[o] {{c, 2}, {c, 3}, {c, 4}, {c, 5}, {c, 6}, {c, 7}, {c, 8}, {c, 9}, {c, 10}, {c, J}, {c, Q}, {c, K}, {c, A}, {d, 2}, {d, 3}, {d, 4}, {d, 5}, {d, 6}, {d, 7}, {d, 8}, {d, 9}, {d, 10}, {d, J}, {d, Q}, {d, K}, {d, A}, {h, 2}, {h, 3}, {h, 4}, {h, 5}, {h, 6}, {h, 7}, {h, 8}, {h, 9}, {h, 10}, {h, J}, {h, Q}, {h, K}, {h, A}, {s, 2}, {s, 3}, {s, 4}, {s, 5}, {s, 6}, {s, 7}, {s, 8}, {s, 9}, {s, 10}, {s, J}, {s, Q}, {s, K}, {s, A}} :[font = input; preserveAspect] removeRand[lis_] := Delete[lis, Random[Integer, {1, Length[lis]}]] :[font = input; preserveAspect] deal[n_] := Complement[deck, Nest[removeRand, deck, n]] :[font = input; Cclosed; preserveAspect; startGroup] deal[5] :[font = output; output; inactive; preserveAspect; endGroup] {{c, 2}, {c, J}, {d, 8}, {d, J}, {h, Q}} ;[o] {{c, 2}, {c, J}, {d, 8}, {d, J}, {h, Q}} :[font = input; preserveAspect] deal[n_] := (deck = Flatten[Outer[List, {c,d,h,s}, Join[Range[2, 10], {J,Q,K,A}]],1]; removeRand[lis_] := Delete[lis, Random[Integer, {1, Length[lis]}]]; Complement[deck, Nest[removeRand, deck, n]] ) :[font = input; Cclosed; preserveAspect; startGroup] deal[5] :[font = output; output; inactive; preserveAspect; endGroup] {{c, 3}, {c, A}, {c, J}, {h, 3}, {h, J}} ;[o] {{c, 3}, {c, A}, {c, J}, {h, 3}, {h, J}} :[font = input; preserveAspect] deal[n_] := Module[{deck, removeRand}, deck = Flatten[Outer[List, {c,d,h,s}, Join[Range[2, 10], {J,Q,K,A}]],1]; removeRand[lis_] := Delete[lis, Random[Integer, {1, Length[lis]}]]; Complement[deck, Nest[removeRand, deck, n]] ] :[font = input; Cclosed; preserveAspect; startGroup] deal[5] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] {{c, 9}, {c, 10}, {d, 6}, {s, 6}, {s, 8}} ;[o] {{c, 9}, {c, 10}, {d, 6}, {s, 6}, {s, 8}} :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 1.6 Koch Snowflake (Michael Trott) :[font = input; preserveAspect] startdreieck = { {{-1,0},{1,0}} , {{1,0},{0,Sqrt[3]}}, {{0,Sqrt[3]},{-1,0}} } // N :[font = input; preserveAspect] EckedranDeterministisch[line_List]:= Module[{d,norm,senk}, d = line[[2]]-line[[1]]; norm = Sqrt[d.d]; senk = {d[[2]],-d[[1]]}; { {line[[1]], line[[1]]+d/3}, {line[[1]] + d/3, line[[1]] + d/2 + senk/norm Sqrt[3] norm/6}, {line[[1]] + d/2 + senk/norm Sqrt[3] norm/6, line[[1]] + 2d/3}, {line[[1]] + 2d/3,line[[2]]}} //N ] :[font = input; preserveAspect] st[1] = startdreieck; Do[st[i] = Flatten[ EckedranDeterministisch /@ st[i-1], 1], {i,2,5}] :[font = input; preserveAspect; startGroup] Show[Graphics[ Table[{Hue[0.8 (i-1)/5], Polygon[(i (#-{0,1/Sqrt[3]}) )&/@ (#[[1]]& /@ Partition[Drop[Append[ hg=Flatten[st[i],1], hg[[1]] ],1],2]) ]}, {i,4,1,-1}] ], AspectRatio->Automatic] :[font = output; output; inactive; preserveAspect; endGroup; endGroup; endGroup] Graphics["<<>>"] ;[o] -Graphics- :[font = section; inactive; Cclosed; preserveAspect; startGroup] 2 Recursive Programming :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 2.1 Simple sum function :[font = input; preserveAspect] sum[n_] := sum[n-1] + n sum[0] = 0 :[font = input; Cclosed; preserveAspect; startGroup] sum[2] :[font = output; output; inactive; preserveAspect; endGroup] 3 ;[o] 3 :[font = input; Cclosed; preserveAspect; startGroup] Table[sum[j], {j,20}] :[font = output; output; inactive; preserveAspect; endGroup] {1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136, 153, 171, 190, 210} ;[o] {1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136, 153, 171, 190, 210} :[font = input; Cclosed; preserveAspect; startGroup] Table[Sum[j, {j,1,i}], {i,20}] :[font = output; output; inactive; preserveAspect; endGroup] {1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136, 153, 171, 190, 210} ;[o] {1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136, 153, 171, 190, 210} :[font = input; Cclosed; preserveAspect; startGroup] Map[sum, Range[20]] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] {1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136, 153, 171, 190, 210} ;[o] {1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120, 136, 153, 171, 190, 210} :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 2.2 Fibonacci numbers and dynamic programming :[font = input; preserveAspect] fib[n_] := fib[n-1] + fib[n-2] :[font = input; preserveAspect] fib[1] = fib[2] = 1; :[font = input; Cclosed; preserveAspect; startGroup] ?fib :[font = print; inactive; preserveAspect; endGroup] Global`fib fib[1] = 1 fib[2] = 1 fib[n_] := fib[n - 1] + fib[n - 2] :[font = input; Cclosed; preserveAspect; startGroup] Table[fib[j], {j, 15}] :[font = output; output; inactive; preserveAspect; endGroup] {1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610} ;[o] {1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610} :[font = input; Cclosed; preserveAspect; startGroup] ?fib :[font = print; inactive; preserveAspect; endGroup] Global`fib fib[1] = 1 fib[2] = 1 fib[n_] := fib[n - 1] + fib[n - 2] :[font = input; preserveAspect] fib2[n_] := fib2[n] = fib2[n-1] + fib2[n-2] fib2[1] = fib2[2] = 1; :[font = input; Cclosed; preserveAspect; startGroup] ?fib2 :[font = print; inactive; preserveAspect; endGroup] Global`fib2 fib2[1] = 1 fib2[2] = 1 fib2[n_] := fib2[n] = fib2[n - 1] + fib2[n - 2] :[font = input; Cclosed; preserveAspect; startGroup] Table[fib2[j], {j,12}] :[font = output; output; inactive; preserveAspect; endGroup] {1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144} ;[o] {1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144} :[font = input; Cclosed; preserveAspect; startGroup] ?fib2 :[font = print; inactive; preserveAspect; endGroup] Global`fib2 fib2[1] = 1 fib2[2] = 1 fib2[3] = 2 fib2[4] = 3 fib2[5] = 5 fib2[6] = 8 fib2[7] = 13 fib2[8] = 21 fib2[9] = 34 fib2[10] = 55 fib2[11] = 89 fib2[12] = 144 fib2[n_] := fib2[n] = fib2[n - 1] + fib2[n - 2] :[font = input; Cclosed; preserveAspect; startGroup] fib2[500] :[font = message; inactive; preserveAspect] $RecursionLimit::reclim: Recursion depth of 256 exceeded. :[font = message; inactive; preserveAspect] $RecursionLimit::reclim: Recursion depth of 256 exceeded. :[font = message; inactive; preserveAspect] $RecursionLimit::reclim: Recursion depth of 256 exceeded. :[font = message; inactive; preserveAspect] General::stop: Further output of $RecursionLimit::reclim will be suppressed during this calculation. :[font = output; output; inactive; preserveAspect; endGroup] 36726740705505779255899443*Hold[fib2[375 - 2]] + 59425114757512643212875125*Hold[fib2[376 - 2]] + 36726740705505779255899443*Hold[fib2[375 - 1]] + 59425114757512643212875125*Hold[fib2[376 - 1]] ;[o] 36726740705505779255899443 Hold[fib2[375 - 2]] + 59425114757512643212875125 Hold[fib2[376 - 2]] + 36726740705505779255899443 Hold[fib2[375 - 1]] + 59425114757512643212875125 Hold[fib2[376 - 1]] :[font = input; Cclosed; preserveAspect; startGroup] $RecursionLimit :[font = output; output; inactive; preserveAspect; endGroup] 256 ;[o] 256 :[font = input; Cclosed; preserveAspect; startGroup] $RecursionLimit = 1000 :[font = output; output; inactive; preserveAspect; endGroup] 1000 ;[o] 1000 :[font = input; preserveAspect] Clear[fib2] fib2[n_] := fib2[n] = fib2[n-1] + fib2[n-2] fib2[1] = fib2[2] = 1; :[font = input; Cclosed; preserveAspect; startGroup] fib2[500] :[font = message; inactive; preserveAspect] $RecursionLimit::reclim: Recursion depth of 1000 exceeded. :[font = message; inactive; preserveAspect] $RecursionLimit::reclim: Recursion depth of 1000 exceeded. :[font = message; inactive; preserveAspect] $RecursionLimit::reclim: Recursion depth of 1000 exceeded. :[font = message; inactive; preserveAspect] General::stop: Further output of $RecursionLimit::reclim will be suppressed during this calculation. :[font = output; output; inactive; preserveAspect; endGroup; endGroup] 203415743226804080810838292438202036123173081972119\ 64554628215486203974898255803242740333222721700\ 974747*Hold[fib2[3 - 2]] + 3291335863877902132585224146092229224181188006442\ 44593849508439919725406087838947353589974769263\ 73114877*Hold[fib2[4 - 2]] + 2034157432268040808108382924382020361231730819721\ 19645546282154862039748982558032427403332227217\ 00974747*Hold[fib2[3 - 1]] + 3291335863877902132585224146092229224181188006442\ 44593849508439919725406087838947353589974769263\ 73114877*Hold[fib2[4 - 1]] ;[o] 203415743226804080810838292438202036123173081972119\ 64554628215486203974898255803242740333222721700\ 974747 Hold[fib2[3 - 2]] + 3291335863877902132585224146092229224181188006442\ 44593849508439919725406087838947353589974769263\ 73114877 Hold[fib2[4 - 2]] + 2034157432268040808108382924382020361231730819721\ 19645546282154862039748982558032427403332227217\ 00974747 Hold[fib2[3 - 1]] + 3291335863877902132585224146092229224181188006442\ 44593849508439919725406087838947353589974769263\ 73114877 Hold[fib2[4 - 1]] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 2.3 Maxima :[font = input; preserveAspect] maxima[{}] := {} maxima[{x_, r___}] := Join[{x}, Select[maxima[{r}], (# > x)&]] :[font = input; Cclosed; preserveAspect; startGroup] maxima[{4, 2, 7, 3, 4, 9, 14, 11, 17}] :[font = output; output; inactive; preserveAspect; endGroup; endGroup; endGroup] {4, 7, 9, 14, 17} ;[o] {4, 7, 9, 14, 17} :[font = section; inactive; Cclosed; preserveAspect; startGroup] 3 Functional Programming :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 3.1 Simple sum functions :[font = input; Cclosed; preserveAspect; startGroup] Timing[ Sum[k, {k, 10000}] ] :[font = output; output; inactive; preserveAspect; endGroup] {1.816666666666663*Second, 50005000} ;[o] {1.81667 Second, 50005000} :[font = input; Cclosed; preserveAspect; startGroup] ?FoldList :[font = info; inactive; preserveAspect; endGroup] FoldList[f, x, {a, b, ...}] gives {x, f[x, a], f[f[x, a], b], ...}. :[font = input; Cclosed; preserveAspect; startGroup] ?Fold :[font = info; inactive; preserveAspect; endGroup] Fold[f, x, list] gives the last element of FoldList[f, x, list]. :[font = input; Cclosed; dontPreserveAspect; startGroup] FoldList[Plus, 0, Range[10]] :[font = output; output; inactive; dontPreserveAspect; endGroup] {0, 1, 3, 6, 10, 15, 21, 28, 36, 45, 55} ;[o] {0, 1, 3, 6, 10, 15, 21, 28, 36, 45, 55} :[font = input; Cclosed; dontPreserveAspect; startGroup] Timing[ Fold[Plus, 0, Range[10000]]] :[font = output; output; inactive; dontPreserveAspect; endGroup] {2.166666666666671*Second, 50005000} ;[o] {2.16667 Second, 50005000} :[font = input; Cclosed; dontPreserveAspect; startGroup] Timing[ Apply[Plus, Range[10000]] ] :[font = output; output; inactive; dontPreserveAspect; endGroup] {0.5*Second, 50005000} ;[o] {0.5 Second, 50005000} :[font = input; Cclosed; preserveAspect; startGroup] Timing[ Plus @@ Range[10000] ] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] {0.5166666666666658*Second, 50005000} ;[o] {0.516667 Second, 50005000} :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 3.2 Base conversion :[font = input; Cclosed; preserveAspect; startGroup] l = IntegerDigits[12509, 2] :[font = output; output; inactive; preserveAspect; endGroup] {1, 1, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 0, 1} ;[o] {1, 1, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 0, 1} :[font = input; Cclosed; preserveAspect; startGroup] r = Reverse[l]; Sum[r[[j]] 2^(j-1), {j, 1, Length[l]}] :[font = output; output; inactive; preserveAspect; endGroup] 12509 ;[o] 12509 :[font = input; preserveAspect] baseConvert[list_List, base_:2]:= Fold[(base #1 + #2)&, 0, list] :[font = input; Cclosed; preserveAspect; startGroup] baseConvert[l] :[font = output; output; inactive; preserveAspect; endGroup] 12509 ;[o] 12509 :[font = input; Cclosed; preserveAspect; startGroup] baseConvert[{a, b, c, d, e}, x] :[font = output; output; inactive; preserveAspect; endGroup] e + x*(d + x*(c + x*(b + a*x))) ;[o] e + x (d + x (c + x (b + a x))) :[font = input; Cclosed; preserveAspect; startGroup] Expand[%] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] e + d*x + c*x^2 + b*x^3 + a*x^4 ;[o] 2 3 4 e + d x + c x + b x + a x :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 3.3 Maxima :[font = input; preserveAspect] maxima[x_] := Union[Rest[FoldList[Max, 0, x]]] :[font = input; Cclosed; preserveAspect; startGroup] maxima[{4, 2, 7, 3, 4, 9, 14, 11, 17}] :[font = output; output; inactive; preserveAspect; endGroup; endGroup; endGroup] {4, 7, 9, 14, 17} ;[o] {4, 7, 9, 14, 17} :[font = section; inactive; Cclosed; preserveAspect; startGroup] 4 Iterative Programming :[font = subsection; inactive; Cclosed; dontPreserveAspect; startGroup] 4.1 Iteration by "Do" :[font = input; Cclosed; dontPreserveAspect; startGroup] sum = 0; Do[ sum += i, {i,10000} ]; sum :[font = output; output; inactive; dontPreserveAspect; endGroup; endGroup] 50005000 ;[o] 50005000 :[font = subsection; inactive; Cclosed; dontPreserveAspect; startGroup] 4.2 Iteration by "For" :[font = input; Cclosed; dontPreserveAspect; startGroup] sum = 0; For[ sum = 0; i = 1, i <= 10000, i++, sum += i]; sum :[font = output; output; inactive; preserveAspect; endGroup; endGroup] 50005000 ;[o] 50005000 :[font = subsection; inactive; Cclosed; dontPreserveAspect; startGroup] 4.3 Iteration by "While" :[font = input; Cclosed; dontPreserveAspect; startGroup] sum = 0; i = 1; While[ i <= 10000, sum += (i++)]; sum :[font = output; output; inactive; dontPreserveAspect; endGroup; endGroup; endGroup] 50005000 ;[o] 50005000 :[font = section; inactive; Cclosed; preserveAspect; startGroup] 5 Evaluation of Expressions :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 5.1 Order of evaluation :[font = input; preserveAspect] fib[n_] := fib[n-1] + fib[n-2] :[font = input; preserveAspect] fib[1] = fib[2] = 1; :[font = input; Cclosed; preserveAspect; startGroup] ?fib :[font = print; inactive; preserveAspect; endGroup] Global`fib fib[1] = 1 fib[2] = 1 fib[n_] := fib[n - 1] + fib[n - 2] :[font = input; Cclosed; preserveAspect; startGroup] Trace[fib[3]] :[font = output; output; inactive; preserveAspect; endGroup] {HoldForm[fib[3]], HoldForm[fib[3 - 1] + fib[3 - 2]], {{HoldForm[3 - 1], HoldForm[-1 + 3], HoldForm[2]}, HoldForm[fib[2]], HoldForm[1]}, {{HoldForm[3 - 2], HoldForm[-2 + 3], HoldForm[1]}, HoldForm[fib[1]], HoldForm[1]}, HoldForm[1 + 1], HoldForm[2]} ;[o] {fib[3], fib[3 - 1] + fib[3 - 2], {{3 - 1, -1 + 3, 2}, fib[2], 1}, {{3 - 2, -2 + 3, 1}, fib[1], 1}, 1 + 1, 2} :[font = text; inactive; preserveAspect] Specific rules before general rules :[font = smalltext; inactive; preserveAspect] - Evaluate head of expression - Evaluate each element in turn - Apply transformations associated with Attributes (Orderless, Listable, and Flat) - Apply any user-supplied definitions - Apply any built-in defintions - Evaluate the result :[font = input; Cclosed; preserveAspect; startGroup] x = 2; Trace[ a x^2 + b x + c ] :[font = output; output; inactive; preserveAspect; endGroup] {{{{HoldForm[x], HoldForm[2]}, HoldForm[2^2], HoldForm[4]}, HoldForm[a*4], HoldForm[4*a]}, {{HoldForm[x], HoldForm[2]}, HoldForm[b*2], HoldForm[2*b]}, HoldForm[4*a + 2*b + c]} ;[o] 2 {{{{x, 2}, 2 , 4}, a 4, 4 a}, {{x, 2}, b 2, 2 b}, 4 a + 2 b + c} :[font = input; Cclosed; preserveAspect; startGroup] Clear[x] Log[x y] :[font = output; output; inactive; preserveAspect; endGroup] Log[x*y] ;[o] Log[x y] :[font = input; preserveAspect] ( Unprotect[Log]; Log[a_ b_] := Log[a] + Log[b]; Protect[Log]; ) :[font = input; Cclosed; preserveAspect; startGroup] Log[x y] :[font = output; output; inactive; preserveAspect; endGroup] Log[x] + Log[y] ;[o] Log[x] + Log[y] :[font = input; Cclosed; preserveAspect; startGroup] ??Log :[font = print; inactive; preserveAspect; endGroup; endGroup] Log[z] gives the natural logarithm of z (logarithm to base E). Log[b, z] gives the logarithm to base b. Attributes[Log] = {Listable, Protected} Log[(a_)*(b_)] := Log[a] + Log[b] :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 5.2 Immediate and delayed evaluation :[font = input; Cclosed; preserveAspect; startGroup] x = Random[] :[font = output; output; inactive; preserveAspect; endGroup] 0.6492183150545028 ;[o] 0.649218 :[font = input; preserveAspect] y := Random[] :[font = input; Cclosed; preserveAspect; startGroup] ?x :[font = print; inactive; preserveAspect; endGroup] Global`x x = 0.6492183150545028 :[font = input; Cclosed; preserveAspect; startGroup] ?y :[font = print; inactive; preserveAspect; endGroup] Global`y y := Random[] :[font = input; Cclosed; preserveAspect; startGroup] Table[x,{10}] :[font = output; output; inactive; preserveAspect; endGroup] {0.6492183150545028, 0.6492183150545028, 0.6492183150545028, 0.6492183150545028, 0.6492183150545028, 0.6492183150545028, 0.6492183150545028, 0.6492183150545028, 0.6492183150545028, 0.6492183150545028} ;[o] {0.649218, 0.649218, 0.649218, 0.649218, 0.649218, 0.649218, 0.649218, 0.649218, 0.649218, 0.649218} :[font = input; Cclosed; preserveAspect; startGroup] Table[y,{10}] :[font = output; output; inactive; preserveAspect; endGroup; endGroup; endGroup] {0.968284928124943, 0.549596729670352, 0.803044024538651, 0.941359591024729, 0.2347108490754349, 0.7176571301881538, 0.3296297437560335, 0.5403410687168411, 0.7291000522258193, 0.1440776545284284} ;[o] {0.968285, 0.549597, 0.803044, 0.94136, 0.234711, 0.717657, 0.32963, 0.540341, 0.7291, 0.144078} :[font = section; inactive; Cclosed; preserveAspect; startGroup] 6 Graphics Programming :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 6.1 Simple closed paths :[font = input; Cclosed; preserveAspect; startGroup] coords = Table[{Random[],Random[]},{10}] :[font = output; output; inactive; preserveAspect; endGroup] {{0.828914573596385, 0.985438798349415}, {0.991947807286483, 0.2354968000568659}, {0.866229747789973, 0.4530080626699102}, {0.7568976934024231, 0.6812424131993082}, {0.4183932809551353, 0.3437668108702565}, {0.89564466343331, 0.4684214425532146}, {0.848412291257576, 0.3960994969568782}, {0.3845364957226196, 0.04583053543348855}, {0.3069269637792376, 0.888210665933031}, {0.7673727956838072, 0.6029234757974319}} ;[o] {{0.828915, 0.985439}, {0.991948, 0.235497}, {0.86623, 0.453008}, {0.756898, 0.681242}, {0.418393, 0.343767}, {0.895645, 0.468421}, {0.848412, 0.396099}, {0.384536, 0.0458305}, {0.306927, 0.888211}, {0.767373, 0.602923}} :[font = input; Cclosed; preserveAspect; startGroup] points = Map[Point, coords] :[font = output; output; inactive; preserveAspect; endGroup] {Point[{0.828914573596385, 0.985438798349415}], Point[{0.991947807286483, 0.2354968000568659}], Point[{0.866229747789973, 0.4530080626699102}], Point[{0.7568976934024231, 0.6812424131993082}], Point[{0.4183932809551353, 0.3437668108702565}], Point[{0.89564466343331, 0.4684214425532146}], Point[{0.848412291257576, 0.3960994969568782}], Point[{0.3845364957226196, 0.04583053543348855}], Point[{0.3069269637792376, 0.888210665933031}], Point[{0.7673727956838072, 0.6029234757974319}]} ;[o] {Point[{0.828915, 0.985439}], Point[{0.991948, 0.235497}], Point[{0.86623, 0.453008}], Point[{0.756898, 0.681242}], Point[{0.418393, 0.343767}], Point[{0.895645, 0.468421}], Point[{0.848412, 0.396099}], Point[{0.384536, 0.0458305}], Point[{0.306927, 0.888211}], Point[{0.767373, 0.602923}]} :[font = input; Cclosed; preserveAspect; startGroup] Show[Graphics[{PointSize[.02], points}]] :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 230; pictureHeight = 142] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations -0.402909 1.390295 -0.013995 0.626435 [ [ 0 0 0 0 ] [ 1 .61803 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p .02 w .74953 .60332 Mdot .97619 .13353 Mdot .80141 .26979 Mdot .6494 .41276 Mdot .17878 .20135 Mdot .8423 .27944 Mdot .77663 .23414 Mdot .13171 .01472 Mdot .02381 .54241 Mdot .66396 .3637 Mdot P P % End of Graphics MathPictureEnd :[font = output; output; inactive; preserveAspect; endGroup] Graphics["<<>>"] ;[o] -Graphics- :[font = input; Cclosed; preserveAspect; startGroup] Show[Graphics[ {PointSize[.025], RGBColor[1,0,0], Map[Point,coords]}], Axes->Automatic]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 230; pictureHeight = 142; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Optima findfont 5.5 scalefont setfont % Scaling calculations 0.006772 1.268183 -0.088171 0.788634 [ [(0.1)] .13359 .06956 0 2 Msboxa [(0.2)] .26041 .06956 0 2 Msboxa [(0.3)] .38723 .06956 0 2 Msboxa [(0.4)] .51405 .06956 0 2 Msboxa [(0.5)] .64086 .06956 0 2 Msboxa [(0.6)] .76768 .06956 0 2 Msboxa [(0.7)] .8945 .06956 0 2 Msboxa [(0.3)] -0.00573 .14842 1 0 Msboxa [(0.4)] -0.00573 .22728 1 0 Msboxa [(0.5)] -0.00573 .30615 1 0 Msboxa [(0.6)] -0.00573 .38501 1 0 Msboxa [(0.7)] -0.00573 .46387 1 0 Msboxa [(0.8)] -0.00573 .54274 1 0 Msboxa [ -0.001 -0.001 0 0 ] [ 1.001 .61903 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p p .002 w .13359 .06956 m .13359 .07581 L s P [(0.1)] .13359 .06956 0 2 Mshowa p .002 w .26041 .06956 m .26041 .07581 L s P [(0.2)] .26041 .06956 0 2 Mshowa p .002 w .38723 .06956 m .38723 .07581 L s P [(0.3)] .38723 .06956 0 2 Mshowa p .002 w .51405 .06956 m .51405 .07581 L s P [(0.4)] .51405 .06956 0 2 Mshowa p .002 w .64086 .06956 m .64086 .07581 L s P [(0.5)] .64086 .06956 0 2 Mshowa p .002 w .76768 .06956 m .76768 .07581 L s P [(0.6)] .76768 .06956 0 2 Mshowa p .002 w .8945 .06956 m .8945 .07581 L s P [(0.7)] .8945 .06956 0 2 Mshowa p .001 w .03214 .06956 m .03214 .07331 L s P p .001 w .0575 .06956 m .0575 .07331 L s P p .001 w .08286 .06956 m .08286 .07331 L s P p .001 w .10823 .06956 m .10823 .07331 L s P p .001 w .15895 .06956 m .15895 .07331 L s P p .001 w .18432 .06956 m .18432 .07331 L s P p .001 w .20968 .06956 m .20968 .07331 L s P p .001 w .23504 .06956 m .23504 .07331 L s P p .001 w .28577 .06956 m .28577 .07331 L s P p .001 w .31114 .06956 m .31114 .07331 L s P p .001 w .3365 .06956 m .3365 .07331 L s P p .001 w .36186 .06956 m .36186 .07331 L s P p .001 w .41259 .06956 m .41259 .07331 L s P p .001 w .43795 .06956 m .43795 .07331 L s P p .001 w .46332 .06956 m .46332 .07331 L s P p .001 w .48868 .06956 m .48868 .07331 L s P p .001 w .53941 .06956 m .53941 .07331 L s P p .001 w .56477 .06956 m .56477 .07331 L s P p .001 w .59014 .06956 m .59014 .07331 L s P p .001 w .6155 .06956 m .6155 .07331 L s P p .001 w .66623 .06956 m .66623 .07331 L s P p .001 w .69159 .06956 m .69159 .07331 L s P p .001 w .71695 .06956 m .71695 .07331 L s P p .001 w .74232 .06956 m .74232 .07331 L s P p .001 w .79305 .06956 m .79305 .07331 L s P p .001 w .81841 .06956 m .81841 .07331 L s P p .001 w .84377 .06956 m .84377 .07331 L s P p .001 w .86914 .06956 m .86914 .07331 L s P p .001 w .91986 .06956 m .91986 .07331 L s P p .001 w .94523 .06956 m .94523 .07331 L s P p .001 w .97059 .06956 m .97059 .07331 L s P p .001 w .99595 .06956 m .99595 .07331 L s P p .002 w 0 .06956 m 1 .06956 L s P p .002 w .00677 .14842 m .01302 .14842 L s P [(0.3)] -0.00573 .14842 1 0 Mshowa p .002 w .00677 .22728 m .01302 .22728 L s P [(0.4)] -0.00573 .22728 1 0 Mshowa p .002 w .00677 .30615 m .01302 .30615 L s P [(0.5)] -0.00573 .30615 1 0 Mshowa p .002 w .00677 .38501 m .01302 .38501 L s P [(0.6)] -0.00573 .38501 1 0 Mshowa p .002 w .00677 .46387 m .01302 .46387 L s P [(0.7)] -0.00573 .46387 1 0 Mshowa p .002 w .00677 .54274 m .01302 .54274 L s P [(0.8)] -0.00573 .54274 1 0 Mshowa p .001 w .00677 .08533 m .01052 .08533 L s P p .001 w .00677 .1011 m .01052 .1011 L s P p .001 w .00677 .11687 m .01052 .11687 L s P p .001 w .00677 .13265 m .01052 .13265 L s P p .001 w .00677 .16419 m .01052 .16419 L s P p .001 w .00677 .17996 m .01052 .17996 L s P p .001 w .00677 .19574 m .01052 .19574 L s P p .001 w .00677 .21151 m .01052 .21151 L s P p .001 w .00677 .24306 m .01052 .24306 L s P p .001 w .00677 .25883 m .01052 .25883 L s P p .001 w .00677 .2746 m .01052 .2746 L s P p .001 w .00677 .29037 m .01052 .29037 L s P p .001 w .00677 .32192 m .01052 .32192 L s P p .001 w .00677 .33769 m .01052 .33769 L s P p .001 w .00677 .35346 m .01052 .35346 L s P p .001 w .00677 .36924 m .01052 .36924 L s P p .001 w .00677 .40078 m .01052 .40078 L s P p .001 w .00677 .41656 m .01052 .41656 L s P p .001 w .00677 .43233 m .01052 .43233 L s P p .001 w .00677 .4481 m .01052 .4481 L s P p .001 w .00677 .47965 m .01052 .47965 L s P p .001 w .00677 .49542 m .01052 .49542 L s P p .001 w .00677 .51119 m .01052 .51119 L s P p .001 w .00677 .52696 m .01052 .52696 L s P p .001 w .00677 .55851 m .01052 .55851 L s P p .001 w .00677 .57428 m .01052 .57428 L s P p .001 w .00677 .59005 m .01052 .59005 L s P p .001 w .00677 .60583 m .01052 .60583 L s P p .001 w .00677 .05378 m .01052 .05378 L s P p .001 w .00677 .03801 m .01052 .03801 L s P p .001 w .00677 .02224 m .01052 .02224 L s P p .001 w .00677 .00647 m .01052 .00647 L s P p .002 w .00677 0 m .00677 .61803 L s P P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p 1 0 0 r p .025 w .89903 .31854 Mdot .58151 .19756 Mdot .03299 .51547 Mdot .02381 .01472 Mdot .2201 .50823 Mdot .46317 .26951 Mdot .27826 .39433 Mdot .62057 .19406 Mdot .97619 .493 Mdot .77493 .60332 Mdot P P % End of Graphics MathPictureEnd :[font = input; Cclosed; preserveAspect; startGroup] lines = Line[coords] :[font = output; output; inactive; preserveAspect; endGroup] Line[{{0.828914573596385, 0.985438798349415}, {0.991947807286483, 0.2354968000568659}, {0.866229747789973, 0.4530080626699102}, {0.7568976934024231, 0.6812424131993082}, {0.4183932809551353, 0.3437668108702565}, {0.89564466343331, 0.4684214425532146}, {0.848412291257576, 0.3960994969568782}, {0.3845364957226196, 0.04583053543348855}, {0.3069269637792376, 0.888210665933031}, {0.7673727956838072, 0.6029234757974319}}] ;[o] Line[{{0.828915, 0.985439}, {0.991948, 0.235497}, {0.86623, 0.453008}, {0.756898, 0.681242}, {0.418393, 0.343767}, {0.895645, 0.468421}, {0.848412, 0.396099}, {0.384536, 0.0458305}, {0.306927, 0.888211}, {0.767373, 0.602923}}] :[font = input; Cclosed; preserveAspect; startGroup] Show[Graphics[{PointSize[.02], {RGBColor[1,0,0], points}, lines}]]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureTop = 1; pictureWidth = 230; pictureHeight = 142; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations -0.402909 1.390295 0.014715 0.597301 [ [ 0 0 0 0 ] [ 1 .61803 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p 1 0 0 r p .02 w .74953 .60332 Mdot .97619 .15538 Mdot .80141 .2853 Mdot .6494 .42162 Mdot .17878 .22005 Mdot .8423 .2945 Mdot .77663 .25131 Mdot .13171 .04209 Mdot .02381 .54524 Mdot .66396 .37484 Mdot P P .004 w .74953 .60332 m .97619 .15538 L .80141 .2853 L .6494 .42162 L .17878 .22005 L .8423 .2945 L .77663 .25131 L .13171 .04209 L .02381 .54524 L .66396 .37484 L s P % End of Graphics MathPictureEnd :[font = input; Cclosed; preserveAspect; startGroup] path = Line[AppendTo[coords, First[coords]]]; Show[Graphics[{PointSize[.02], {RGBColor[1,0,0],points}, path}]]; :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 230; pictureHeight = 142; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations -0.402909 1.390295 0.014715 0.597301 [ [ 0 0 0 0 ] [ 1 .61803 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p 1 0 0 r p .02 w .74953 .60332 Mdot .97619 .15538 Mdot .80141 .2853 Mdot .6494 .42162 Mdot .17878 .22005 Mdot .8423 .2945 Mdot .77663 .25131 Mdot .13171 .04209 Mdot .02381 .54524 Mdot .66396 .37484 Mdot P P .004 w .74953 .60332 m .97619 .15538 L .80141 .2853 L .6494 .42162 L .17878 .22005 L .8423 .2945 L .77663 .25131 L .13171 .04209 L .02381 .54524 L .66396 .37484 L .74953 .60332 L .74953 .60332 L s P % End of Graphics MathPictureEnd :[font = input; Cclosed; preserveAspect; startGroup] base = coords[[Random[Integer,{1,Length[coords]}]]] :[font = output; output; inactive; preserveAspect; endGroup] {0.3845364957226196, 0.04583053543348855} ;[o] {0.384536, 0.0458305} :[font = text; inactive; preserveAspect] The following function finds the angle between the horizontal axis and point "a", with point "b" being taken as the vertex of the angle. :[font = input; preserveAspect] angle[a_List, b_List] := Apply[ArcTan, (b-a)] :[font = input; preserveAspect] remain = DeleteCases[coords, base]; :[font = input; Cclosed; preserveAspect; startGroup] s = Sort[remain, (angle[base, #1] <= angle[base, #2])&] :[font = output; output; inactive; preserveAspect; endGroup] {{0.991947807286483, 0.2354968000568659}, {0.848412291257576, 0.3960994969568782}, {0.89564466343331, 0.4684214425532146}, {0.866229747789973, 0.4530080626699102}, {0.7673727956838072, 0.6029234757974319}, {0.7568976934024231, 0.6812424131993082}, {0.828914573596385, 0.985438798349415}, {0.828914573596385, 0.985438798349415}, {0.828914573596385, 0.985438798349415}, {0.4183932809551353, 0.3437668108702565}, {0.3069269637792376, 0.888210665933031}} ;[o] {{0.991948, 0.235497}, {0.848412, 0.396099}, {0.895645, 0.468421}, {0.86623, 0.453008}, {0.767373, 0.602923}, {0.756898, 0.681242}, {0.828915, 0.985439}, {0.828915, 0.985439}, {0.828915, 0.985439}, {0.418393, 0.343767}, {0.306927, 0.888211}} :[font = input; Cclosed; preserveAspect; startGroup] p = Join[{base}, s, {base}] :[font = output; output; inactive; preserveAspect; endGroup] {{0.3845364957226196, 0.04583053543348855}, {0.991947807286483, 0.2354968000568659}, {0.848412291257576, 0.3960994969568782}, {0.89564466343331, 0.4684214425532146}, {0.866229747789973, 0.4530080626699102}, {0.7673727956838072, 0.6029234757974319}, {0.7568976934024231, 0.6812424131993082}, {0.828914573596385, 0.985438798349415}, {0.828914573596385, 0.985438798349415}, {0.828914573596385, 0.985438798349415}, {0.4183932809551353, 0.3437668108702565}, {0.3069269637792376, 0.888210665933031}, {0.3845364957226196, 0.04583053543348855}} ;[o] {{0.384536, 0.0458305}, {0.991948, 0.235497}, {0.848412, 0.396099}, {0.895645, 0.468421}, {0.86623, 0.453008}, {0.767373, 0.602923}, {0.756898, 0.681242}, {0.828915, 0.985439}, {0.828915, 0.985439}, {0.828915, 0.985439}, {0.418393, 0.343767}, {0.306927, 0.888211}, {0.384536, 0.0458305}} :[font = input; preserveAspect] path = Line[p]; :[font = input; Cclosed; preserveAspect; startGroup] Show[Graphics[{PointSize[.02], {RGBColor[1,0,0],points}, path}]] :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 34; pictureWidth = 230; pictureHeight = 142] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations -0.402909 1.390295 0.014715 0.597301 [ [ 0 0 0 0 ] [ 1 .61803 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p 1 0 0 r p .02 w .74953 .60332 Mdot .97619 .15538 Mdot .80141 .2853 Mdot .6494 .42162 Mdot .17878 .22005 Mdot .8423 .2945 Mdot .77663 .25131 Mdot .13171 .04209 Mdot .02381 .54524 Mdot .66396 .37484 Mdot P P .004 w .13171 .04209 m .97619 .15538 L .77663 .25131 L .8423 .2945 L .80141 .2853 L .66396 .37484 L .6494 .42162 L .74953 .60332 L .74953 .60332 L .74953 .60332 L .17878 .22005 L .02381 .54524 L .13171 .04209 L s P % End of Graphics MathPictureEnd :[font = output; output; inactive; preserveAspect; endGroup] Graphics["<<>>"] ;[o] -Graphics- :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] SimpleClosedPath :[font = input; preserveAspect] simpleClosedPath[l_] := Module[{points, base, sorted, path}, points = {PointSize[.02], RGBColor[1,0,0], Map[Point,l]}; (* base = l[[ Random[Integer, {1, Length[l]}] ]]; *) base = Last[Sort[l,(#2[[2]] > #1[[2]])&]]; remain = DeleteCases[l,base]; angle[a_,b_]:= Apply[ArcTan, (b - a)]; sorted = Sort[remain, (angle[base, #1] <= angle[base, #2])&]; path = Line[Join[{base},sorted,{base}]]; Show[Graphics[{{RGBColor[1,0,0],points}, path}]] ] :[font = input; preserveAspect] data = Table[{Random[],Random[]},{25}]; simpleClosedPath[data]; :[font = input; preserveAspect; endGroup; endGroup] data = Table[{Random[],Random[]},{100}]; simpleClosedPath[data]; :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] 6.2 Random audio walk :[font = input; preserveAspect] (* Equal tempered C major scale *) cmajor = Table[N[261.62558 2^(j/12)],{j,0,12}] :[font = text; inactive; preserveAspect] We want to do a random walk across our list of tones. We will allow steps of 0, 1, 2, -1,-2, steps. :[font = input; preserveAspect] step20 = Table[Random[Integer, {-2,2}], {2}]; :[font = text; inactive; preserveAspect] Need to add 1, so that we get no Part[expr, 0] which would return the Head, not a position. :[font = input; preserveAspect] FoldList[Plus, 5, step20] :[font = input; preserveAspect] pos = Mod[FoldList[Plus, 5, step20], 11] + 1 :[font = input; preserveAspect] brown = cmajor[[pos]] :[font = input; preserveAspect] tones[freq_] := Play[Sin[2 Pi t freq], {t, 0, .5}] :[font = input; preserveAspect; endGroup; endGroup] Map[tones, brown]; :[font = section; inactive; Cclosed; preserveAspect; startGroup] 7 Additional sources of information on programming in Mathematica. ;[s] 3:0,0;55,1;66,2;68,-1; 3:1,16,12,Times,1,18,0,0,0;1,17,13,Times,3,18,0,0,0;1,16,12,Times,1,18,0,0,0; :[font = subsubsection; inactive; preserveAspect] "Programming in Mathematica", R. Maeder, Addison-Wesley Publishing Co., 1992. ;[s] 3:0,0;18,1;30,2;80,-1; 3:1,10,8,Times,1,12,0,0,0;1,10,8,Times,3,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = subsubsection; inactive; preserveAspect] "Introduction to Programming with Mathematica", R. Gaylord, S. Kamin, P. Wellin, TELOS/Springer-Verlag, 1993. ;[s] 3:0,0;36,1;47,2;116,-1; 3:1,10,8,Times,1,12,0,0,0;1,10,8,Times,3,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = subsubsection; inactive; preserveAspect] "Mathematica: A Practical Approach", N. Blachman, Prentice-Hall, 1992. ;[s] 3:0,0;3,1;14,2;72,-1; 3:1,10,8,Times,1,12,0,0,0;1,10,8,Times,3,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = subsubsection; inactive; preserveAspect; fontName = "Times"] "The Mathematica Journal, Miller Freeman, San Francisco. ;[s] 3:0,0;7,1;18,2;58,-1; 3:1,10,8,Times,1,12,0,0,0;1,10,8,Times,3,12,0,0,0;1,10,8,Times,1,12,0,0,0; :[font = subsubsection; inactive; preserveAspect; endGroup; endGroup] "Mathematica in Education", TELOS/Springer-Verlag. To order a subscription or receive a complimentary copy of Mathematica in Education, send a message to: Paul Wellin, editor Mathematica in Education Department of Mathematics Sonoma State University Rohnert Park, CA 94928 USA email: MathInEd@groucho.sonoma.edu fax: 707-664-2505 ;[s] 8:0,0;3,1;14,2;112,3;123,4;163,5;186,6;197,7;362,-1; 8:1,10,8,Times,1,12,0,0,0;1,10,8,Times,3,12,0,0,0;1,10,8,Times,1,12,0,0,0;1,10,8,Times,3,12,0,0,0;1,10,8,Times,1,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Times,2,12,0,0,0;1,11,8,Times,0,12,0,0,0; ^*)