(************** Content-type: application/mathematica ************** Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 54340, 1342]*) (*NotebookOutlinePosition[ 55542, 1387]*) (* CellTagsIndexPosition[ 55402, 1378]*) (*WindowFrame->Normal*) Notebook[{ Cell[TextData[{ "Instructions: \n\nBegin by reading the Introduction.\n\nGo through ALL \ Parts and be able to explain what the commands are doing.\n\nDo the You Try \ It for Part I, \n\tIf you already did this one by hand, do your results \ agree?\n\t\nDo the You Try It for Part II \n\tBe sure to change the terms in \ red to what they should be for this problem.\n\tIncreasng the expression in \ green can extend your series to more terms.\n\t\nDo the You Try It for Part \ III \n\tBe sure to change the terms in red to what they should be for this \ problem.\n\nDo the You Try it for Part IV\n\tRespond to the questions posed.\n\ \n", StyleBox["The heart of your write-up will be a written summary (NOT HAND \ WRITTEN) of your observations, but you may include a few pages of ", FontWeight->"Bold"], StyleBox["Mathematica", FontWeight->"Bold", FontSlant->"Italic"], StyleBox[" printouts to help clarify your explanations.\n", FontWeight->"Bold"] }], "Subsubtitle"], Cell[CellGroupData[{ Cell["\<\ Use the Fourier Series to Approximate Discontinuous Functions and to \ Interpret Music \ \>", "Title"], Cell[TextData[StyleBox["Chapter 8, Sections 9 & 10", FontFamily->"Arial", FontSize->16, FontWeight->"Bold"]], "Text"], Cell[CellGroupData[{ Cell["Introduction", "Section"], Cell[TextData[{ "OBJECTIVE: Use ", StyleBox["Mathematica", FontSlant->"Italic"], " to calculate Fourier series and to build even and odd Fourier \ representations of selected functions." }], "Text"], Cell["\<\ In signal processing and communications, it is necessary to construct \ periodic functions, some with discontinuities. The Fourier series provides us \ with a tool to analyze such functions. One very important type of signal that \ you probably receive every day is music. We can use the Fourier series to \ build mathematical models of musical tones, to look at their graphs, and even \ to play back the signal to hear how close our model is to the real thing. We \ usually call a device that can do this a synthesizer.\ \>", "Text"], Cell[TextData[{ "As you have probably noticed, the computations involved in arriving at a \ Fourier series approximation to a function can be tedious. Fortunately, the \ computer can perform such computations for us, enabling you to not only get \ the results but to visualize the results.\n\n", StyleBox["Mathematica", FontSlant->"Italic"], " has a package that allows you to merely call upon the Fourier Series. The \ package is called by executing ", StyleBox["<"Bold"], "; the specific commands for getting the Fourier Series expansions are \ different in Version 3 and Version 4. You can get details on this from the \ Help window; look under Add-Ons and then Calculus packages and then the \ FourierTransform. This module does not call upon the FourierTransform \ package; instead, we use the ", StyleBox["Integrate", FontWeight->"Bold"], " commands to compute the Fourier coefficients." }], "Text"], Cell[CellGroupData[{ Cell["Technology Guidelines", "Subsection", CellDingbat->"\[LightBulb]"], Cell[TextData[{ StyleBox["NOTE: If you have just finished a module, restart ", CellFrame->True, Background->None], StyleBox["Mathematica", CellFrame->True, FontSlant->"Italic", Background->None], StyleBox[ " before executing a new module.\nTO OPEN CELLS, put your cursor on the \ right cell bracket and double click.", CellFrame->True, Background->None], "\nTO STOP AN EXECUTION\n\tSelect the ", StyleBox["Kernel", FontSlant->"Italic"], " pull-down menu and click on ", StyleBox["Abort Evaluation.\n", FontSlant->"Italic"], "ORDER OF EXECUTION\n\tExecute cells in the order given. Do not skip any \ Input cells within a given notebook.\nSAVING NOTEBOOKS\n\tYou can save \ anytime to any directory you choose, and it is wise to save often.\n\t\ However, before you do your final save, delete all your output by selecting \ the \n\t ", StyleBox["Delete All Output", FontSlant->"Italic"], " selection under the ", StyleBox["Kernel", FontSlant->"Italic"], " pull-down menu.\nEXPERIENCING MAJOR PROBLEMS\n\tSave if appropriate, and \ then shut down ", StyleBox["Mathematica", FontSlant->"Italic"], " and start it up again." }], "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["\<\ Part I: Fourier Series Approximations for Non-Periodic Functions\ \>", "Section"], Cell[TextData[StyleBox["Section 8.9", FontWeight->"Bold"]], "Text"], Cell[TextData[{ "The following is an example of how you can use a Fourier series to \ approximate a continuous function. If you have not done so already, read \ Sections 8.9 and 8.10 in your text before proceeding. We define the \ coefficients for the sine and cosine functions as they are defined in your \ text. Because of the way that ", StyleBox["a[n]", FontSlant->"Italic"], " and ", StyleBox["b[n]", FontSlant->"Italic"], " are stored, if you decide to enter a new function, you must ", StyleBox["clear the ", FontWeight->"Bold"], StyleBox["a", FontWeight->"Bold", FontSlant->"Italic"], StyleBox[" and ", FontWeight->"Bold"], StyleBox["b", FontWeight->"Bold", FontSlant->"Italic"], StyleBox[" values first", FontWeight->"Bold"], ".\n\nThe function we look at first is ", StyleBox["f(x) = ", FontSlant->"Italic"], Cell[BoxData[ \(TraditionalForm\`\(\((1\ - \ x)\) \((x + 1)\) \((x - 2)\), \)\)]], " and we will find its Fourier series approximation over the interval ", Cell[BoxData[ \(TraditionalForm\`x\ = \ \(-2\)\ to\ + 2\)]], ". We will begin by defining the function and looking at its plot." }], "Text"], Cell[BoxData[{ \(Off[General::spell]\ \), "\n", \(Off[General::spell1]\ \), "\n", \(Clear[a, b, f, x, length, foursine, fourcos, all]\), "\n", \(f[x_] := \((1 - x)\) \((x + 1)\) \((x - 2)\)\), "\n", \(\(length = 2;\)\), "\n", \(\(Plot[f[x], {x, \(-length\), length}];\)\)}], "Input"], Cell["\<\ Next, we compute the Fourier coefficients using the formulations in your \ text.\ \>", "Text"], Cell[BoxData[ ButtonBox[ ButtonBox[ RowBox[{ StyleBox["\[MathematicaIcon]", FontSize->14, FontWeight->"Bold", FontColor->RGBColor[0.792981, 0.777356, 0.144533], FontVariations->{"CompatibilityType"->0}], StyleBox[" ", FontSize->14, FontWeight->"Bold", FontSlant->"Italic"], StyleBox["About", FontSize->14, FontWeight->"Bold", FontColor->RGBColor[0.500008, 0, 0.500008]], StyleBox[" ", FontSize->14, FontWeight->"Bold", FontSlant->"Italic"], StyleBox["Mathematica", FontSize->14, FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[0.500008, 0, 0.500008]]}], ButtonStyle->"Paste"], ButtonData:>"h1", ButtonStyle->"Hyperlink"]], "Input", Evaluatable->False, CellTags->"hb1"], Cell[BoxData[{ \(b[n_] := \(b[n] = 1/length\ Integrate[ Sin[n\ \ \[Pi]/2\ \ x] f[x], {x, \(-length\), length}]\)\t\), "\n", \(a[n_] := \(a[n] = 1/length\ Integrate[ Cos[n\ \[Pi]/2\ \ \ x] f[x], {x, \(-length\), length}]\)\)}], "Input"], Cell[TextData[{ "Now, we put these coefficients into the series formulas and go out to the \ ", Cell[BoxData[ \(TraditionalForm\`n = 10\)]], " term in both the sine and cosine components." }], "Text"], Cell[BoxData[{ \(\(foursine[x_, 10] = Sum[b[j]\ Sin[j\ \[Pi]/2\ \ x], {j, 1, 10}];\)\), "\n", \(\(fourcos[x_, 10] = a[0]/2 + Sum[a[j\ ] Cos[j\ \[Pi]/2\ \ x], {j, 1, 10}];\)\), "\n", \(all[x_, 10] = foursine[x, 10] + fourcos[x, 10]\)}], "Input"], Cell["\<\ I expect that you are glad that you did not have to calculate that by hand! \ Now, let's look at a plot of the function together with its Fourier series \ approximation.\ \>", "Text"], Cell[BoxData[{ \(\(Plot[{f[x], Evaluate[all[x, 10]]}, {x, \(-length\), length}, PlotStyle -> {RGBColor[0, 0, 1], RGBColor[1, 0, 0]}, AxesLabel -> {"\", "\"}]\ ;\)\), "\n", \(Print["\", length, "\< to x = \>", length, "\< is plotted in red.\>"]\), "\n", \(Print["\", \ N[all[x, 10]] // ComplexExpand]\)}], "Input"], Cell[TextData[{ "The ", StyleBox["ComplexExpand", FontWeight->"Bold"], " command in the last input expression shows the series in real form. \n\n\ What happens if you extend the plot further? You will notice that the Fourier \ Series repeats the pattern of the function over the interval [-2, 2], whereas \ the polynomial is not at all periodic." }], "Text"], Cell[BoxData[ \(\(Plot[{f[x], Evaluate[all[x, 10]]}, {x, \(-4\)\ length, 4\ length}, PlotRange -> {\(-20\), 20}, PlotStyle -> {RGBColor[0, 0, 1], RGBColor[1, 0, 0]}, AxesLabel -> {"\", "\"}]\ ;\)\)], "Input"], Cell["\<\ The Fourier series gives a reasonable approximation to the function over the \ interval [-2, 2], but outside that interval, anything can happen. The \ extended Fourier series is called the periodic extension of the function.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: Part I ", "Section"], Cell[TextData[StyleBox["Section 8.9, Exercises 5 and 15", FontWeight->"Bold"]], "Text"], Cell[TextData[{ "Find the Fourier series for the function ", Cell[BoxData[ FormBox[ RowBox[{ FractionBox[ FormBox[\(x\^\(2\ \)\), "TraditionalForm"], \(4\ \)], " "}], TraditionalForm]], FontSlant->"Italic"], " over the interval -\[Pi] to \[Pi]. The following will get you started." }], "Text"], Cell[BoxData[{ \(Clear[a, b, f, x, length, foursine, fourcos, all]\), "\n", \(f[x_] := x\^2/4\), "\n", \(\(length = \[Pi];\)\), "\n", \(b[n_] := \(b[n] = 1/length\ Integrate[ Sin[n\ \ x] f[x], {x, \(-length\), length}]\)\t\), "\n", \(a[n_] := \(a[n] = 1/length\ Integrate[ Cos[n\ \ x] f[x], {x, \(-length\), length}]\)\), "\n", \(\(foursine[x_, 10] = Sum[b[j]\ Sin[j\ x], {j, 1, 10}];\)\), "\n", \(\(fourcos[x_, 10] = a[0]/2 + Sum[a[j] Cos[j\ \ x], {j, 1, 10}];\)\), "\n", \(\(all[x_, n_] = foursine[x, 10] + fourcos[x, 10];\)\), "\n", \(\(Plot[{f[x], Evaluate[all[x, 10]]}, {x, \(-length\), length}, PlotStyle -> {RGBColor[0, 0, 1], RGBColor[1, 0, 0]}]\ ;\)\), "\n", \(Print["\", length, "\< to x = \>", length, "\< is plotted in red.\>"]\), "\n", \(Print["\", \ all[x, 10]]\)}], "Input"], Cell[TextData[{ "Use this result to verify that the series that converges to", Cell[BoxData[ FormBox[ FractionBox[ RowBox[{" ", FormBox[\(\[Pi]\^2\), "TraditionalForm"]}], "6"], TraditionalForm]]], " is 1 + ", Cell[BoxData[ \(TraditionalForm\`1\/4\)]], " + ", Cell[BoxData[ \(TraditionalForm\`1\/9\)]], " + ", Cell[BoxData[ \(TraditionalForm\`1\/16\)]], " + ", Cell[BoxData[ \(TraditionalForm\`1\/25\)]], " + . . . .\nWhat should you let ", StyleBox["x", FontSlant->"Italic"], " equal in your ", StyleBox["f[x]", FontSlant->"Italic"], " and in your Fourier series to get the desired result?" }], "Text"], Cell["\<\ Can you come up with the sum of any other infinite series by this method?\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Part II: Fourier Coefficients for the Sawtooth Function", "Section"], Cell[TextData[{ "Consider the Sawtooth Function to be essentially the line y = x over the \ interval 0 to 1, plus that segment repeated over and over. We can draw this \ by defining it using the ", StyleBox["Mod [x, 1]", FontWeight->"Bold"], " function. This maps every ", StyleBox["x", FontSlant->"Italic"], " onto the interval between 0 and 1. For example, if ", StyleBox["x", FontSlant->"Italic"], " is between 0 and 1, the function will be ", StyleBox["x", FontSlant->"Italic"], ". If ", StyleBox["x", FontSlant->"Italic"], " is between 1 and 2, the function will be ", Cell[BoxData[ \(TraditionalForm\`x - 1\)]], ", etc. Let's look at a graph of this function." }], "Text"], Cell[BoxData[{ \(Clear[a, b, x, n, f, g]\), "\n", \(g[x_] := Mod[x, 1]\), "\n", \(\(Plot[g[x], {x, \(-3\), 3}, PlotStyle -> RGBColor[0, 0, 1], AxesLabel -> {"\", "\"}];\)\)}], "Input"], Cell[TextData[{ "To compute Fourier coefficients for this function, we need to focus on the \ function over the interval ", Cell[BoxData[ \(TraditionalForm\`\(-1\)\)]], " to ", Cell[BoxData[ \(TraditionalForm\`\(+1\)\)]], ". The function is", Cell[BoxData[ \(TraditionalForm\`\(\ \((x + 1)\)\)\)]], " when ", Cell[BoxData[ \(TraditionalForm\`x\)]], " goes from ", Cell[BoxData[ \(TraditionalForm\`\(-1\)\)]], " to ", Cell[BoxData[ \(TraditionalForm\`0\)]], " and then becomes ", Cell[BoxData[ \(TraditionalForm\`x\)]], " when ", Cell[BoxData[ \(TraditionalForm\`x\)]], " goes from ", Cell[BoxData[ \(TraditionalForm\`0\)]], " to ", Cell[BoxData[ \(TraditionalForm\`\(+1\)\)]], ". Here we will put all our commands together and show the results at the \ end." }], "Text"], Cell[BoxData[{ \(Clear[a, b, x, length, foursine, fourcos, all]\), "\n", \(\(length = 1;\)\), "\n", \(b[n_] := \(b[n] = 1/length\ \((Integrate[ Sin[n\ Pi/length\ \ x] \((x + 1)\), {x, \(-length\), 0}] + \t\n Integrate[ Sin[n\ Pi/length\ \ x] x, {x, 0, length}])\)\)\), "\n", \(a[n_] := \(a[n] = 1/length\ \((Integrate[ Cos[n\ Pi/length\ \ x] \((x + 1)\), {x, \(-length\), 0}] + Integrate[ Cos[n\ Pi/length\ \ x] x, {x, 0, length}])\)\)\t\), "\n", \(\(foursine[x_, 20] = Sum[b[j]\ Sin[j\ Pi/length\ \ x], {j, 1, 20}];\)\), "\n", \(\(fourcos[x_, 20] = a[0]/2 + Sum[a[j] Cos[j\ Pi/length\ \ x], {j, 1, 20}];\)\), "\n", \(\(all[x_, 20] = foursine[x, 20] + fourcos[x, 20];\)\), "\n", \(\(Plot[{g[x], Evaluate[all[x, 20]]}, {x, \(-2\) length, 2 length}, PlotStyle -> {RGBColor[0, 0, 1], RGBColor[1, 0, 0]}, AxesLabel -> {x, function}];\)\), "\n", \(Print["\", length, "\< to x = \>", length, "\< is plotted in red.\>"]\), "\n", \(Print["\", \ all[x, 20]]\)}], "Input"], Cell["\<\ Since this is neither an even nor an odd function, we need both the sine and \ cosine series to fit the function. However, note that there is only one \ nonzero term in the Fourier cosine series. You should notice what is referred to as Gibbs' phenomenon. That refers to \ the poor (wiggly) fit at the points of discontinuity. There are far fewer \ wiggles over the continuous sections. This phenomenon would occur no matter \ how many terms we extended our series.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: Part II", "Section"], Cell[TextData[{ "Let's suppose you have a step function that takes on the value 0 from ", Cell[BoxData[ \(TraditionalForm\`\(-3\)\)]], " to 0 and then jumps up to ", Cell[BoxData[ \(TraditionalForm\`5\)]], " when ", StyleBox["x", FontSlant->"Italic"], " is between 0 and 3. First we will define the function and look at its \ graph. " }], "Text"], Cell[BoxData[ ButtonBox[ ButtonBox[ RowBox[{ StyleBox["\[MathematicaIcon]", FontWeight->"Bold", FontColor->RGBColor[0.792981, 0.777356, 0.144533], FontVariations->{"CompatibilityType"->0}], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["About", FontWeight->"Bold", FontColor->RGBColor[0.500008, 0, 0.500008]], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["Mathematica", FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[0.500008, 0, 0.500008]]}], ButtonStyle->"Paste"], ButtonData:>"h2", ButtonStyle->"Hyperlink"]], "Input", Evaluatable->False, CellTags->"hb2"], Cell[BoxData[{ \(Clear[g, x]\), "\n", \(\(g[x_] := 0 /; \(-3\) \[LessEqual] x \[LessEqual] 0;\)\), "\n", \(\(g[x_] := 5 /; 0 < x < 3;\)\t\), "\n", \(\(Plot[g[x], {x, \(-3\), 3}, PlotStyle -> RGBColor[0, 0, 1]];\)\)}], "Input"], Cell["\<\ Alter the expressions in red to generate the series you want for this \ function. For more efficient computation, we define the series out to 20 terms. If you \ want it out to more or fewer terms, change the terms in green.\ \>", "Text"], Cell[BoxData[{\(Clear[a, b, x, length, foursine, fourcos, all]\), "\n", RowBox[{ RowBox[{ RowBox[{"length", "=", StyleBox["1", FontColor->RGBColor[1, 0, 0]]}], ";"}], " "}], "\n", RowBox[{\(b[n_]\), ":=", RowBox[{\(b[n]\), "=", RowBox[{\(1/length\), " ", RowBox[{"(", RowBox[{ RowBox[{"Integrate", "[", RowBox[{ RowBox[{\(Sin[n\ Pi/length\ \ x]\), "*", StyleBox[\((x + 1)\), FontColor->RGBColor[1, 0, 0]]}], ",", \({x, \(-length\), 0}\)}], "]"}], "+", "\t", "\n", "\t\t\t\t", RowBox[{"Integrate", "[", RowBox[{ RowBox[{\(Sin[n\ Pi/length\ \ x]\), "*", StyleBox["x", FontColor->RGBColor[1, 0, 0]]}], ",", \({x, 0, length}\)}], "]"}]}], ")"}]}]}]}], "\n", RowBox[{ RowBox[{\(a[n_]\), ":=", RowBox[{\(a[n]\), "=", RowBox[{\(1/length\), " ", RowBox[{"(", RowBox[{ RowBox[{"Integrate", "[", RowBox[{ RowBox[{\(Cos[n\ Pi/length\ \ x]\), "*", StyleBox[\((x + 1)\), FontColor->RGBColor[1, 0, 0]]}], ",", \({x, \(-length\), 0}\)}], "]"}], "+", RowBox[{"Integrate", "[", RowBox[{ RowBox[{\(Cos[n\ Pi/length\ \ x]\), "*", StyleBox["x", FontColor->RGBColor[1, 0, 0]]}], ",", \({x, 0, length}\)}], "]"}]}], ")"}]}]}]}], "\t"}], "\[IndentingNewLine]", RowBox[{ RowBox[{"terms", " ", "=", " ", StyleBox["30", FontColor->RGBColor[0, 1, 0]]}], ";"}], "\n", \(foursine[x_, terms] = Sum[b[j]\ Sin[j\ Pi/length\ \ x], {j, 1, terms}];\), "\n", \(fourcos[ x_, terms] = a[0]/2 + Sum[a[j] Cos[j\ Pi/length\ \ x], {j, 1, terms}];\), "\n", \(all[x_, terms] = foursine[x, terms] + fourcos[x, terms];\), "\n", \(Plot[{g[x], Evaluate[all[x, terms]]}, {x, \(-length\), length}, PlotStyle -> {RGBColor[0, 0, 1], RGBColor[1, 0, 0]}, AxesLabel -> {x, function}];\), "\n", \(Print["\", length, "\< to x = \>", length, "\< is plotted in red.\>"]\), "\n", \(Print["\", \ all[x, terms]]\)}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Part III: Define a Function to be Either Even or Odd", "Section"], Cell[TextData[StyleBox["Section 8.10", FontWeight->"Bold"]], "Text"], Cell[TextData[{ "Sometimes, all we want is a Fourier series approximation for a function \ over an interval and we don't care about how the periodic extension of the \ function behaves. Consequently, we have the choice of constructing a Fourier \ series that is either even (cosine terms only) or odd (sine terms only). \ There may be a reason that you would choose to have only cosine terms or only \ sine terms to approximate the function. The following is an example of how \ you can do either. \nSuppose that the function for which we want the Fourier \ series takes on the value ", StyleBox["x", FontSlant->"Italic"], " for", Cell[BoxData[ FormBox[ RowBox[{" ", RowBox[{"(", RowBox[{"0", " ", "\[LessEqual]", " ", "x", " ", "<", " ", FormBox[\(1\/2\), "TraditionalForm"]}], ")"}]}], TraditionalForm]]], " and the value ", Cell[BoxData[ \(TraditionalForm\`1\/2\)]], " for ", Cell[BoxData[ FormBox[ RowBox[{"(", RowBox[{ FormBox[\(1\/2\), "TraditionalForm"], " ", "\[LessEqual]", " ", "x", " ", "<", " ", "1"}], ")"}], TraditionalForm]]], ".\nWe will begin by defining ", StyleBox["g[x]", FontSlant->"Italic"], " over the interval 0 to 1, and then we will extend the definition to an \ odd function and to an even function." }], "Text"], Cell[BoxData[{ \(Clear[g, x]\), "\n", \(\(g[x_] := x /; 0 \[LessEqual] x \[LessEqual] .5;\)\), "\n", \(\(g[x_] := .5 /; .5 < x < 1;\)\t\), "\n", \(\(Plot[g[x], {x, 0, 1}, PlotStyle -> RGBColor[0, 0, 1], AxesLabel -> {x, function}];\)\), "\n", \(\(godd[ x_] := \(- .5\) /; \(-1\) \[LessEqual] x \[LessEqual] \(- .5\);\)\), "\n", \(\(godd[x_] := x /; \(- .5\) \[LessEqual] x \[LessEqual] 0;\)\), "\n", \(\(godd[x_] := x /; 0 \[LessEqual] x \[LessEqual] .5;\)\), "\n", \(\(godd[x_] := .5 /; .5 \[LessEqual] x \[LessEqual] 1;\)\), "\n", \(\(Plot[godd[x], {x, \(-1\), 1}, PlotStyle -> RGBColor[0, 1, .5], AxesLabel -> {x, odd\ function}];\)\), "\n", \(\(geven[ x_] := .5 /; \(-1\) \[LessEqual] x \[LessEqual] \(- .5\);\)\), "\n", \(\(geven[ x_] := \(-x\) /; \(- .5\) \[LessEqual] x \[LessEqual] 0;\)\), "\n", \(\(geven[x_] := x /; 0 \[LessEqual] x \[LessEqual] .5;\)\), "\n", \(\(geven[x_] := .5 /; .5 \[LessEqual] x \[LessEqual] 1;\)\), "\n", \(\(Plot[geven[x], {x, \(-1\), 1}, PlotStyle -> RGBColor[1, 0, 1], AxesLabel -> {x, even\ function}];\)\)}], "Input"], Cell[TextData[{ "Here we will call upon the simplified formulas used when you are looking \ only for a sine or only for a cosine series. We double the integrals, but \ integrate over only half the interval. We will go to ", Cell[BoxData[ \(TraditionalForm\`n\ = \ 20\)]], " in both the sine and cosine series for these evaluations." }], "Text"], Cell[BoxData[{ \(Clear[a, b, x, fousine, fourcos]\), "\n", \(\(length\ = \ 1;\)\), "\n", \(b[n_] := \(b[n] = 2/length\ \((Integrate[ Sin[n\ \[Pi]/length\ \ x]\ \ x, {x, 0, length/2}] + Integrate[ Sin[n\ \[Pi]/length\ \ x]*0.5, {x, length/2, length}])\)\)\t\t\), "\n", \(a[n_] := \(a[n] = 2/length\ \((Integrate[ Cos[n\ \[Pi]/length\ \ x]\ \ x, {x, 0, length/2}] + Integrate[ Cos[n\ \[Pi]/length\ \ x]*0.5, {x, length/2, length}])\)\)\t\t\), "\n", \(\(foursine[x_, 20] = Sum[b[j]\ Sin[j\ \[Pi]\ /length\ x], {j, 1, 20}];\)\), "\n", \(\(fourcos[x_, 20] = a[0]/2 + Sum[a[j] Cos[j\ \[Pi]/length\ x], {j, 1, 20}];\)\), "\n", \(\(Plot[{godd[x], Evaluate[foursine[x, 20]]}, {x, \(-length\), length}, PlotStyle -> {RGBColor[0, .5, 1], RGBColor[1, 0, 0]}, AxesLabel -> {x, odd\ function}];\)\), "\n", \(Print["\", foursine[x, 20] // N]\), "\n", \(\(Plot[{geven[x], Evaluate[fourcos[x, 20]]}, {x, \(-length\), length}, PlotStyle -> {RGBColor[ .8, 0, 1], RGBColor[1, 0, 0]}, AxesLabel -> {x, even\ function}, PlotRange -> All];\)\), "\n", \(Print["\", fourcos[x, 20] // N]\)}], "Input"], Cell["\<\ Note that both the sine and the cosine expansions fit the function over the \ interval 0 to 1, but, over a broader range, one is even and one is odd. The \ cosine series seems to be a better fit.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["You Try It - Part III ", "Section"], Cell[TextData[StyleBox["Section 8.10, Exercises 8 and 16", FontWeight->"Bold"]], "Text"], Cell[TextData[{ "Find both a Fourier sine series and cosine series expansion for the \ function ", Cell[BoxData[ \(TraditionalForm\`\(\ \(| 2 x\ - \ \[Pi] | \)\)\)]], " over the interval 0 to \[Pi]. We could simply define the function as \ given, but, for clarity in plotting, we will define both its even counterpart \ and its odd counterpart over the interval -\[Pi] to \[Pi]. Note that this can \ be done by shifting the function to the left a distance of \[Pi] units." }], "Text"], Cell[BoxData[{ \(Clear[geven, godd]\), "\n", \(\(geven[x_] := Abs[2 \((x + \[Pi])\) - \[Pi]] /; \(-\[Pi]\) \[LessEqual] x < 0;\)\), "\n", \(\(geven[x_] := Abs[2 x - \[Pi]] /; 0 \[LessEqual] x < \[Pi];\)\), "\n", \(\(Plot[geven[x], {x, \(-\[Pi]\), \[Pi]}, PlotStyle -> RGBColor[1, 0, 1], AxesLabel -> {x, even\ function}];\)\), "\n", \(\(godd[ x_] := \(-Abs[ 2 \((x + \[Pi])\) - \[Pi]]\) /; \(-\[Pi]\) \[LessEqual] x < 0;\)\), "\n", \(\(godd[x_] := Abs[2 x - \[Pi]] /; 0 \[LessEqual] x < \[Pi];\)\), "\n", \(\(Plot[godd[x], {x, \(-\[Pi]\), \[Pi]}, PlotStyle -> RGBColor[0, 1, .5], AxesLabel -> {x, odd\ function}];\)\)}], "Input"], Cell[TextData[{ "Note that this function is", Cell[BoxData[ \(TraditionalForm\`\(\ \(-\((2 x\ - \ \[Pi])\)\)\)\)]], " between 0 and \[Pi]/2 but ", Cell[BoxData[ \(TraditionalForm\`\(+\((2 x\ - \ \[Pi])\)\)\)]], " from \[Pi]/2 to \[Pi]. Insert the appropriate expressions for the terms \ in red." }], "Text"], Cell[BoxData[{\(Clear[a, b, x, n, foursine, fourcos]\), "\n", RowBox[{ RowBox[{"length", "=", StyleBox["1", FontColor->RGBColor[1, 0, 0]]}], ";", "\n", RowBox[{\(b[n_]\), ":=", RowBox[{\(b[n]\), "=", RowBox[{\(2/length\), " ", RowBox[{"(", RowBox[{ RowBox[{"Integrate", "[", RowBox[{ RowBox[{\(Sin[n\ \[Pi]/length\ \ x]\), RowBox[{"(", StyleBox[\(-\((x)\)\), FontColor->RGBColor[1, 0, 0]], ")"}]}], ",", \({x, 0, length/2}\)}], "]"}], "\t", "+", RowBox[{"Integrate", "[", RowBox[{ RowBox[{\(Sin[n\ \[Pi]/length\ \ x]\), StyleBox[\((x)\), FontColor->RGBColor[1, 0, 0]]}], ",", \({x, length/2, length}\)}], "]"}]}], ")"}]}]}]}]}], "\n", RowBox[{ RowBox[{\(a[n_]\), ":=", RowBox[{\(a[n]\), "=", RowBox[{\(2/length\), " ", RowBox[{"(", RowBox[{ RowBox[{"Integrate", "[", RowBox[{ RowBox[{\(Cos[n\ \[Pi]/length\ \ x]\), RowBox[{"(", StyleBox[\(-\((x)\)\), FontColor->RGBColor[1, 0, 0]], ")"}]}], ",", \({x, 0, length/2}\)}], "]"}], "+", RowBox[{"Integrate", "[", RowBox[{ RowBox[{\(Cos[n\ \[Pi]/length\ \ x]\), StyleBox[\((x)\), FontColor->RGBColor[1, 0, 0]]}], ",", \({x, length/2, length}\)}], "]"}]}], ")"}]}]}]}], "\t "}], "\n", \(fourcos[x_, 20] = N[a[0]/2 + Sum[a[j] Cos[j\ \[Pi]/length\ \ x], {j, 1, 20}]];\), "\n", RowBox[{\(Plot[{geven[x], Evaluate[fourcos[x, 20]]}, {x, \(-length\), length}, AxesLabel -> {x, even\ function}, PlotStyle -> {RGBColor[1, 0, 1], RGBColor[0, 0, 1]}, PlotRange -> All];\), " \t"}], "\n", RowBox[{\(Print["\", fourcos[x, 20]]\), " "}], "\n", \(foursine[x_, 20] = N[Sum[b[j]\ Sin[j\ \[Pi]/length\ \ x], {j, 1, 20}]];\), "\n", \(Plot[{godd[x], Evaluate[foursine[x, 20]]}, {x, \(-length\), length}, AxesLabel -> {x, odd\ function}, PlotStyle -> {RGBColor[0, 1, .5], RGBColor[0, 0, 1]}, PlotRange -> All];\), "\n", \(Print["\", foursine[x, 20]]\)}], "Input"], Cell["\<\ Is the cosine function a better fit again? Try this with other functions.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Part IV: Analyze Musical Tones of a Clarinet ", "Section"], Cell[TextData[{ "The harmonies in mathematics are heard in musical instruments such as the \ piano and clarinet and are seen in the Fourier Series of the form:", StyleBox[" ", FontSize->9], Cell[BoxData[ \(TraditionalForm \`\(a[0] + a[1]\ Cos[\(2\ \[Pi]\ 1\ t\)\/\[Lambda]] + b[1]\ Sin[\(2\ \[Pi]\ 1\ t\)\/\[Lambda]] + a[2]\ Cos[\(2\ \[Pi]\ 2\ t\)\/\[Lambda]] + b[2]\ Sin[\(2\ \[Pi]\ 2\ t\)\/\[Lambda]] + ... \) + a[n]\ Cos[\(2\ \[Pi]\ n\ t\)\/\[Lambda]] + b[n]\ Sin[\(2\ \[Pi]\ n\ t\)\/\[Lambda]]\)]], ".\nA group of students from Carroll College in Montana recorded musical \ tones from a clarinet and from a piano using a sound sensor that interfaces \ with a graphing calculator. The recorded signals represent a measure of the \ loudness of the tones as a function of time. After sampling the tones and \ graphically observing the periodic pattern, the students selected what \ appeared to be approximately one period of the signal and then used Riemann \ sums to approximate the integrals for the Fourier coefficients. The following \ data sets are those that were collected by the students. Lambda (\[Lambda]) \ represents the length of the interval selected for what appears to be one \ period in the recorded signal. Increasing the number of Fourier terms gives \ better approximations of the signal." }], "Text"], Cell[TextData[{ "First, we look at all the sample points collected when the note A is \ played on a clarinet. You can hear the recording of the sound itself with the \ ", StyleBox["Mathematica", FontSlant->"Italic"], " ", StyleBox["ListPlay", FontWeight->"Bold"], " command, provided your speakers are turned on. It is a very short tone." }], "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{ StyleBox["clarinet", FontSize->12], StyleBox["=", FontSize->12], StyleBox[\({2.27817, 2.40131, 2.57483, 2.642, 2.63081, 2.59722, 2.53005, 2.51886, 2.58603, 2.53005, 2.49087, 2.47408, 2.37892, 2.34534, 2.36213, 2.33974, 2.33414, 2.37892, 2.4293, 2.44609, 2.38452, 2.36213, 2.29496, 2.27817, 2.27817, 2.25578, 2.31175, 2.54684, 2.78753, 2.82112, 2.83231, 2.82112, 2.68678, 2.6476, 2.58043, 2.49087, 2.43489, 2.39012, 2.40691, 2.4125, 2.45169, 2.51326, 2.57483, 2.69238, 2.74835, 2.69238, 2.66999, 2.65879, 2.62521, 2.69238, 2.74276, 2.69798, 2.68118, 2.69238, 2.81552, 2.80992, 2.59722, 2.54125, 2.39571, 2.25578, 2.25578, 2.21659, 2.26137, 2.36773, 2.53565, 2.642, 2.63081, 2.60282, 2.54125, 2.50766, 2.56923, 2.55244, 2.49647, 2.48527, 2.40131, 2.33414, 2.36213, 2.33974, 2.33414, 2.36773, 2.4237, 2.45169, 2.40131, 2.35653, 2.30615, 2.27257, 2.28376, 2.26137, 2.29496, 2.47408, 2.74835, 2.82672, 2.81552, 2.83791, 2.70917, 2.6532, 2.60282, 2.50766, 2.44049, 2.39012, 2.39012, 2.4125, 2.44049, 2.50206, 2.56364, 2.66439, 2.74835, 2.70917, 2.66439, 2.66999, 2.63081, 2.67559, 2.74276, 2.70357, 2.68118, 2.67559, 2.77074, 2.8547, 2.6364, 2.55244, 2.44609, 2.27817, 2.25578, 2.22219, 2.23898, 2.34534, 2.49647, 2.6364, 2.6364, 2.60842, 2.56364, 2.50206, 2.54684, 2.58043, 2.50206, 2.49087, 2.4293, 2.33974, 2.35093, 2.35093, 2.32854, 2.35653, 2.4125, 2.45169, 2.4125, 2.36213, 2.32854, 2.27257, 2.28376, 2.26697, 2.27257, 2.4293, 2.69798, 2.82112, 2.80433, 2.83791, 2.73716, 2.65879, 2.61961, 2.53005, 2.45169, 2.39571, 2.39012, 2.40691, 2.4293, 2.49087, 2.54125, 2.642, 2.73156, 2.72037, 2.65879, 2.67559, 2.6364, 2.65879, 2.73156, 2.71477, 2.67559, 2.67559, 2.73716, 2.8603, 2.68118, 2.56364, 2.48527, 2.30615, 2.26137, 2.23339, 2.22219, 2.31735, 2.45169, 2.61401, 2.642, 2.61401, 2.57483, 2.50206, 2.53565, 2.58603, 2.50766, 2.49087, 2.44609, 2.35093, 2.34534, 2.35093, 2.32854, 2.33974, 2.39571, 2.44049, 2.4237, 2.36773, 2.33414, 2.27817, 2.27817, 2.27257, 2.26697, 2.37332, 2.61961, 2.81552, 2.80433, 2.83231, 2.76514, 2.66439, 2.63081, 2.55244, 2.46848, 2.4125, 2.39012, 2.40691, 2.4181, 2.46848, 2.53005, 2.60842, 2.70917, 2.73716, 2.66439, 2.66999, 2.6476, 2.6476, 2.71477, 2.72596, 2.68118, 2.66999, 2.70917, 2.84911, 2.74835, 2.56364, 2.51326, 2.33974, 2.25018, 2.23898, 2.21659, 2.29496, 2.4125, 2.58603, 2.642, 2.62521, 2.58603, 2.51326, 2.51326, 2.58603, 2.53005, 2.49087, 2.46848, 2.37332, 2.33414, 2.35093, 2.33974, 2.33974, 2.38452, 2.43489, 2.44049, 2.37332, 2.34534, 2.28936, 2.27257, 2.27257, 2.26137, 2.33974, 2.56364, 2.79873, 2.79873, 2.80992, 2.79873, 2.68118, 2.6476, 2.58043, 2.48527, 2.4181, 2.37892, 2.39571, 2.4125, 2.45728, 2.51886, 2.59162, 2.69798, 2.74276, 2.67559, 2.65879, 2.6532, 2.6364, 2.70357, 2.73716, 2.68678, 2.66999, 2.68678, 2.81552, 2.79873, 2.58603, 2.53565, 2.37892, 2.25578, 2.24458, 2.211, 2.26697, 2.38452, 2.54684, 2.6476, 2.62521, 2.59162, 2.53565, 2.50766, 2.56923, 2.55244, 2.48527, 2.47408, 2.39571, 2.33414, 2.35093, 2.33974, 2.33414, 2.36773, 2.4237, 2.44609, 2.39012, 2.34534, 2.30615, 2.26697, 2.27817, 2.25578, 2.30615, 2.49647, 2.76514, 2.81552, 2.80433, 2.82112, 2.69798, 2.6476, 2.59722, 2.49647, 2.43489, 2.38452, 2.39012, 2.40691, 2.44049, 2.50766, 2.56923, 2.66999, 2.74276, 2.69238, 2.6532, 2.66439, 2.62521, 2.68118, 2.73716, 2.69238, 2.66999, 2.67559, 2.78753, 2.83231, 2.60282, 2.54684, 2.4237, 2.26137, 2.25578, 2.21659, 2.24458, 2.35653, 2.50766, 2.6364, 2.62521, 2.59722, 2.54684, 2.50206, 2.55804, 2.56364, 2.49087, 2.48527, 2.4125, 2.32854, 2.35093, 2.33974, 2.32854, 2.35653, 2.4125, 2.45169, 2.40131, 2.35093, 2.31175, 2.26697, 2.27817, 2.26697, 2.28936, 2.44609, 2.71477, 2.81552, 2.79313, 2.82672, 2.72037, 2.6476, 2.61401, 2.51886, 2.45169, 2.39571, 2.38452, 2.40131, 2.4237, 2.49087, 2.55244, 2.642, 2.73156, 2.70917, 2.6532, 2.66999, 2.63081, 2.65879, 2.73156, 2.70917, 2.66999, 2.66999, 2.75395, 2.84351, 2.642, 2.56364, 2.46288, 2.28376, 2.25018, 2.22219, 2.23339, 2.32854, 2.47408, 2.62521, 2.63081, 2.61401, 2.56364, 2.50206, 2.53565, 2.56923, 2.50766, 2.49647, 2.43489, 2.34534, 2.35093, 2.34534, 2.32854, 2.34534, 2.40131, 2.44049, 2.4181, 2.36213, 2.32854, 2.27257, 2.27817, 2.26137, 2.27817, 2.40131, 2.6532, 2.81552, 2.79313, 2.82672, 2.74276, 2.6532, 2.62521, 2.53565, 2.45728, 2.40691, 2.37892, 2.40131, 2.4181, 2.47408, 2.54125, 2.61961, 2.72037, 2.72596, 2.6532, 2.66439, 2.63081, 2.642, 2.72037, 2.71477, 2.67559, 2.66999, 2.70917, 2.8547, 2.69798, 2.55244, 2.49647, 2.32295, 2.25578, 2.22779, 2.21659, 2.31175, 2.4237, 2.59722, 2.6364, 2.61961, 2.58043, 2.50206, 2.51886, 2.58043, 2.50766, 2.48527, 2.45169, 2.35653, 2.33974}\), FontSize->10]}], StyleBox[";", FontSize->10], "\n", \(ListPlay[clarinet]\), ";"}]], "Input"], Cell["\<\ To get a clearer understanding of the signal you are hearing, let's look at a \ graph of the signal with the points connected. Note the periodic behavior of \ the musical tone. The units on the vertical axis represent the sound levels \ in the units recorded by the particular sound sensor. \ \>", "Text"], Cell[BoxData[ \(\(ListPlot[clarinet, PlotJoined \[Rule] True];\)\)], "Input"], Cell[TextData[{ "The students chose the points 129 to 177 to represent one period. Does \ that look about right? That means that the interval will be of length ", Cell[BoxData[ \(TraditionalForm\`\[Lambda]\ = \ 177\ - \ 129\)]], "." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ \(Clear[period]\), "\n", \(\(start = 129;\)\), "\n", \(\(stop = 177;\)\), "\n", \(\(\[Lambda] = stop - start;\)\), "\n", \(\(period = Table[clarinet\[LeftDoubleBracket]c\[RightDoubleBracket], {c, start, stop}];\)\), "\n", \(\(clarinetplot = ListPlot[period, PlotRange \[Rule] {{1, \[Lambda] + 1}, {2, 3}}, PlotJoined \[Rule] True, AxesLabel -> {count, "\"}, AxesOrigin -> {0, 2.2}, PlotStyle -> RGBColor[0, 0, 1]];\)\)}], "Input"], Cell[TextData[ "We want to get a Fourier series approximation for the set of points you see \ in the graph. In what follows, note the use of Riemann sums rather than \ integrals to approximate the Fourier coefficients. Because you have a set of \ discrete values (assigned to the symbol period) instead of a mathematical \ function to approximate, you can estimate the areas of each small rectangle \ to be the width of the rectangle (1/\[Lambda]) times the appropriate height \ (sound sensor values as in the above graph). Adding up these areas gives \ approximations to the integrals over the interval of length \[Lambda]."], "Text"], Cell[BoxData[{ \(Clear[a, b, n, t, terms, clarinetfour]\), "\n", \(\(terms = 20;\)\), "\n", \(a[0] = \(\[Sum]\+\(t = 1\)\%\[Lambda] period\[LeftDoubleBracket]t\ \[RightDoubleBracket]\)\/\[Lambda]; a[n_] := \(a[ n] = \(2 \(\[Sum]\+\(t = 1\)\%\[Lambda] period\[LeftDoubleBracket]t\ \[RightDoubleBracket]\ N[Cos[\(2\ \[Pi]\ n\ t\)\/\[Lambda]]]\)\)\/\[Lambda]\)\ \), "\n", \(b[n_] := \(b[ n] = \(2\ \(\[Sum]\+\(t = 1\)\%\[Lambda] \ period\[LeftDoubleBracket]t\[RightDoubleBracket]\ N[Sin[\(2\ \[Pi]\ n\ t\)\/\ \[Lambda]]]\)\)\/\[Lambda]\)\), "\n", \(\(clarinetfour[t_] = N[a[0] + \[Sum]\+\(n = 1\)\%terms\((a[ n]\ Cos[\(2\ \[Pi]\ n\ t\)\/\[Lambda]] + b[n]\ Sin[\(2\ \[Pi]\ n\ t\)\/\[Lambda]])\)];\)\)}], "Input",\ PageWidth->PaperWidth], Cell["Now we can see what our simulated clarinet plot looks like. ", "Text"], Cell[BoxData[{ \(\(clarinetfourplot = Plot[Evaluate[clarinetfour[t]], {t, 1, \[Lambda] + 1}, PlotStyle \[Rule] {RGBColor[1, 0, 0]}, AxesLabel -> {count, "\"}, AxesOrigin -> {0, 2.2}, DisplayFunction -> Identity];\)\), "\n", \(\(Show[clarinetplot, clarinetfourplot, DisplayFunction -> $DisplayFunction];\)\), "\n", \(Print["\"]\)}], "Input", PageWidth->PaperWidth], Cell["\<\ Based upon what we have done, do you think that the Fourier series we found \ can be used to reproduce the sound of a note? To learn more about this, you \ might check into the way in which music synthesizers work and the technique \ used to replicate a phone number dialed on a touch-tone phone. The important \ point to gather from all this is that periodic phenomena, discrete or \ continuous, can be approximated by Fourier series representation.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["You Try It: Part IV: The Piano", "Section", PageWidth->PaperWidth], Cell[TextData[{ "As with the clarinet example, first we look at and listen to all the \ sample points collected when middle", Cell[BoxData[ \(TraditionalForm\`-\)]], "C is played on a piano." }], "Text", PageWidth->PaperWidth], Cell[BoxData[{ RowBox[{ RowBox[{"piano", "=", StyleBox[\({2.50766, 2.51326, 2.51326, 2.51886, 2.52445, 2.52445, 2.52445, 2.53005, 2.54125, 2.55244, 2.56364, 2.56364, 2.55244, 2.54684, 2.53565, 2.53005, 2.51886, 2.51326, 2.50206, 2.49647, 2.48527, 2.47967, 2.46848, 2.45169, 2.43489, 2.4237, 2.4237, 2.4293, 2.44049, 2.45169, 2.46288, 2.47967, 2.49647, 2.51326, 2.53565, 2.55244, 2.56923, 2.58043, 2.58603, 2.59722, 2.59722, 2.58603, 2.58043, 2.56364, 2.55244, 2.53565, 2.53005, 2.51886, 2.50766, 2.50206, 2.49647, 2.50206, 2.51326, 2.51886, 2.52445, 2.52445, 2.51326, 2.50766, 2.50766, 2.50766, 2.50206, 2.50206, 2.50766, 2.50766, 2.51326, 2.51886, 2.52445, 2.52445, 2.52445, 2.53005, 2.54125, 2.55244, 2.56364, 2.55804, 2.55244, 2.54125, 2.53565, 2.52445, 2.51886, 2.51326, 2.50206, 2.49647, 2.48527, 2.47967, 2.46848, 2.45169, 2.43489, 2.4237, 2.4237, 2.4293, 2.44049, 2.45169, 2.46288, 2.47408, 2.49087, 2.51326, 2.53005, 2.55244, 2.56364, 2.57483, 2.58603, 2.59162, 2.59162, 2.58603, 2.57483, 2.56364, 2.55244, 2.53565, 2.52445, 2.51886, 2.50766, 2.49647, 2.49647, 2.50206, 2.51326, 2.51886, 2.52445, 2.51886, 2.51326, 2.50766, 2.50766, 2.50766, 2.50206, 2.50206, 2.50206, 2.50766, 2.51326, 2.51886, 2.51886, 2.51886, 2.52445, 2.53005, 2.54125, 2.55244, 2.56364, 2.55804, 2.55244, 2.54125, 2.53565, 2.52445, 2.51886, 2.51326, 2.50206, 2.49647, 2.48527, 2.47967, 2.46848, 2.45169, 2.44049, 2.4293, 2.4237, 2.4293, 2.44049, 2.45169, 2.46288, 2.47408, 2.49087, 2.51326, 2.53005, 2.54684, 2.56364, 2.57483, 2.58603, 2.59162, 2.59162, 2.58603, 2.57483, 2.56364, 2.54684, 2.53565, 2.52445, 2.51326, 2.50766, 2.49647, 2.49647, 2.50206, 2.50766, 2.51886, 2.52445, 2.51886, 2.51326, 2.50766, 2.50766, 2.50206, 2.50206, 2.50206, 2.50206, 2.50766, 2.50766, 2.51886, 2.51886, 2.51886, 2.51886, 2.52445, 2.53565, 2.55244, 2.55804, 2.55804, 2.55244, 2.54125, 2.53005, 2.52445, 2.51886, 2.51326, 2.50206, 2.49087, 2.48527, 2.47408, 2.46288, 2.45169, 2.43489, 2.4237, 2.4181, 2.4237, 2.43489, 2.45169, 2.46288, 2.47408, 2.49087, 2.50766, 2.53005, 2.54684, 2.55804, 2.56923, 2.58603, 2.58603, 2.58603, 2.58603, 2.57483, 2.55804, 2.54684, 2.53565, 2.52445, 2.51326, 2.50206, 2.49647, 2.49647, 2.50206, 2.50766, 2.51886, 2.52445, 2.51886, 2.51326, 2.50766, 2.50766, 2.50206, 2.50206, 2.50206, 2.50206, 2.50766, 2.51326, 2.51326, 2.51886, 2.51886, 2.51886, 2.53005, 2.53005, 2.55244, 2.55804, 2.55804, 2.55244, 2.54125, 2.53565, 2.52445, 2.51886, 2.50766, 2.50206, 2.49087, 2.48527, 2.47967, 2.46288, 2.45169, 2.43489, 2.4237, 2.4237, 2.4293, 2.44049, 2.45169, 2.46288, 2.47408, 2.49087, 2.51326, 2.53005, 2.54684, 2.55804, 2.56923, 2.58043, 2.58603, 2.58603, 2.58043, 2.56923, 2.55804, 2.54684, 2.53565, 2.52445, 2.51326, 2.50206, 2.49647, 2.49647, 2.49647, 2.50766, 2.51886, 2.51886, 2.51886, 2.51326, 2.50766, 2.50766, 2.50206, 2.49647, 2.49647, 2.50206, 2.50766, 2.50766, 2.51326, 2.51326, 2.51326, 2.51886, 2.52445, 2.53565, 2.54684, 2.55244, 2.55244, 2.54684, 2.54125, 2.53005, 2.52445, 2.51886, 2.51326, 2.50206, 2.49647, 2.48527, 2.47408, 2.46288, 2.45169, 2.43489, 2.4237, 2.4181, 2.4293, 2.43489, 2.45169, 2.45728, 2.47408, 2.48527, 2.50766, 2.52445, 2.54125, 2.55804, 2.56923, 2.58043, 2.58603, 2.58603, 2.58043, 2.56923, 2.55244, 2.54125, 2.53565, 2.52445, 2.51326, 2.50206, 2.49647, 2.49647, 2.50206, 2.50766, 2.51886, 2.51886, 2.51886, 2.51326, 2.50766, 2.50766, 2.50206, 2.49647, 2.49647, 2.50206, 2.50206, 2.50766, 2.51326, 2.51326, 2.51326, 2.51886, 2.52445, 2.53565, 2.54684, 2.55244, 2.55244, 2.54684, 2.53565, 2.53005, 2.52445, 2.51326, 2.50766, 2.50206, 2.49087, 2.48527, 2.47408, 2.46288, 2.44609, 2.43489, 2.4237, 2.4181, 2.4237, 2.43489, 2.44609, 2.45728, 2.46848, 2.48527, 2.50766, 2.52445, 2.54125, 2.55244, 2.56923, 2.57483, 2.58043, 2.58603, 2.58043, 2.56923, 2.55804, 2.54125, 2.53565, 2.52445, 2.51326, 2.50206, 2.49647, 2.49647, 2.50206, 2.51326, 2.51886, 2.51886, 2.51326, 2.51326, 2.50766, 2.50206, 2.50206, 2.49647, 2.49647, 2.49647, 2.50206, 2.50766, 2.51326, 2.51326, 2.51326, 2.51326, 2.52445, 2.53565, 2.54684, 2.55244, 2.54684, 2.54125, 2.53565, 2.53005, 2.52445, 2.51886, 2.50766, 2.50206, 2.49087, 2.48527, 2.47967, 2.46288, 2.45169, 2.43489, 2.4237, 2.4237, 2.4293, 2.43489, 2.44609, 2.45728, 2.46848, 2.48527, 2.50766, 2.52445, 2.54125, 2.55244, 2.56364, 2.57483, 2.58043, 2.58043, 2.57483, 2.56364, 2.55244, 2.54125, 2.53005, 2.51886, 2.50766, 2.49647, 2.49087, 2.49087, 2.49647, 2.50766, 2.51326, 2.51886, 2.51326, 2.51326, 2.50766, 2.50766, 2.50206, 2.49647, 2.49647, 2.49647, 2.50206, 2.50766, 2.51326, 2.50766, 2.51326, 2.51326, 2.51886, 2.53005, 2.54684, 2.54684, 2.54684, 2.54125, 2.53565, 2.52445, 2.51886}\), FontSize->10]}], StyleBox[";", FontSize->10]}], "\[IndentingNewLine]", \(ListPlot[piano, PlotJoined \[Rule] True];\), "\[IndentingNewLine]", \(ListPlay[ piano];\)}], "Input", PageWidth->PaperWidth, FontFamily->"Courier New", FontSize->12, FontWeight->"Bold", FontColor->GrayLevel[0], Background->GrayLevel[1]], Cell["\<\ The students chose the points 90 to 152 to represent one period. Does this \ look about right? Note that this makes the period for the note C slightly longer than for the \ note A. Might this have anything to do with the notes themselves?\ \>", "Text", PageWidth->PaperWidth], Cell[BoxData[ RowBox[{ RowBox[{"start", "=", StyleBox["90", FontColor->RGBColor[1, 0, 0]]}], ";", "\n", RowBox[{"stop", "=", StyleBox["152", FontColor->RGBColor[1, 0, 0]]}], ";", "\n", \(\[Lambda] = stop - start\), ";", "\n", \(period = Table[piano\[LeftDoubleBracket]c\[RightDoubleBracket], {c, start, stop}]\), ";", "\n", \(pianoplot = ListPlot[period, PlotRange \[Rule] {{0, \[Lambda] + 1}, {2.4, 2.6}}, AxesLabel -> {count, "\"}, AxesOrigin -> {0, 2.4}, PlotJoined \[Rule] True, PlotStyle -> RGBColor[0, 1, 0]]\), ";"}]], "Input", PageWidth->PaperWidth], Cell[BoxData[{ \(Clear[a, b, n, t, terms, clarinetfour]\), "\n", \(\(terms = 30;\)\), "\n", \(a[0] = \(\[Sum]\+\(t = 1\)\%\[Lambda] period\[LeftDoubleBracket]t\ \[RightDoubleBracket]\)\/\[Lambda]; a[n_] := \(a[ n] = \(2 \(\[Sum]\+\(t = 1\)\%\[Lambda] period\[LeftDoubleBracket]t\ \[RightDoubleBracket]\ N[Cos[\(2\ \[Pi]\ n\ t\)\/\[Lambda]]]\)\)\/\[Lambda]\)\ \), "\n", \(b[n_] := \(b[ n] = \(2\ \(\[Sum]\+\(t = 1\)\%\[Lambda] \ period\[LeftDoubleBracket]t\[RightDoubleBracket]\ N[Sin[\(2\ \[Pi]\ n\ t\)\/\ \[Lambda]]]\)\)\/\[Lambda]\)\), "\n", \(\(pianofour[t_] = N[a[0] + \[Sum]\+\(n = 1\)\%terms\((a[ n]\ Cos[\(2\ \[Pi]\ n\ t\)\/\[Lambda]] + b[n]\ Sin[\(2\ \[Pi]\ n\ t\)\/\[Lambda]])\)];\)\)}], "Input",\ PageWidth->PaperWidth], Cell[BoxData[{ \(\(pianofourplot = Plot[Evaluate[pianofour[t]], {t, 1, \[Lambda]}, PlotStyle \[Rule] {RGBColor[1, 0, 0]}, AxesLabel -> {count, "\"}, AxesOrigin -> {0, 2.4}, DisplayFunction -> Identity];\)\), "\n", \(\(Show[pianoplot, pianofourplot, DisplayFunction -> $DisplayFunction];\)\), "\n", \(Print["\"]\)}], "Input", PageWidth->PaperWidth], Cell["\<\ Compare the clarinet and the piano. The clarinet is in blue and the piano is \ in green in the following graph.\ \>", "Text"], Cell[BoxData[ \(\(Show[clarinetplot, pianoplot, PlotRange -> All];\)\)], "Input"], Cell["\<\ Why might the piano tone be smoother than the clarinet tone? Listen to their \ sounds in succession.\ \>", "Text"], Cell[BoxData[{ \(\(ListPlay[clarinet];\)\), "\n", \(\(ListPlay[piano];\)\)}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ StyleBox["\[MathematicaIcon]", FontWeight->"Bold", FontColor->RGBColor[0.792981, 0.777356, 0.144533], FontVariations->{"CompatibilityType"->0}], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["About", FontWeight->"Bold", FontColor->RGBColor[0.500008, 0, 0.500008]], StyleBox[" ", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["Mathematica", FontWeight->"Bold", FontSlant->"Italic", FontColor->RGBColor[0.500008, 0, 0.500008]] }], "Section", CellDingbat->None], Cell[TextData[{ StyleBox["NOTE:", FontWeight->"Bold"], " The following double assignment terminology, ", StyleBox["b[n_]:= b[n] = ....", FontWeight->"Bold", FontSlant->"Italic"], " , forces ", StyleBox["Mathematica", FontSlant->"Italic"], " to \"remember\" the value of ", StyleBox["b[n]", FontSlant->"Italic"], " for each value of ", StyleBox["n", FontSlant->"Italic"], ", making subsequent computations that repeatedly use", StyleBox[" b[n]", FontSlant->"Italic"], " much more efficient. If you decide to enter a new function, ", StyleBox["be sure that you Clear a and b first", FontWeight->"Bold"], ".\n", ButtonBox["Go back.", ButtonData:>"hb1", ButtonStyle->"Hyperlink"] }], "Text", CellTags->"h1"], Cell[TextData[{ "There are many ways to define piecewise continuous functions in ", StyleBox["Mathematica", FontSlant->"Italic"], ". This is one of them. The ", StyleBox["/; ", FontWeight->"Bold"], "is used to specify the values of ", StyleBox["x", FontSlant->"Italic"], " over which ", StyleBox["f[x] ", FontSlant->"Italic"], "is to take on the specified value. Other ways to define piecewise \ continuous functions include using the ", StyleBox["UnitStep", FontWeight->"Bold"], " function or the ", StyleBox["Which", FontWeight->"Bold"], " function. Look these up in the ", StyleBox["Help", FontSlant->"Italic"], " menu to get more information on their use.\n", ButtonBox["Go back.", ButtonData:>"hb2", ButtonStyle->"Hyperlink"] }], "Text", CellTags->"h2"] }, Closed]] }, Open ]] }, FrontEndVersion->"4.1 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 695}}, WindowSize->{716, 333}, WindowMargins->{{47, Automatic}, {Automatic, 28}}, PrintingCopies->1, PrintingPageRange->{Automatic, Automatic}, StyleDefinitions -> "Default.nb" ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{ "hb1"->{ Cell[7906, 225, 981, 30, 41, "Input", Evaluatable->False, CellTags->"hb1"]}, "hb2"->{ Cell[17974, 524, 851, 25, 40, "Input", Evaluatable->False, CellTags->"hb2"]}, "h1"->{ Cell[52705, 1281, 776, 27, 90, "Text", CellTags->"h1"]}, "h2"->{ Cell[53484, 1310, 828, 28, 90, "Text", CellTags->"h2"]} } *) (*CellTagsIndex CellTagsIndex->{ {"hb1", 55025, 1360}, {"hb2", 55129, 1364}, {"h1", 55233, 1368}, {"h2", 55310, 1371} } *) (*NotebookFileOutline Notebook[{ Cell[1705, 50, 993, 18, 431, "Subsubtitle"], Cell[CellGroupData[{ Cell[2723, 72, 112, 3, 225, "Title"], Cell[2838, 77, 123, 3, 37, "Text"], Cell[CellGroupData[{ Cell[2986, 84, 31, 0, 59, "Section"], Cell[3020, 86, 209, 6, 33, "Text"], Cell[3232, 94, 544, 8, 90, "Text"], Cell[3779, 104, 974, 19, 147, "Text"], Cell[CellGroupData[{ Cell[4778, 127, 74, 1, 47, "Subsection"], Cell[4855, 130, 1209, 34, 242, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[6113, 170, 91, 2, 33, "Section"], Cell[6207, 174, 69, 1, 33, "Text"], Cell[6279, 177, 1202, 33, 147, "Text"], Cell[7484, 212, 312, 6, 130, "Input"], Cell[7799, 220, 104, 3, 33, "Text"], Cell[7906, 225, 981, 30, 41, "Input", Evaluatable->False, CellTags->"hb1"], Cell[8890, 257, 316, 8, 50, "Input"], Cell[9209, 267, 212, 6, 33, "Text"], Cell[9424, 275, 276, 5, 70, "Input"], Cell[9703, 282, 193, 4, 52, "Text"], Cell[9899, 288, 531, 8, 130, "Input"], Cell[10433, 298, 368, 8, 90, "Text"], Cell[10804, 308, 254, 4, 50, "Input"], Cell[11061, 314, 248, 4, 52, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[11346, 323, 38, 0, 33, "Section"], Cell[11387, 325, 89, 1, 33, "Text"], Cell[11479, 328, 353, 10, 39, "Text"], Cell[11835, 340, 1074, 20, 270, "Input"], Cell[12912, 362, 716, 27, 58, "Text"], Cell[13631, 391, 97, 2, 33, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[13765, 398, 74, 0, 33, "Section"], Cell[13842, 400, 730, 22, 71, "Text"], Cell[14575, 424, 222, 4, 70, "Input"], Cell[14800, 430, 872, 34, 71, "Text"], Cell[15675, 466, 1349, 26, 330, "Input"], Cell[17027, 494, 490, 9, 109, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[17554, 508, 38, 0, 33, "Section"], Cell[17595, 510, 376, 12, 52, "Text"], Cell[17974, 524, 851, 25, 40, "Input", Evaluatable->False, CellTags->"hb2"], Cell[18828, 551, 254, 5, 90, "Input"], Cell[19085, 558, 247, 5, 71, "Text"], Cell[19335, 565, 2698, 61, 350, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[22070, 631, 71, 0, 33, "Section"], Cell[22144, 633, 70, 1, 33, "Text"], Cell[22217, 636, 1408, 35, 153, "Text"], Cell[23628, 673, 1232, 23, 330, "Input"], Cell[24863, 698, 357, 7, 52, "Text"], Cell[25223, 707, 1406, 28, 390, "Input"], Cell[26632, 737, 219, 4, 52, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[26888, 746, 41, 0, 33, "Section"], Cell[26932, 748, 90, 1, 33, "Text"], Cell[27025, 751, 498, 9, 71, "Text"], Cell[27526, 762, 779, 18, 190, "Input"], Cell[28308, 782, 333, 9, 52, "Text"], Cell[28644, 793, 2709, 59, 410, "Input"], Cell[31356, 854, 98, 3, 52, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[31491, 862, 64, 0, 33, "Section"], Cell[31558, 864, 1404, 24, 169, "Text"], Cell[32965, 890, 393, 11, 71, "Text"], Cell[33361, 903, 5777, 83, 1070, "Input"], Cell[39141, 988, 315, 5, 71, "Text"], Cell[39459, 995, 81, 1, 30, "Input"], Cell[39543, 998, 284, 7, 52, "Text"], Cell[39830, 1007, 571, 13, 170, "Input"], Cell[40404, 1022, 638, 9, 109, "Text"], Cell[41045, 1033, 834, 18, 238, "Input"], Cell[41882, 1053, 76, 0, 33, "Text"], Cell[41961, 1055, 524, 10, 170, "Input"], Cell[42488, 1067, 474, 7, 90, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[42999, 1079, 74, 1, 33, "Section"], Cell[43076, 1082, 240, 7, 52, "Text"], Cell[43319, 1091, 5976, 87, 1546, "Input"], Cell[49298, 1180, 288, 7, 90, "Text"], Cell[49589, 1189, 721, 17, 170, "Input"], Cell[50313, 1208, 831, 18, 238, "Input"], Cell[51147, 1228, 509, 10, 170, "Input"], Cell[51659, 1240, 135, 3, 33, "Text"], Cell[51797, 1245, 85, 1, 30, "Input"], Cell[51885, 1248, 124, 3, 33, "Text"], Cell[52012, 1253, 95, 2, 50, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[52144, 1260, 558, 19, 33, "Section"], Cell[52705, 1281, 776, 27, 90, "Text", CellTags->"h1"], Cell[53484, 1310, 828, 28, 90, "Text", CellTags->"h2"] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)