NotebookFileName[]

I want this to be the boundary temperature distribution along the unit circle (which is the boundary of the unit disk):

Clear[ff];ff[θ_]=(Pi^2)-(θ^2)

The average temperature along the unit circle is:

(1/(2 Pi))Integrate[ff[θ],{θ,-Pi,Pi}]

For our calculations we will need the inner squares of the functions 1 (the constant function) and the positive integer multiples of cosine

Integrate[1*1,{θ,-Pi,Pi}]

Table[Integrate[ Cos[n θ] Cos[n θ],{θ,-Pi,Pi}],{n,1,20}]

These are the Fourier coefficients of the upside down parabola that we have chosen for the temperature along the boundary (unit circle):

Table[(1/Pi)Integrate[ff[θ] Cos[n θ],{θ,-Pi,Pi}],{n,1,20}]

It is an amazing fact that I can write a partial sum of the Fourier series for the boundary function as the dot product of the list of the coefficients and the list of cosines.

Table[Cos[n θ],{n,1,20}]

This is the inner product

{4,-1,(4/9),-(1/4),(4/25),-(1/9),(4/49),-(1/16),(4/81),-(1/25),(4/121),-(1/36),(4/169),-(1/49),(4/225),-(1/64),(4/289),-(1/81),(4/361),-(1/100)}.{Cos[θ],Cos[2 θ],Cos[3 θ],Cos[4 θ],Cos[5 θ],Cos[6 θ],Cos[7 θ],Cos[8 θ],Cos[9 θ],Cos[10 θ],Cos[11 θ],Cos[12 θ],Cos[13 θ],Cos[14 θ],Cos[15 θ],Cos[16 θ],Cos[17 θ],Cos[18 θ],Cos[19 θ],Cos[20 θ]}

Now define a Fourier approximation for out boundary function

faff[θ_]=((2 (π^2))/3)+4 Cos[θ]-Cos[2 θ]+(4/9) Cos[3 θ]-(1/4) Cos[4 θ]+(4/25) Cos[5 θ]-(1/9) Cos[6 θ]+(4/49) Cos[7 θ]-(1/16) Cos[8 θ]+(4/81) Cos[9 θ]-(1/25) Cos[10 θ]+(4/121) Cos[11 θ]-(1/36) Cos[12 θ]+(4/169) Cos[13 θ]-(1/49) Cos[14 θ]+(4/225) Cos[15 θ]-(1/64) Cos[16 θ]+(4/289) Cos[17 θ]-(1/81) Cos[18 θ]+(4/361) Cos[19 θ]-(1/100) Cos[20 θ]

Let us see how good our approximation is:

Plot[{ff[θ],faff[θ]},{θ,-Pi,Pi},PlotStyle->{{RGBColor[0,0,0],Thickness[0.01]},{RGBColor[1,0,0],Thickness[0.005]}},ImageSize->500]

Quite good.

Notice that the Fourier approximation extends the function periodically to the entire real line

Plot[{ff[θ],faff[θ]},{θ,-3Pi,3Pi},PlotStyle->{{RGBColor[0,0,0],Thickness[0.01]},{RGBColor[1,0,0],Thickness[0.005]}},ImageSize->700]

Now show the unit circle and the boundary temperature in 3-space:

Show[ParametricPlot3D[{Cos[θ],Sin[θ],0},{θ,-Pi,Pi}],ParametricPlot3D[{Cos[θ],Sin[θ],ff[θ]},{θ,-Pi,Pi}],PlotRange->All,BoxRatios->{1,1,1}]

Now we want to write an approximation for the solution. Again using the dot product

{4,-1,(4/9),-(1/4),(4/25),-(1/9),(4/49),-(1/16),(4/81),-(1/25),(4/121),-(1/36),(4/169),-(1/49),(4/225),-(1/64),(4/289),-(1/81),(4/361),-(1/100)}.Table[r^n Cos[n θ],{n,1,20}]

