(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.0' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 6610, 236]*) (*NotebookOutlinePosition[ 7340, 261]*) (* CellTagsIndexPosition[ 7296, 257]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["A Guitar String and Fourier Series", "Title"], Cell[BoxData[ \(Needs["\"]\)], "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["Mathematical Model of a Guitar String", "Section"], Cell[TextData[{ "When you pluck a guitar string of length L at its midpoint, a mathematical \ model for the string, ignoring dampening, determines the displacement of the \ string at a distance ", StyleBox["x", FontSlant->"Italic"], " units along its length and at time ", StyleBox["t", FontSlant->"Italic"], " to be an infinite sum of tones. The ", Cell[BoxData[ \(TraditionalForm\`n\^th\)]], " tone is" }], "Text"], Cell[BoxData[{ \(Clear[tone]\), "\[IndentingNewLine]", \(tone[x_, t_, n_] := \(\(8 a \((\(-1\))\)\^\(n + 1\)\)\/\(\(\((2 n - 1)\)\^2\) \[Pi]\^2\)\) Cos[\(c \((2 n - 1)\) \[Pi]\ t\)\/L]\ Sin[\(\((2 n - 1)\) \[Pi]\ \ x\)\/L]\)}], "Input"], Cell[TextData[{ "where ", StyleBox["c", FontSlant->"Italic"], " is the wave speed, determined by the length of the string and the amount \ of tension on the string, and ", StyleBox["a", FontSlant->"Italic"], " is the initial displacement at the midpoint. The sum of the first ", StyleBox["n", FontSlant->"Italic"], " tones is" }], "Text"], Cell[BoxData[{ \(Clear[u]\), "\[IndentingNewLine]", \(u[x_, t_, n_] := \[Sum]\+\(i = 1\)\%n tone[x, t, i]\)}], "Input"], Cell["\<\ The limit of this sum as n approaches infinity gives the displacement of the \ guitar string.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Initial Displacement at the Midpoint", "Section"], Cell[TextData[{ "The initial displacement at the midpoint is obtained by setting ", StyleBox["t", FontSlant->"Italic"], " = 0 and ", StyleBox["x", FontSlant->"Italic"], " = ", Cell[BoxData[ \(TraditionalForm\`L\/2\)]] }], "Text"], Cell[BoxData[ \(u[L/2, 0, Infinity]\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Graph of Initial Displacement", "Section"], Cell[TextData[{ "The ", Cell[BoxData[ \(TraditionalForm\`10\^th\)]], " partial sum at ", StyleBox["t", FontSlant->"Italic"], " = 0 approximates the initial displacement." }], "Text"], Cell[BoxData[{ \(\(a = 1.5;\)\), "\[IndentingNewLine]", \(\(c = 58091;\)\), "\[IndentingNewLine]", \(\(L = 66;\)\)}], "Input"], Cell[BoxData[ \(\(Plot[u[x, 0, 10], {x, 0, 66}];\)\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Graph of First Three Tones", "Section"], Cell[TextData[{ "Here are the first three tones at time ", StyleBox["t", FontSlant->"Italic"], " = 0." }], "Text"], Cell[BoxData[ \(\(Plot[{tone[x, 0, 1], \ tone[x, 0, 2], \ tone[x, 0, 3]}, \ {x, 0, 66}, \ PlotRange \[Rule] All, \ PlotStyle \[Rule] {{Red}, {Green}, {Blue}}];\)\)], "Input"], Cell[BoxData[ \(N[tone[x, t, 1]]\)], "Input"], Cell[BoxData[ \(tone[x, t, 1]\)], "Input"], Cell["Here is an animation of the first three terms.", "Text"], Cell[BoxData[ \(\(Table[ Plot[{tone[x, t, 1], \ tone[x, t, 2], \ tone[x, t, 3]}, \ {x, 0, 66}, \ PlotRange \[Rule] {\(-a\), a}, \ PlotStyle \[Rule] {{Red}, {Green}, {Blue}}], {t, 0, .95\ \(2 L\)\/c, .05\ \(2 L\)\/c}];\)\)], "Input"], Cell["Here is an animation of the sum of the first three terms.", "Text"], Cell[BoxData[ \(\(Table[ Plot[u[x, t, 3], \ {x, 0, 66}, \ PlotRange \[Rule] {\(-a\), a}], {t, 0, .95\ \(2 L\)\/c, .05\ \(2 L\)\/c}];\)\)], "Input"], Cell["\<\ Now let's listen to the tones. We will play them at their maximum amplitude, \ that is, at the midpoint. But first, we will lower the pitch so that the \ sound is within a good range for cheap computer speakers.\ \>", "Text"], Cell[BoxData[ \(\(c = 58091/2;\)\)], "Input"], Cell["Here is the fundamental tone.", "Text"], Cell[BoxData[ \(\(Play[tone[L\/2, t, 1], {t, 0, 1}];\)\)], "Input"], Cell["Here is the first overtone.", "Text"], Cell[BoxData[ \(\(Play[tone[L\/2, t, 2], {t, 0, 1}];\)\)], "Input"], Cell["And here is the second overtone.", "Text"], Cell[BoxData[ \(\(Play[tone[L\/2, t, 3], {t, 0, 1}];\)\)], "Input"], Cell["\<\ Here are the sum of the first three terms. Can you hear the overtones?\ \>", "Text"], Cell[BoxData[ \(\(Play[u[L\/2, t, 3], {t, 0, 1}];\)\)], "Input"], Cell["\<\ If you cannot hear the overtones, try this one, with the overtones amplified \ by a factor of 4. Notice how the sound is more natural and less \ mechanical-sounding than the monotones are.\ \>", "Text"], Cell[BoxData[ \(\(Play[ tone[L\/2, t, 1] + 4\ tone[L\/2, t, 2] + 4\ tone[L\/2, t, 3], {t, 0, 1}];\)\)], "Input"] }, Closed]] }, FrontEndVersion->"5.0 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 695}}, AutoGeneratedPackage->None, CellGrouping->Manual, WindowSize->{813, 666}, WindowMargins->{{10, Automatic}, {Automatic, 0}}, StyleDefinitions -> "Classroom.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->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1776, 53, 51, 0, 67, "Title"], Cell[1830, 55, 90, 2, 30, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[1957, 62, 56, 0, 42, "Section"], Cell[2016, 64, 445, 13, 48, "Text"], Cell[2464, 79, 305, 7, 88, "Input"], Cell[2772, 88, 365, 12, 48, "Text"], Cell[3140, 102, 128, 2, 91, "Input"], Cell[3271, 106, 117, 3, 29, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[3425, 114, 55, 0, 42, "Section"], Cell[3483, 116, 255, 10, 36, "Text"], Cell[3741, 128, 52, 1, 30, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[3830, 134, 48, 0, 42, "Section"], Cell[3881, 136, 202, 8, 33, "Text"], Cell[4086, 146, 140, 3, 70, "Input"], Cell[4229, 151, 67, 1, 30, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[4333, 157, 45, 0, 42, "Section"], Cell[4381, 159, 124, 5, 29, "Text"], Cell[4508, 166, 198, 3, 70, "Input"], Cell[4709, 171, 49, 1, 50, "Input"], Cell[4761, 174, 46, 1, 50, "Input"], Cell[4810, 177, 62, 0, 29, "Text"], Cell[4875, 179, 283, 5, 84, "Input"], Cell[5161, 186, 73, 0, 29, "Text"], Cell[5237, 188, 174, 3, 62, "Input"], Cell[5414, 193, 238, 4, 48, "Text"], Cell[5655, 199, 49, 1, 50, "Input"], Cell[5707, 202, 45, 0, 29, "Text"], Cell[5755, 204, 71, 1, 62, "Input"], Cell[5829, 207, 43, 0, 29, "Text"], Cell[5875, 209, 71, 1, 62, "Input"], Cell[5949, 212, 48, 0, 29, "Text"], Cell[6000, 214, 71, 1, 62, "Input"], Cell[6074, 217, 95, 2, 29, "Text"], Cell[6172, 221, 68, 1, 62, "Input"], Cell[6243, 224, 213, 4, 48, "Text"], Cell[6459, 230, 135, 3, 62, "Input"] }, Closed]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)