(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 4.0, MathReader 4.0, or any compatible application. 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[ 28594, 857]*) (*NotebookOutlinePosition[ 29303, 882]*) (* CellTagsIndexPosition[ 29259, 878]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Fourier Coefficients", "Title", CellFrame->True, TextAlignment->Center, Background->RGBColor[0, 1, 0]], Cell["\<\ This notebook is by Steven Amgott. Please send any questions or \ comments to samgott1@swarthmore.edu. Feel free to use and distribute this \ notebook, but keep this author information in any copy you use or distribute.\ \ \>", "SmallText"], Cell[TextData[{ "In general, anything in ", StyleBox["magenta", FontColor->RGBColor[1, 0, 1]], " is something you can, and possibly should, change (in particular if you \ wish to do a different example)." }], "Text"], Cell[CellGroupData[{ Cell["\<\ Initialization. (Can be skipped, if you answer \"Yes\" to the \ initialization request.)\ \>", "Section"], Cell["\<\ The cell in this section is an initialization cell, and will be \ automatically evaluated if you answer \"Yes\" to the initialization request. \ If you do not answer \"Yes\" to this request, you must evaluate it before \ creating the graphs in the second section below.\ \>", "Text"], Cell[BoxData[ \(Needs["\"]\)], "Input", InitializationCell->True], Cell[BoxData[ RowBox[{\(Simpson[y_, domain_, n_]\), ":=", RowBox[{"N", "[", RowBox[{"Module", "[", RowBox[{\({x, a, b, s, h}\), ",", RowBox[{\({x, a, b} = domain\), ";", \(h = \(b - a\)\/n\), ";", RowBox[{\(1\/6\), " ", RowBox[{"(", RowBox[{ RowBox[{"4", " ", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\/2\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\/2\)], \((y /. x \[Rule] s)\)}]}], "+", RowBox[{"2", " ", RowBox[{ UnderoverscriptBox["\[Sum]", GridBox[{ {\(s = a + h\)}, {\(\[CapitalDelta]\[MediumSpace]s = h\)} }], \(b - h\)], \((y /. x \[Rule] s)\)}]}], "+", \((y /. x \[Rule] a)\), "+", \((y /. x \[Rule] b)\)}], ")"}], " ", "h"}]}]}], "]"}], "]"}]}]], "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[TextData[{ "Eliminating some unnecessary warning messages. ", StyleBox["(Should be skipped)", FontColor->RGBColor[1, 0, 1]] }], "Subsubsection"], Cell[BoxData[{ \(\(Off[General::"\"];\)\), "\n", \(\(Off[General::"\"];\)\)}], "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Fourier coefficient calculations", "Section"], Cell["\<\ Given a periodic function g(x) of period 2r, we can try to find its \ Fourier Series, which has the form\ \>", "Text"], Cell[TextData[{ Cell[BoxData[ FormBox[ FractionBox[ FormBox[ SubscriptBox[ StyleBox["a", FontSlant->"Italic"], "0"], "TraditionalForm"], "2"], TraditionalForm]]], " + ", Cell[BoxData[ \(TraditionalForm\`\[Sum]\+\(k = 1\)\%\[Infinity]\((a\_k\ \(cos(\(\(k\ \ \[Pi]\)\/r\) x)\)\ + b\_k\ \(sin(\(\(k\ \[Pi]\)\/r\) x)\))\)\)]] }], "Text", TextAlignment->Center, TextJustification->0], Cell[TextData[{ "We do this by calculating the ", Cell[BoxData[ \(TraditionalForm\`a\_k\)]], " and ", Cell[BoxData[ \(TraditionalForm\`b\_k\)]], " from the formulas" }], "Text"], Cell[TextData[{ Cell[BoxData[ \(TraditionalForm\`a\_k\)]], " = ", Cell[BoxData[ \(1\/r\ \(\[Integral]\_\(-r\)\%\(\(\ \)\(r\)\)\ \ g \((x)\)\ cos \((\(k\ \ \[Pi]\)\/r\ x)\) \[DifferentialD]x\)\)], InitializationCell->True, FontFamily->"Times New Roman"] }], "Text", TextAlignment->Center, TextJustification->0], Cell["and", "Text"], Cell[TextData[{ Cell[BoxData[ \(TraditionalForm\`b\_k\)]], " = ", Cell[BoxData[ \(1\/r\ \(\[Integral]\_\(-r\)\%\(\(\ \)\(r\)\)\ \ g \((x)\)\ sin \((\(k\ \ \[Pi]\)\/r\ x)\) \[DifferentialD]x\)\)], InitializationCell->True, FontFamily->"Times New Roman"] }], "Text", TextAlignment->Center, TextJustification->0], Cell[TextData[{ "Here are ", StyleBox["Mathematica ", FontSlant->"Italic"], "expressions which calculate the coefficients. I have included a version \ which does the work exactly (but can take a LONG time on some computers and \ might not produce an answer if the integral is not one ", StyleBox["Mathematica", FontSlant->"Italic"], " can find), a version that uses ", StyleBox["Mathematica", FontSlant->"Italic"], "'s built-in numerical integrator (but still can take a while to evaluate \ and can produce some warnings), and a version that uses Simpson's rule (so we \ can control the amount of time for the computation). ", StyleBox["y", FontColor->RGBColor[1, 0, 0]], " is the placeholder for the function (written in the form g[x] for \ evaluation) whose Fourier coefficients are to be found, ", StyleBox["x", FontColor->RGBColor[1, 0, 0]], " is the independent variable, ", StyleBox["r", FontColor->RGBColor[1, 0, 0]], " is the \"radius\" of the interval (so the period is 2 r), and ", StyleBox["k", FontColor->RGBColor[1, 0, 0]], " determines which coefficient (of cos(", Cell[BoxData[ \(\(k\ \[Pi]\)\/r\ x\)], InitializationCell->True], ") for the a's and of sin(", Cell[BoxData[ \(\(k\ \[Pi]\)\/r\ x\)], InitializationCell->True], ") for the b's) is being calculated." }], "Text"], Cell[TextData[{ "The cells in this section are initialization cells, and will already have \ been evaluated if you answered \"Yes\" to the initialization request. If you \ did, you can skip the rest of this paragraph. If you did not, be sure to \ evaluate them and also the cells in the initialization section before going \ on to the rest of the notebook. The easiest way to do this is to use the ", StyleBox["Kernel...Evaluation...Evaluate Initialization", FontColor->RGBColor[0, 0, 1]], " menu item." }], "Text"], Cell["Exact version.", "Text"], Cell[BoxData[{ \(\(aExact[y_, x_, r_, k_] := 1\/r\ \(\[Integral]\_\(-r\)\%r\((y\ Cos[\(k\ \[Pi]\)\/r\ x])\) \ \[DifferentialD]x\);\)\), "\n", \(\(bExact[y_, x_, r_, k_] := 1\/r\ \(\[Integral]\_\(-r\)\%r\((y\ Sin[\(k\ \[Pi]\)\/r\ x])\) \ \[DifferentialD]x\);\)\)}], "Input", InitializationCell->True], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], "'s numerical version." }], "Text"], Cell[BoxData[{ \(\(aN[y_, x_, r_, k_] := \(1\/r\) NIntegrate[y\ Cos[\(k\ \[Pi]\)\/r\ x], {x, \(-r\), r}];\)\), "\n", \(\(bN[y_, x_, r_, k_] := \(1\/r\) NIntegrate[ y\ Sin[\(k\ \[Pi]\)\/r\ x], {x, \(-r\), r}];\)\)}], "Input", InitializationCell->True], Cell[TextData[{ "Simpson version. ", StyleBox["n", FontColor->RGBColor[1, 0, 0]], " is the number of subdivisions to be used by Simpson's rule." }], "Text"], Cell[BoxData[{ \(\(aSimp[y_, x_, r_, k_, n_] := \(1\/r\) Simpson[y\ Cos[\(k\ \[Pi]\)\/r\ x], {x, \(-r\), r}, n];\)\), "\n", \(\(bSimp[y_, x_, r_, k_, n_] := \(1\/r\) Simpson[y\ Sin[\(k\ \[Pi]\)\/r\ x], {x, \(-r\), r}, n];\)\)}], "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell["Finding the coefficients for an unknown periodic function.", "Section"], Cell["\<\ The next cell creates a random periodic function (with period 2) \ which has terms in sin(m \[Pi] x) and cos(m \[Pi] x) up to m = 4.\ \>", "Text"], Cell[BoxData[{ \(Clear[g, r0, r1, r2, r3, r4, s1, s2, s3, s4, origPlot]\), "\n", \(\(r0 = Random[Integer, {\(-9\), 9}];\)\), "\n", \(\(r1 = Random[Integer, {\(-9\), 9}];\)\), "\n", \(\(r2 = Random[Integer, {\(-9\), 9}];\)\), "\n", \(\(r3 = Random[Integer, {\(-9\), 9}];\)\), "\n", \(\(r4 = Random[Integer, {\(-9\), 9}];\)\), "\n", \(\(s1 = Random[Integer, {\(-9\), 9}];\)\), "\n", \(\(s2 = Random[Integer, {\(-9\), 9}];\)\), "\n", \(\(s3 = Random[Integer, {\(-9\), 9}];\)\), "\n", \(\(s4 = Random[Integer, {\(-9\), 9}];\)\), "\n", \(g[x_] := r0\/2 + r1\ Cos[\[Pi]\ x] + r2\ Cos[2 \[Pi]\ x] + r3\ Cos[3 \[Pi]\ x] + r4\ Cos[4\ \[Pi]\ x] + s1\ Sin[\[Pi]\ x] + s2\ Sin[2\ \[Pi]\ x] + s3\ Sin[3 \[Pi]\ x] + s4\ Sin[4 \[Pi]\ x]\), "\n", \(\t\t\(origPlot = Plot[g[x], {x, \(-2\), 2}];\)\)}], "Input"], Cell[TextData[{ "Right now we do not know any of the coefficients, but we can find them by \ calculating the Fourier series for this function (which in this case is \ finite and actually equals the function). Let's do a couple \"by hand,\" and \ then we will have ", StyleBox["Mathematica", FontSlant->"Italic"], " find all the coefficients by using the functions we defined above." }], "Text"], Cell[TextData[{ "To find r0 we need to integrate the function g(x) over the inteval [-1,1]. \ (If finding the integrals in the next several cells takes too long on your \ computer, you can abort the calculation (", StyleBox["Kernel...Abort Evaluation", FontColor->RGBColor[0, 0, 1]], ") and skip to the cell that uses ", StyleBox["NIntegrate", FontColor->RGBColor[1, 0, 0]], " (via ", StyleBox["aN[g[x],x,r,k]", FontColor->RGBColor[1, 0, 0]], " and ", StyleBox["bN[g[x],x,r,k]", FontColor->RGBColor[1, 0, 0]], ") to calculate all the coefficients at once.)" }], "Text"], Cell[BoxData[ \(\[Integral]\_\(-1\)\%1 g[x] \[DifferentialD]x\)], "Input"], Cell["Let's check our answer.", "Text"], Cell[BoxData[ \(r0\)], "Input"], Cell["\<\ To find r1 we need to integrate the function g(x) cos(\[Pi] x) \ over the inteval [-1,1]. \ \>", "Text"], Cell[BoxData[ \(\[Integral]\_\(-1\)\%1 g[x] Cos[\[Pi]\ x] \[DifferentialD]x\)], "Input"], Cell["Let's check our answer.", "Text"], Cell[BoxData[ \(r1\)], "Input"], Cell["\<\ To find s1 we need to integrate the function g(x) sin(\[Pi] x) over \ the inteval [-1,1]. \ \>", "Text"], Cell[BoxData[ \(\[Integral]\_\(-1\)\%1 g[x] Sin[\[Pi]\ x] \[DifferentialD]x\)], "Input"], Cell["Let's check our answer.", "Text"], Cell[BoxData[ \(s1\)], "Input"], Cell["\<\ The last one we will do by hand is r2. We need to integrate g(x) \ cos(2 \[Pi] x) over the interval [-1,1].\ \>", "Text"], Cell[BoxData[ \(\[Integral]\_\(-1\)\%1 g[x] Cos[2\ \[Pi]\ x] \[DifferentialD]x\)], "Input"], Cell["Let's check our answer.", "Text"], Cell[BoxData[ \(r2\)], "Input"], Cell[TextData[{ "The function", StyleBox[" aExact[g[x],x,r,k]", FontColor->RGBColor[1, 0, 0]], " finds the coefficient of cos(", Cell[BoxData[ \(\(k\ \[Pi]\)\/r\)]], " x) in the Fourier series for g(x), and the function ", StyleBox["bExact[g[x],x,r,k]", FontColor->RGBColor[1, 0, 0]], " finds the coefficient of sin(", Cell[BoxData[ \(\(k\ \[Pi]\)\/r\)]], " x) in the Fourier series for g(x), using exact integration within ", StyleBox["Mathematica", FontSlant->"Italic"], ". If it seems to be taking too long, you can abort the calculation (", StyleBox["Kernel...Abort Evaluation", FontColor->RGBColor[0, 0, 1]], ") and try a numerical method. Since the period of g(x) is 2, ", StyleBox["r", FontColor->RGBColor[1, 0, 0]], "= 1." }], "Text"], Cell[BoxData[{ \(Clear[f, a0, a1, a2, a3, a4, b1, b2, b3, b4, guessPlot]\), "\n", \(\(a0 = aExact[g[x], x, 1, 0];\)\), "\n", \(\(a1 = aExact[g[x], x, 1, 1];\)\), "\n", \(\(a2 = aExact[g[x], x, 1, 2];\)\), "\n", \(\(a3 = aExact[g[x], x, 1, 3];\)\), "\n", \(\(a4 = aExact[g[x], x, 1, 4];\)\), "\n", \(\(b1 = bExact[g[x], x, 1, 1];\)\), "\n", \(\(b2 = bExact[g[x], x, 1, 2];\)\), "\n", \(\(b3 = bExact[g[x], x, 1, 3];\)\), "\n", \(\(b4 = bExact[g[x], x, 1, 4];\)\), "\n", \(f[x_] = a0\/2 + a1\ Cos[\[Pi]\ x] + a2\ Cos[2 \[Pi]\ x] + a3\ Cos[3 \[Pi]\ x] + a4\ Cos[4\ \[Pi]\ x] + b1\ Sin[\[Pi]\ x] + b2\ Sin[2\ \[Pi]\ x] + b3\ Sin[3 \[Pi]\ x] + b4\ Sin[4 \[Pi]\ x]\), "\n", \(\t\t\(guessPlot = Plot[f[x], {x, \(-2\), 2}, PlotStyle \[Rule] RGBColor[1, 0, 0]];\)\)}], "Input"], Cell[TextData[{ "If exact answers are taking too long, you can use ", StyleBox["Mathematica", FontSlant->"Italic"], "'s built-in numerical integrator ", StyleBox["NIntegrate", FontColor->RGBColor[1, 0, 0]], ", which was programed into the functions ", StyleBox["aN[g[x],x,r,k]", FontColor->RGBColor[1, 0, 0]], " and ", StyleBox["bN[g[x],x,r,k]", FontColor->RGBColor[1, 0, 0]], ". A word of caution - when I tried this on an older computer (Pentium II \ 266), ", StyleBox["NIntegrate", FontColor->RGBColor[1, 0, 0]], " returned warnings about its calculations because the function g(x) \ oscillates rapidly. On a newer computer (Celeron 400) I got no such \ warnings. Of course, if you found exact answers above you can skip this next \ cell." }], "Text"], Cell[BoxData[{ \(Clear[f, a0, a1, a2, a3, a4, b1, b2, b3, b4, guessPlot]\), "\n", \(\(a0 = aN[g[x], x, 1, 0];\)\), "\n", \(\(a1 = aN[g[x], x, 1, 1];\)\), "\n", \(\(a2 = aN[g[x], x, 1, 2];\)\), "\n", \(\(a3 = aN[g[x], x, 1, 3];\)\), "\n", \(\(a4 = aN[g[x], x, 1, 4];\)\), "\n", \(\(b1 = bN[g[x], x, 1, 1];\)\), "\n", \(\(b2 = bN[g[x], x, 1, 2];\)\), "\n", \(\(b3 = bN[g[x], x, 1, 3];\)\), "\n", \(\(b4 = bN[g[x], x, 1, 4];\)\), "\n", \(f[x_] = a0\/2 + a1\ Cos[\[Pi]\ x] + a2\ Cos[2 \[Pi]\ x] + a3\ Cos[3 \[Pi]\ x] + a4\ Cos[4\ \[Pi]\ x] + b1\ Sin[\[Pi]\ x] + b2\ Sin[2\ \[Pi]\ x] + b3\ Sin[3 \[Pi]\ x] + b4\ Sin[4 \[Pi]\ x]\), "\n", \(\t\t\(guessPlot = Plot[f[x], {x, \(-2\), 2}, PlotStyle \[Rule] RGBColor[1, 0, 0]];\)\)}], "Input"], Cell[TextData[{ "If using ", StyleBox["NItegrate", FontColor->RGBColor[1, 0, 0]], " causes problems (which can depend on your computer as well as g(x)), you \ can always use Simpson's rule (programmed into ", StyleBox["aSimp[g[x],x,r,k,n]", FontColor->RGBColor[1, 0, 0]], " and ", StyleBox["bSimp[g[x],x,r,k,n]", FontColor->RGBColor[1, 0, 0]], ") to get approximations. The advantage is you can control the amount of \ time for the calculations by adjusting the number of subintervals ", StyleBox["n", FontColor->RGBColor[1, 0, 0]], " the method uses. There will be no warnings since the method is not \ adaptive, but you have to be careful about the answers (as we will see in the \ next section). I'll start with ", StyleBox["10", FontColor->RGBColor[1, 0, 1]], " subdivisions for Simpson's rule. You can skip the next cell if you have \ found answers in the preceeding cells." }], "Text"], Cell[BoxData[{\(Clear[f, n, a0, a1, a2, a3, a4, b1, b2, b3, b4, guessPlot]\), "\n", RowBox[{ RowBox[{"n", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(a0 = aSimp[g[x], x, 1, 0, n];\), "\n", \(a1 = aSimp[g[x], x, 1, 1, n];\), "\n", \(a2 = aSimp[g[x], x, 1, 2, n];\), "\n", \(a3 = aSimp[g[x], x, 1, 3, n];\), "\n", \(a4 = aSimp[g[x], x, 1, 4, n];\), "\n", \(b1 = bSimp[g[x], x, 1, 1, n];\), "\n", \(b2 = bSimp[g[x], x, 1, 2, n];\), "\n", \(b3 = bSimp[g[x], x, 1, 3, n];\), "\n", \(b4 = bSimp[g[x], x, 1, 4, n];\), "\n", \(f[x_] = a0\/2 + a1\ Cos[\[Pi]\ x] + a2\ Cos[2 \[Pi]\ x] + a3\ Cos[3 \[Pi]\ x] + a4\ Cos[4\ \[Pi]\ x] + b1\ Sin[\[Pi]\ x] + b2\ Sin[2\ \[Pi]\ x] + b3\ Sin[3 \[Pi]\ x] + b4\ Sin[4 \[Pi]\ x]\), "\n", RowBox[{ "\t\t", \(guessPlot = Plot[f[x], {x, \(-2\), 2}, PlotStyle \[Rule] RGBColor[1, 0, 0]];\)}]}], "Input"], Cell["\<\ Whichever way we found the coefficients, we can overlay the graphs \ for comparison.\ \>", "Text"], Cell[BoxData[ \(\(Show[origPlot, guessPlot];\)\)], "Input"], Cell["\<\ Here's we can check our answer (they should be the same, or almost \ the same if we are using numerical methods).\ \>", "Text"], Cell[BoxData[{ \(f[x]\), "\n", \(g[x]\)}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["A triangular wave.", "Section"], Cell["Here is a triangular wave, with period 2.", "Text"], Cell[BoxData[{ \(Clear[g, origPlot]\), "\n", \(g[x_] := If[x < \(-1\), x + 2, If[x > 1, \(-x\) + 2, If[x < 0, \(-x\), x]]]\), "\n", \(\(origPlot = Plot[g[x], {x, \(-2\), 2}];\)\)}], "Input"], Cell["Let's try to find the constant term using exact integration.", "Text"], Cell[BoxData[ \(\[Integral]\_\(-1\)\%1 g[x] \[DifferentialD]x\)], "Input"], Cell[TextData[{ "Evidently ", StyleBox["Mathematica", FontSlant->"Italic"], " is not too happy about doing this. I don't think we can use ", StyleBox["aExact", FontColor->RGBColor[1, 0, 0]], " and ", StyleBox["bExact", FontColor->RGBColor[1, 0, 0]], ". Let's try ", StyleBox["NIntegrate", FontColor->RGBColor[1, 0, 0]], " to see if we can use ", StyleBox["aN", FontColor->RGBColor[1, 0, 0]], " and ", StyleBox["bN", FontColor->RGBColor[1, 0, 0]], "." }], "Text"], Cell[BoxData[ \(NIntegrate[g[x], {x, \(-1\), 1}]\)], "Input"], Cell["This works better. What about the other coefficients?", "Text"], Cell[BoxData[{\(Clear[f, max, guessPlot]\), "\n", \(r = 1;\), "\n", RowBox[{ RowBox[{"max", "=", StyleBox["4", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(f[x_] = aN[g[x], x, r, 0]\/2 + \[Sum]\+\(m = 1\)\%max aN[g[x], x, r, m]\ Cos[\(m\ \[Pi]\)\/r\ x] + \[Sum]\+\(m = 1\)\%max bN[g[x], x, r, m]\ Sin[\(m\ \[Pi]\)\/r\ x]\), "\n", \(guessPlot = Plot[f[x], {x, \(-2\), 2}, PlotStyle \[Rule] RGBColor[1, 0, 0], DisplayFunction \[Rule] Identity];\), "\n", \(Show[origPlot, guessPlot, DisplayFunction \[Rule] $DisplayFunction];\)}], "Input"], Cell[TextData[{ "I got an answer, but also lots of warnings. (On an older Macintosh \ PowerPC 133 running ", StyleBox["Mathematica", FontSlant->"Italic"], " 3.0.1 I didn't even get an answer.) You might want to go back and \ increase ", StyleBox["max", FontColor->RGBColor[1, 0, 1]], " to see if we seem to get convergence to the triangular wave." }], "Text"], Cell["\<\ Notice that the coefficients of all the sine terms are zero. Could \ this have been predicted from the original triangular wave function?\ \>", \ "Text"], Cell["\<\ To get some idea about the warnings, let's try the Simpson's rule \ approach.\ \>", "Text"], Cell[BoxData[{\(Clear[f, n, max, guessPlot]\), "\n", \(r = 1;\), "\n", RowBox[{ RowBox[{"n", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", RowBox[{ RowBox[{"max", "=", StyleBox["4", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(f[x_] = aSimp[g[x], x, r, 0, n]\/2 + \[Sum]\+\(m = 1\)\%max aSimp[g[x], x, r, m, n]\ Cos[\(m\ \[Pi]\)\/r\ x] + \[Sum]\+\(m = 1\)\%max bSimp[ g[x], x, r, m, n]\ Sin[\(m\ \[Pi]\)\/r\ x]\), "\n", \(guessPlot = Plot[f[x], {x, \(-2\), 2}, PlotStyle \[Rule] RGBColor[1, 0, 0], DisplayFunction \[Rule] Identity];\), "\n", \(Show[origPlot, guessPlot, DisplayFunction \[Rule] $DisplayFunction];\)}], "Input"], Cell[TextData[{ "We can increase the number of terms we are using from the Fourier Series \ by increasing ", StyleBox["max", FontColor->RGBColor[1, 0, 1]], ". It is interesting to try it for max = ", StyleBox["10", FontColor->RGBColor[1, 0, 1]], "." }], "Text"], Cell[BoxData[{\(Clear[f, n, max, guessPlot]\), "\n", \(r = 1;\), "\n", RowBox[{ RowBox[{"n", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", RowBox[{ RowBox[{"max", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(f[x_] = aSimp[g[x], x, r, 0, n]\/2 + \[Sum]\+\(m = 1\)\%max aSimp[g[x], x, r, m, n]\ Cos[\(m\ \[Pi]\)\/r\ x] + \[Sum]\+\(m = 1\)\%max bSimp[ g[x], x, r, m, n]\ Sin[\(m\ \[Pi]\)\/r\ x]\), "\n", \(guessPlot = Plot[f[x], {x, \(-2\), 2}, PlotStyle \[Rule] RGBColor[1, 0, 0], DisplayFunction \[Rule] Identity];\), "\n", \(Show[origPlot, guessPlot, DisplayFunction \[Rule] $DisplayFunction];\)}], "Input"], Cell[TextData[{ "That doesn't seem right. Increasing the number of steps should produce \ better approximations if the Fourier series converges to the function. The \ problem here is the accuracy of the integration, not the convergence. Let's \ increase ", StyleBox["n", FontColor->RGBColor[1, 0, 1]], "." }], "Text"], Cell[BoxData[{\(Clear[f, n, max, guessPlot]\), "\n", \(r = 1;\), "\n", RowBox[{ RowBox[{"n", "=", StyleBox["20", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", RowBox[{ RowBox[{"max", "=", StyleBox["10", FontColor->RGBColor[1, 0, 1]]}], ";"}], "\n", \(f[x_] = aSimp[g[x], x, r, 0, n]\/2 + \[Sum]\+\(m = 1\)\%max aSimp[g[x], x, r, m, n]\ Cos[\(m\ \[Pi]\)\/r\ x] + \[Sum]\+\(m = 1\)\%max bSimp[ g[x], x, r, m, n]\ Sin[\(m\ \[Pi]\)\/r\ x]\), "\n", \(guessPlot = Plot[f[x], {x, \(-2\), 2}, PlotStyle \[Rule] RGBColor[1, 0, 0], DisplayFunction \[Rule] Identity];\), "\n", \(Show[origPlot, guessPlot, DisplayFunction \[Rule] $DisplayFunction];\)}], "Input"], Cell[TextData[{ "Perhaps this explains why ", StyleBox["NIntegrate", FontColor->RGBColor[1, 0, 0]], " is giving us warnings. Rapidly oscillating functions can cause problems \ for numerical integrators." }], "Text"], Cell["\<\ You can easily modify this section to calculate Fourier \ coefficients for other functions g(x).\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["A square wave. Animation of convergence.", "Section"], Cell[CellGroupData[{ Cell["Plot of a square wave.", "Subsection"], Cell["\<\ Here is a square wave of height \[Pi] and period 2 \[Pi].\ \>", \ "Text"], Cell[BoxData[{\(Clear[sqWavePlot, x]\), "\[IndentingNewLine]", RowBox[{ RowBox[{"sqWavePlot", "=", RowBox[{"Plot", "[", RowBox[{\(If[\((\(-4\)\ \[Pi] < x < \(-3\)\ \[Pi])\) \[Or] \((\(-2\)\ \[Pi] < x < \(-\[Pi]\))\) \[Or] \((0 < x < \[Pi])\) \[Or] \((2\ \[Pi] < x < 3\ \[Pi])\), \[Pi], 0]\), ",", \({x, \(-4\)\ \[Pi], 4\ \[Pi]}\), ",", \(PlotRange \[Rule] {\(-1\), 4}\), ",", RowBox[{"ImageSize", "\[Rule]", StyleBox["400", FontColor->RGBColor[1, 0, 1]]}]}], "]"}]}], ";"}]}], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Calculating the coefficients.", "Subsection"], Cell[TextData[{ "The ", StyleBox["Mathematica", FontSlant->"Italic"], " function which produces one period of our square wave is" }], "Text"], Cell[BoxData[{ \(Clear[g, x]\), "\[IndentingNewLine]", \(g[x_] := If[x < 0, 0, \[Pi]]\), "\[IndentingNewLine]", \(\(Plot[g[x], {x, \(-\[Pi]\), \[Pi]}];\)\)}], "Input"], Cell["We'll use the exact coefficient calculations.", "Text"], Cell[BoxData[ \(aExact[g[x], x, \[Pi], 0]\)], "Input"], Cell[TextData[{ "The constant term is therefore ", Cell[BoxData[ \(TraditionalForm\`\[Pi]\/2\)]] }], "Text"], Cell["Finding the cosine term coefficients", "Text"], Cell[BoxData[{ \(Clear[k]\), "\[IndentingNewLine]", \(aExact[g[x], x, \[Pi], k]\)}], "Input"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " doesn't yet know that k is an integer. Since it is, sin(k \[Pi]) = 0, \ and so the coefficients of all the cosine terms are 0. We can tell ", StyleBox["Mathematica", FontSlant->"Italic"], " to simply the result, assuming k is an integer, by using the syntax below \ instead." }], "Text"], Cell[BoxData[{ \(Clear[k]\), "\n", \(Simplify[aExact[g[x], x, \[Pi], k], k \[Element] Integers]\)}], "Input"], Cell["\<\ Could we have predicted that these coefficients would be 0 from the \ original square wave function?\ \>", "Text"], Cell["Let's now find the sine term coefficients.", "Text"], Cell[BoxData[ \(Simplify[bExact[g[x], x, \[Pi], k], k \[Element] Integers]\)], "Input"], Cell[TextData[{ "For even k this is 0 and for odd k this is ", Cell[BoxData[ \(TraditionalForm\`2\/k\)]], ". Writing an odd k as 2n+1, the coefficient of sin((2n+1)x) is ", Cell[BoxData[ FormBox[ FractionBox["2", RowBox[{ RowBox[{"2", StyleBox["n", FontSlant->"Plain"]}], "+", "1"}]], TraditionalForm]]], "." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Animating the convergence", "Subsection"], Cell[TextData[{ "We can animate graphs of increasing the partial Fourier series \ approximations using the cell below. To see the animation, evaluate the \ cell, select the entire collection of output graphs by clicking on the \ bracket containing all of them, and choose ", StyleBox["Animate Selected Graphics", FontColor->RGBColor[0, 0, 1]], " from the ", StyleBox["Cell", FontColor->RGBColor[0, 0, 1]], " menu item. You can control the speed and direction of the animation \ using the VCR-like controls at the lower left corner of the notebook window. \ The square wave is in black, and the Fourier approximations are in ", StyleBox["red", FontColor->RGBColor[1, 0, 0]], "." }], "Text"], Cell[BoxData[{\(Clear[n, max, x]\), "\n", RowBox[{"Animate", "[", RowBox[{ RowBox[{"Show", "[", RowBox[{ "sqWavePlot", ",", \(Plot[\[Pi]\/2 + 2\ \(\[Sum]\+\(n = 0\)\%max Sin[\((2\ n + 1)\) x]\/\(2\ n + 1\ \)\), {x, \(-4\)\ \[Pi], 4\ \[Pi]}, PlotStyle \[Rule] RGBColor[1, 0, 0]]\), ",", \(PlotLabel \[Rule] "\" <> ToString[2\ max + 1] <> "\"\), ",", \(PlotRange \[Rule] {\(-1\), 4}\), ",", RowBox[{"ImageSize", "\[Rule]", StyleBox["400", FontColor->RGBColor[1, 0, 1]]}]}], "]"}], ",", RowBox[{"{", RowBox[{"max", ",", "0", ",", StyleBox["30", FontColor->RGBColor[1, 0, 1]], ",", "1"}], "}"}]}], "]"}]}], "Input"] }, Closed]] }, Closed]] }, Open ]] }, FrontEndVersion->"4.0 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 720}}, AutoGeneratedPackage->None, WindowToolbars->"EditBar", WindowSize->{636, 663}, WindowMargins->{{13, Automatic}, {Automatic, 8}} ] (*********************************************************************** 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[1739, 51, 114, 3, 121, "Title"], Cell[1856, 56, 252, 5, 44, "SmallText"], Cell[2111, 63, 226, 6, 52, "Text"], Cell[CellGroupData[{ Cell[2362, 73, 116, 3, 74, "Section"], Cell[2481, 78, 294, 5, 71, "Text"], Cell[2778, 85, 93, 2, 30, "Input", InitializationCell->True], Cell[2874, 89, 1209, 25, 155, "Input", InitializationCell->True], Cell[CellGroupData[{ Cell[4108, 118, 158, 4, 43, "Subsubsection"], Cell[4269, 124, 141, 3, 50, "Input", InitializationCell->True] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[4459, 133, 51, 0, 33, "Section"], Cell[4513, 135, 128, 3, 33, "Text"], Cell[4644, 140, 473, 15, 36, "Text"], Cell[5120, 157, 199, 8, 33, "Text"], Cell[5322, 167, 339, 11, 36, "Text"], Cell[5664, 180, 19, 0, 33, "Text"], Cell[5686, 182, 339, 11, 36, "Text"], Cell[6028, 195, 1377, 36, 150, "Text"], Cell[7408, 233, 528, 9, 90, "Text"], Cell[7939, 244, 30, 0, 33, "Text"], Cell[7972, 246, 328, 7, 76, "Input", InitializationCell->True], Cell[8303, 255, 105, 4, 33, "Text"], Cell[8411, 261, 295, 6, 76, "Input", InitializationCell->True], Cell[8709, 269, 167, 5, 33, "Text"], Cell[8879, 276, 309, 6, 76, "Input", InitializationCell->True] }, Closed]], Cell[CellGroupData[{ Cell[9225, 287, 77, 0, 33, "Section"], Cell[9305, 289, 156, 3, 52, "Text"], Cell[9464, 294, 890, 16, 284, "Input"], Cell[10357, 312, 405, 8, 71, "Text"], Cell[10765, 322, 604, 16, 71, "Text"], Cell[11372, 340, 78, 1, 42, "Input"], Cell[11453, 343, 39, 0, 33, "Text"], Cell[11495, 345, 35, 1, 30, "Input"], Cell[11533, 348, 116, 3, 33, "Text"], Cell[11652, 353, 92, 1, 42, "Input"], Cell[11747, 356, 39, 0, 33, "Text"], Cell[11789, 358, 35, 1, 30, "Input"], Cell[11827, 361, 115, 3, 33, "Text"], Cell[11945, 366, 92, 1, 42, "Input"], Cell[12040, 369, 39, 0, 33, "Text"], Cell[12082, 371, 35, 1, 30, "Input"], Cell[12120, 374, 132, 3, 33, "Text"], Cell[12255, 379, 104, 2, 42, "Input"], Cell[12362, 383, 39, 0, 33, "Text"], Cell[12404, 385, 35, 1, 30, "Input"], Cell[12442, 388, 806, 23, 96, "Text"], Cell[13251, 413, 885, 18, 284, "Input"], Cell[14139, 433, 800, 21, 109, "Text"], Cell[14942, 456, 849, 18, 284, "Input"], Cell[15794, 476, 938, 22, 128, "Text"], Cell[16735, 500, 1040, 22, 304, "Input"], Cell[17778, 524, 108, 3, 33, "Text"], Cell[17889, 529, 63, 1, 30, "Input"], Cell[17955, 532, 137, 3, 33, "Text"], Cell[18095, 537, 60, 2, 50, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[18192, 544, 37, 0, 33, "Section"], Cell[18232, 546, 57, 0, 33, "Text"], Cell[18292, 548, 220, 5, 70, "Input"], Cell[18515, 555, 76, 0, 33, "Text"], Cell[18594, 557, 78, 1, 42, "Input"], Cell[18675, 560, 514, 20, 52, "Text"], Cell[19192, 582, 65, 1, 30, "Input"], Cell[19260, 585, 70, 0, 33, "Text"], Cell[19333, 587, 635, 10, 216, "Input"], Cell[19971, 599, 379, 10, 71, "Text"], Cell[20353, 611, 164, 4, 52, "Text"], Cell[20520, 617, 101, 3, 33, "Text"], Cell[20624, 622, 789, 15, 236, "Input"], Cell[21416, 639, 280, 9, 52, "Text"], Cell[21699, 650, 790, 15, 236, "Input"], Cell[22492, 667, 330, 8, 52, "Text"], Cell[22825, 677, 790, 15, 236, "Input"], Cell[23618, 694, 226, 6, 52, "Text"], Cell[23847, 702, 120, 3, 33, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[24004, 710, 60, 0, 33, "Section"], Cell[CellGroupData[{ Cell[24089, 714, 44, 0, 47, "Subsection"], Cell[24136, 716, 83, 3, 33, "Text"], Cell[24222, 721, 662, 13, 90, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[24921, 739, 51, 0, 31, "Subsection"], Cell[24975, 741, 151, 5, 33, "Text"], Cell[25129, 748, 181, 3, 70, "Input"], Cell[25313, 753, 61, 0, 33, "Text"], Cell[25377, 755, 58, 1, 30, "Input"], Cell[25438, 758, 118, 4, 36, "Text"], Cell[25559, 764, 52, 0, 33, "Text"], Cell[25614, 766, 102, 2, 50, "Input"], Cell[25719, 770, 369, 9, 71, "Text"], Cell[26091, 781, 118, 2, 50, "Input"], Cell[26212, 785, 124, 3, 33, "Text"], Cell[26339, 790, 58, 0, 33, "Text"], Cell[26400, 792, 91, 1, 30, "Input"], Cell[26494, 795, 405, 13, 36, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[26936, 813, 47, 0, 31, "Subsection"], Cell[26986, 815, 718, 16, 109, "Text"], Cell[27707, 833, 847, 19, 156, "Input"] }, Closed]] }, Closed]] }, Open ]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)