We are ready to write an approximation for the solution

Clear[sol];sol[r_,θ_]=((2 (π^2))/3)+4 r Cos[θ]-(r^2) Cos[2 θ]+(4/9) (r^3) Cos[3 θ]-(1/4) (r^4) Cos[4 θ]+(4/25) (r^5) Cos[5 θ]-(1/9) (r^6) Cos[6 θ]+(4/49) (r^7) Cos[7 θ]-(1/16) (r^8) Cos[8 θ]+(4/81) (r^9) Cos[9 θ]-(1/25) (r^10) Cos[10 θ]+(4/121) (r^11) Cos[11 θ]-(1/36) (r^12) Cos[12 θ]+(4/169) (r^13) Cos[13 θ]-(1/49) (r^14) Cos[14 θ]+(4/225) (r^15) Cos[15 θ]-(1/64) (r^16) Cos[16 θ]+(4/289) (r^17) Cos[17 θ]-(1/81) (r^18) Cos[18 θ]+(4/361) (r^19) Cos[19 θ]-(1/100) (r^20) Cos[20 θ]

See it in 3-space

Show[ParametricPlot3D[{Cos[θ],Sin[θ],0},{θ,-Pi,Pi}],ParametricPlot3D[{Cos[θ],Sin[θ],ff[θ]},{θ,-Pi,Pi}],ParametricPlot3D[{r Cos[θ],r Sin[θ],sol[r,θ]},{r,0,1},{θ,-Pi,Pi},PlotPoints->{30,150}],BoxRatios->{1,1,1},PlotRange->All,ImageSize->500]

What came up in class today was this integral

Table[Integrate[ (((Cos[n θ] ))^2),{θ,-Pi,Pi}],{n,1,20}]

Why is the integral of (((Cos[n θ] ))^2), with  n being a positive integer, over [-π,π] equal to π? One can calculate this integral using some integration method, but here, I want to emphasize the geometric argument that proves it. Since  (((Cos[n θ] ))^2)  is an even function, we can focus only on the interval [0,π]. In fact we will focus first on the interval [0,π/2].

Plot[(((Cos[θ] ))^2),{θ,0,Pi/2},PlotStyle->{{RGBColor[0,0,0.6],Thickness[0.005]}}, PlotRange->{{0,Pi/2},{0,1}},Ticks->{Range[0,Pi,Pi/4],{0,1/2,1}},AspectRatio->Automatic]

Options[%]

(1/2)({ColDown}+{ColUp})

ColDown=Sequence[1,0.5,0];ColDownD=(1/2)({ColDown}+{ColUp});
ColUp=Sequence[0.5,0,1];ColUpD=(1/2)({ColDown}+{ColUp});
ColGr=Sequence[1,0,0];
MyOpts=Sequence[PlotRange->{{0,Pi/2},{-0.002,1.002}},PlotRangeClipping->False,Frame->True,AspectRatio->Automatic,ImageSize->800,ImageResolution->800];

CosSqPis1=Graphics[{
{RGBColor[ColDown],Polygon[Join[{{Pi/2,0},{0,0}},{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64]]]},
{Line[{{0,0},{Pi/2,0},{Pi/2,1},{0,1},{0,0}}]},
{RGBColor[ColGr],Thickness[0.005],Line[{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64]]}
},MyOpts,FrameTicks->{{{0,1/2,1},{0,1/2,1}},{Range[0,Pi,Pi/8],Range[0,Pi,Pi/8]}}]

CosSqPis2=Graphics[{
{RGBColor[ColUp],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64],{{Pi/2,1},{0,1}}]]},
{RGBColor[ColDown],Polygon[Join[{{Pi/2,0},{0,0}},{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64]]]},
{Line[{{0,0},{Pi/2,0},{Pi/2,1},{0,1},{0,0}}]},
{RGBColor[ColGr],Thickness[0.005],Line[{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64]]}
},MyOpts,FrameTicks->{{{0,1/2,1},{0,1/2,1}},{Range[0,Pi,Pi/8],Range[0,Pi,Pi/8]}}]

xx=2.3/8;CosSqPis3=Graphics[{
{RGBColor[ColUp],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64],{{Pi/2,1},{0,1}}]]},
{RGBColor[ColDown],Polygon[Join[{{Pi/2,0},{0,0}},{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64]]]},
{RGBColor[ColDownD],Thickness[0.005],Line[{{#,0},{#,(((Cos[#] ))^2)}}&[xx]]},
{RGBColor[ColUpD],Thickness[0.005],Line[{{#,1},{#,(((Cos[#] ))^2)}}&[Pi/2-xx]]},
{Line[{{0,0},{Pi/2,0},{Pi/2,1},{0,1},{0,0}}]},
{RGBColor[ColGr],Thickness[0.005],Line[{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64]]}
},MyOpts,FrameTicks->{{{0,1/2,1},{0,1/2,1}},{Join[{{xx,"x"}},Range[0,Pi,Pi/8]],Join[{{Pi/2-xx,"(π/2)-x"}},Range[0,Pi,Pi/8]]}}]

Manipulate[Graphics[{
{RGBColor[ColUp],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64],{{Pi/2,1},{0,1}}]]},
{RGBColor[ColDown],Polygon[Join[{{Pi/2,0},{0,0}},{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64]]]},
{RGBColor[ColDownD],Thickness[0.005],Line[{{#,0},{#,(((Cos[#] ))^2)}}&[xx]]},
{RGBColor[ColUpD],Thickness[0.005],Line[{{#,1},{#,(((Cos[#] ))^2)}}&[Pi/2-xx]]},
{Line[{{0,0},{Pi/2,0},{Pi/2,1},{0,1},{0,0}}]},
{RGBColor[ColGr],Thickness[0.005],Line[{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64]]}
},MyOpts,FrameTicks->{{{0,1/2,1},{0,1/2,1}},{Join[{{xx,"x"}},Range[0,Pi,Pi/8]],Join[{{Pi/2-xx,"(π/2)-x"}},Range[0,Pi,Pi/8]]}},AspectRatio->Automatic,ImageSize->600],{xx,0,Pi/2},ControlPlacement->Top]

Manipulate[Graphics[{
{RGBColor[ColUp],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[Pi/2-xx,Pi/2,Pi/256],{{Pi/2,0},{Pi/2,1},{Pi/2-xx,1}}]]},
{RGBColor[ColDown],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[xx,0,-Pi/256],{{0,1},{0,0},{xx,0}}]]},
{RGBColor[ColDownD],Thickness[0.005],Line[{{#,0},{#,(((Cos[#] ))^2)}}&[xx]]},
{RGBColor[ColUpD],Thickness[0.005],Line[{{#,1},{#,(((Cos[#] ))^2)}}&[Pi/2-xx]]},
{Line[{{0,0},{Pi/2,0},{Pi/2,1},{0,1},{0,0}}]},
{RGBColor[ColGr],Thickness[0.006],Line[{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/256]]}
},MyOpts,FrameTicks->{{{0,1/2,1},{0,1/2,1}},{Join[{{xx,"x"}},Range[0,Pi,Pi/8]],Join[{{Pi/2-xx,"(π/2)-x"}},Range[0,Pi,Pi/8]]}},ImageSize->400],{xx,Pi/256,Pi/2},ControlPlacement->Top]

st=Pi/512;CosSqPisAni=Table[Graphics[{
{RGBColor[ColUp],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[Pi/2-xx,Pi/2,Pi/256],{{Pi/2,0},{Pi/2,1},{Pi/2-xx,1}}]]},
{RGBColor[ColDown],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[xx,0,-Pi/256],{{0,1},{0,0},{xx,0}}]]},
{RGBColor[ColDownD],Thickness[0.005],Line[{{#,0},{#,(((Cos[#] ))^2)}}&[xx]]},
{RGBColor[ColUpD],Thickness[0.005],Line[{{#,1},{#,(((Cos[#] ))^2)}}&[Pi/2-xx]]},
{Line[{{0,0},{Pi/2,0},{Pi/2,1},{0,1},{0,0}}]},
{RGBColor[ColGr],Thickness[0.006],Line[{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/256]]}
},MyOpts,FrameTicks->{{{0,1/2,1},{0,1/2,1}},{Join[{{xx,"x"}},Range[0,Pi,Pi/8]],Join[{{Pi/2-xx,"(π/2)-x"}},Range[0,Pi,Pi/8]]}}],{xx,st,Pi/2,st}];

Length[CosSqPisAni]

CosSqPis4=Graphics[{
{RGBColor[ColUp],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[0,Pi,Pi/64],{{0,1}}]]},
{RGBColor[ColDown],Polygon[Join[{{Pi/2,0},{0,0}},{#,(((Cos[#] ))^2)}&/@Range[0,Pi/2,Pi/64]]],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[Pi/2,Pi,Pi/64],{{Pi,1},{Pi,0},{Pi/2,0}}]]},

{Thickness[0.001],Line[{{0,0},{Pi/2,0},{Pi/2,1},{0,1},{0,0}}],Line[{{Pi/2,0},{Pi,0},{Pi,1},{Pi/2,1}}]},
{RGBColor[ColGr],Thickness[0.005],Line[{#,(((Cos[#] ))^2)}&/@Range[0,Pi,Pi/64]]}
},PlotRange->{{0,Pi},{-0.005,1.005}},PlotRangeClipping->True,Frame->True,FrameTicks->{{{0,1/2,1},{0,1/2,1}},{Range[0,Pi,Pi/4],Range[0,Pi,Pi/4]}},BaseStyle->{FontSize->4}]

CosSqPis5=Graphics[{
{RGBColor[ColUp],Polygon[Join[{#,(((Cos[#] ))^2)}&/@Range[-Pi,Pi,Pi/64],{{0,1}}]]},
{RGBColor[ColDown],Polygon[Join[{{Pi,1},{Pi,0},{-Pi,0},{-Pi,1}},{#,(((Cos[#] ))^2)}&/@Range[-Pi,Pi,Pi/64]]]},
{Thickness[0.001],Line[{{-Pi,0},{Pi,0},{Pi,1},{-Pi,1},{-Pi,0}}],Line[{{#,0},{#,1}}]&/@{-Pi/2,0,Pi/2}},
{RGBColor[ColGr],Thickness[0.005],Line[{#,(((Cos[#] ))^2)}&/@Range[-Pi,Pi,Pi/64]]}
},PlotRange->{{-Pi,Pi},{-0.005,1.005}},PlotRangeClipping->True,Frame->True,FrameTicks->{{{0,1/2,1},{0,1/2,1}},{Range[-Pi,Pi,Pi/2],Range[-Pi,Pi,Pi/2]}},BaseStyle->{FontSize->4}]

NotebookDirectory[]

SetDirectory[NotebookDirectory[]]

NotebookFileName[]

(* 
Export["CosSqPis1.png",CosSqPis1,"PNG","ImageResolution"->800];
Export["CosSqPis2.png",CosSqPis2,"PNG","ImageResolution"->800];
Export["CosSqPis3.png",CosSqPis3,"PNG","ImageResolution"->800];
Export["CosSqPis4.png",CosSqPis4,"PNG","ImageResolution"->800];
Export["CosSqPis5.png",CosSqPis5,"PNG","ImageResolution"->800];
*)

dds=0.3&/@Range[Length[CosSqPisAni]];

(* 
Export["CosSqPisAniS1.gif",CosSqPisAni[[1]],"gif","ImageSize"->800];
Export["CosSqPisAni.gif",CosSqPisAni,"gif","AnimationRepetitions"->Infinity,"ImageSize"->800,"DisplayDurations"->dds];
*)