DE.03 Laplace Transform and Fourier Analysis
 LITERACY

\(Needs["Graphics`Colors`"]; 

    Graphics`Colors`GosiaGreen = RGBColor[0, \ 0.392187, \ 0]; 

    Needs["Graphics`FilledPlot`"]; 


    If[MemberQ[{"Global`", "Graphics`Common`GraphicsCommon`", 
          "Vector3D`"}, \ Context[ScaleFactor]], 
      Remove["*`ScaleFactor"]]; 
<< "Graphics`Legend`"; 
    
<< "Graphics`Common`GraphicsCommon`"; 

    Remove["*`ScaleFactor"]; 

Off[General::"spell"]; 

    \(Off[General::"spell1"]; \)\)Off[ParametricPlot3D::"ppcom"]; Off[ParametricPlot::"ppcom"]; \(Off[Plot::"plnr"]; 
Needs["Calculus`Master`"]; 

    Off[Unique::"usym"]; 
SetOptions[Limit, Analytic -> True]; 
    \)

CMView = {2.7, 1.6, 1.2}; \(Clear[FastFourierfit, Fourierfitters, F, Fvalues, n, k, jump, num, 
      numtab, coeffs, t, L]; 
jump[n_] := \(jump[n] = N[1\/\(2\ n\)]\); 

    \(Fvalues[F_, L_, n_] := N[Table[F[L\ t], {t, 0, 1 - jump[n], jump[n]}]]; 
    \)\)numtab[n_] := numtab[n] = Table[k, {k, 1, n}]; Fourierfitters[L_, n_, t_] := 
      Table[(E^(((2 π I k t)/L))), {k, -n + 1, n - 1}]; coeffs[n_, list_] := 
      (1/N)[(Sqrt[Length])[list]] 
        (Join[Reverse[
              Fourier[list][[numtab[n]
                  ]]], 
            InverseFourier[list][[Drop[numtab[n], 1]
                ]]])FastFourierfit[F_, L_, n_, t_] := 
      Chop[Fourierfitters[L, n, t] . coeffs[n, Fvalues[F, L, n]]]; \(L := 
      Expand[a\ ∂\_{#2, 2}#1 + b\ ∂\_#2 #1 + c\ #1]&\)

Off[Graphics::"gpt"]

New Vector Drawers

BeginPackage["Vector3D`", "Graphics`Colors`"];

\(Axes3D::"usage" = 
      "Axes3D[a, b] creates a Graphics3D object of cartesian axes with x, y, and z running from -a/3 to a, and with axes labels b units beyond the tips of the axes.  Axes3D[a] is Axes3D[a, a/8]."; 

    \(Perpend::"usage" = 
      "Perpend[a] returns a unit vector which is perpendicular to the vector a."; \)\)Arrow::"usage" = 
      "Arrow[a] produces a 2 or 3 dimensional vector from the origin to a. \
Arrow[a, Tail -> tail] gives a vector from tail to a."; Vector::"usage" = 
      "Vector[a, b] gives a 2D or 3D vector from a to b."; ArrowHead::"usage" = 
      "ArrowHead[a, vec] produces an arrowhead with its tip placed at the \
point a, pointing in the direction of the vector vec."; Tail::"usage" = 
      "Tail -> point puts the tail of the vector at point."; Norm::"usage" = 
      "Norm[vec] returns the Euclidean length of vec."; Normalize::"usage" = 
      "Normalize[vec] returns a unit vector in the direction of vec, \
provided vec is nonzero."; Aperture::"usage" = 
      "Aperture is the ratio of the radius of the base to the length of the \
head of a vector."; TipSize::"usage" = 
      "TipSize specifies an absolute size for the inner tip length of the \
head of a vector."; TipRatio::"usage" = 
      "TipRatio is the ratio of the inner length of the arrowhead to the \
length of the shaft of a vector."; HeadRatio::"usage" = 
      "HeadRatio is the ratio of the outer length of the arrowhead to the \
length of the shaft of a vector."; HeadSize::"usage" = 
      "HeadSize specifies an absolute size for the head of a vector."; 
    ScaleFactor::"usage" = 
      "ScaleFactor specifies the amount to scale a vector in length and may \
be either a number or a pure function."; ZeroVectorPointSize::"usage" = 
      "ZeroVectorPointSize is the size of the point used to represent a \
zero vector."; Options[Vector] = 
      Options[Arrow] = 
        Options[ArrowHead] = {HeadRatio -> 0.18, 
            TipRatio -> 0.14, Aperture -> 0.3, 
            ScaleFactor -> 1, HeadType -> Polygon, 
            ShaftQ -> True, EdgesQ -> True, 
            VectorColor -> RGBColor[0, 0, 1], ShaftWidth -> 0.005, 
            ZeroVectorPointSize -> 0.01}; Begin["`Private`"]; SetOptions[ParametricPlot, AspectRatio -> Automatic]; SetOptions[Plot, AspectRatio -> Automatic]; SetOptions[Graphics, AspectRatio -> Automatic]; Axes3D[u_, v_] := 
      Graphics3D[{{Blue, Line[{{-(u/3), 0, 0}, {u, 0, 0}}]}, 
          Text["x", {u + v, 0, 0}], {Blue, 
            Line[{{0, -(u/3), 0}, {0, u, 0}}]}, 
          Text["y", {0, u + v, 0}], {Blue, 
            Line[{{0, 0, -(u/3)}, {0, 0, u}}]}, 
          Text["z", {0, 0, u + v}]}]; Axes3D[u_] := Axes3D[u, (u/8)]; Norm[a_?VectorQ] := N[(Sqrt[a . a])]; Normalize[a_?VectorQ] := If[a . a == 0, a, (a/Norm)[a]]; Perpend[a_?VectorQ] := 
      Normalize[{a[[2]], 
            -a[[1]]}] /; 
        Length[a] == 2Perpend[a_?VectorQ] := 
      Normalize[
          If[a[[1]] == 0, {1, 0, 0}, {0, 
              a[[3]], 
              -a[[2]]}]] /; 
        Length[a] == 3Base3D = 
      Table[{Cos[((2 k π)/8.) ], Sin[((2 k π)/8.) ]}, {k, 0, 
          8}]; Vector[from_?VectorQ, to_?VectorQ, opts___] := 
      Module[{sq, sw, ht, hs, hr, tr, ap, sf, vc, zvps, diff = to - from, 
            tip}, {sq, sw, ht, hs, hr, ts, tr, ap, sf, vc, zvps} = 
            {ShaftQ, ShaftWidth, HeadType, HeadSize, HeadRatio, TipSize, 
                  TipRatio, Aperture, ScaleFactor, VectorColor, 
                  ZeroVectorPointSize} /. {opts} /. Options[Vector]; 
          If[from == to, 
            Return[Graphics[{PointSize[zvps], vc, Point[from]}]]]; 
          diff = If[NumberQ[N[sf]], sf diff, sf[diff]]; tip = from + diff; 
          If[NumberQ[hs], hr = (hs/Norm)[diff]; tr = 0.75 hr]; 
          If[NumberQ[ts], tr = (ts/Norm)[diff]]; 
          Graphics[{
              If[sq, {vc, Thickness[sw], Line[{from, tip - tr diff}]}, {}], 
              With[{trans = ap hr Norm[diff] Perpend[diff]}, {vc, 
                  Thickness[sw], 
                  ht[{tip, tip - hr diff + trans, tip - tr diff, 
                      tip - hr diff - trans, tip}]}]}]] /; 
        Length[from] == Length[to] == 2Vector[from_?VectorQ, to_?VectorQ, opts___] := 
      Module[{sq, eq, sw, hs, hr, tr, ap, sf, vc, zvps, diff = to - from, 
            tip}, {sq, eq, sw, hs, hr, ap, sf, vc, zvps} = 
            {ShaftQ, EdgesQ, ShaftWidth, HeadSize, HeadRatio, Aperture, 
                  ScaleFactor, VectorColor, ZeroVectorPointSize} /. {opts}
                   /. Options[Vector]; 
          If[from == to, 
            Return[Graphics3D[{PointSize[zvps], vc, Point[from]}]]]; 
          diff = If[NumberQ[N[sf]], sf diff, sf[diff]]; tip = from + diff; 
          If[NumberQ[hs], hr = (hs/Norm)[diff]]; tr = (hr/2); 
          Graphics3D[{
              If[sq, {vc, Thickness[sw], Line[{from, tip - tr diff}]}, {}], 
              If[eq, {}, EdgeForm[]], {SurfaceColor[vc], 
                With[{temp = Perpend[diff]}, 
                  (Polygon[Append[#1, tip]]&)/@
                    Partition[
                      (tip - hr diff + #1&)/@
                        ((ap hr Norm[diff] Base3D) . {temp, 
                              Normalize[temp\[Cross]diff]}), 2, 1]]}}]] /; 
        Length[from] == Length[to] == 3Arrow[a_, Tail -> b_, opts___] := Vector[b, a + b, opts]Arrow[a_, opts___] := Vector[Table[0, {Length[a]}], a, opts]\(ArrowHead[a_, b_, opts___] := 
      Vector[a - b, a, ShaftQ -> False, opts]; 

End[]; 

    \(EndPackage[]; \)\)

VectorField and Phase Lines

BeginPackage["PhaseStuff`", "Vector3D`", 
      "Utilities`FilterOptions`"]; PhaseLine::"usage" = 
      "PhaseLine[fcn,{var,a,b},tint,pos] makes a vertical phase line for \
the function, fcn, of the variable, var, for the variable going from a to b, \
with  a color given by tint,  at the x-coordinate pos."; PhaseLine3D::"usage" = 
      "PhaseLIne3D[fcn,{var,a,b},tint,loc] makes a vertical phase line for \
the function, fcn, of the variable, var, for the variable going from a to b, \
with  a color given by tint, and base point at loc = {x,y}"; VectorField::"usage" = 
      "VectorField[{function,{var1,a,b,space1},{var2,c,d,space2}] will make \
a vector field of normalized vectors, colored by magnitude, for the function \
of the variables on the range {r1,r2} with spacing between points given by  \
{space1, space2}.  If a single function of a single variable is given, the \
vector field {1,f} will be plotted."; StikPikXZ::"usage" = 
      "StikPikXZ[picture,a:_0] takes a 2 dimensional Mathematica picture \
and embeds it on the XZ plane at y = a.   Some optional characteristics of \
the graphs are lost in the  process.  StikPikYZ and StikPikXZ are \
similar."; StikPikYZ::"usage" = 
      "StikPikYZ[picture,a:_0] takes a 2 dimensional Mathematica picture \
and embeds it on the XZ plane at y = a.   Some optional characteristics of \
the graphs are lost in the  process.  StikPikYZ and StikPikXZ are \
similar."; StikPikXY::"usage" = 
      "StikPikXY[picture,a:_0] takes a 2 dimensional Mathematica picture \
and embeds it on the XZ plane at y = a.   Some optional characteristics of \
the graphs are lost in the  process.  StikPikYZ and StikPikXZ are \
similar."; Begin["`Private`"]; PhaseLine[fcn_, {var_, a_, b_}, tint_, pos_:  0] := 
      Module[{len, len1, k, zset, zero, zero1, signs, stick, dots, pointers}, 
        zset = Solve[fcn == 0, var]; 
        zero = If[Length[zset] == 0, {}, var /. zset]; zero = Sort[zero]; 
        zero = Select[zero, #1 ≥ a && #1 ≤ b&]; 
        zero1 = Sort[zero ⋃ {a, b}]; len = Length[zero]; 
        len1 = Length[zero1]; 
        signs = Table[
            Sign[fcn /. 
                var -> 
                  (1/2) (
                      zero1[[k + 1]] + 
                        zero1[[k]])], {
              k, 1, len1 - 1}]; 
        stick = {Thickness[0.007], Line[{{pos, a}, {pos, b}}]}; 
        dots = (Point[{pos, #1}]&)/@zero; 
        dots = Join[{PointSize[0.05], tint}, dots]; 
        heads = Table[
            MakeHead[zero1[[k]], 
              zero1[[k + 1]], pos, 
              signs[[k]], b - a, tint], {
              k, 1, len1 - 1}]; 
        Return[{Graphics[Join[{tint}, stick, dots]], heads}]]MakeHead[a_, b_, c_, s_, slen_, tint_] := 
      Module[{u, v, w}, u = Min[2 (b - a), ((3 slen)/4)]; 
        Return[ArrowHead[{c, a ( .5 - (s/5)) + b ( .5 + (s/5))}, {0, 
              s u}, VectorColor -> tint]]]PhaseLine3D[fcn_, {var_, a_, b_}, tint_, pos_: {0, 0}] := 
      Module[{len, len1, k, zset, zero, zero1, signs, stick, dots, pointers}, 
        zset = Solve[fcn == 0, var]; 
        zero = If[Length[zset] == 0, {}, var /. zset]; zero = Sort[zero]; 
        zero = Select[zero, #1 ≥ a && #1 ≤ b&]; 
        zero1 = Sort[zero ⋃ {a, b}]; len = Length[zero]; 
        len1 = Length[zero1]; 
        signs = Table[
            Sign[fcn /. 
                var -> 
                  (1/2) (
                      zero1[[k + 1]] + 
                        zero1[[k]])], {
              k, 1, len1 - 1}]; 
        stick = {Thickness[0.007], 
            Line[{{pos[[1]], 
                  pos[[2]], a}, {
                  pos[[1]], 
                  pos[[2]], b}}]}; 
        dots = 
          (Point[{pos[[1]], 
                    pos[[2]], #1}]&)/@
            zero; dots = Join[{PointSize[0.03], tint}, dots]; 
        heads = Table[
            MakeHead3D[zero1[[k]], 
              zero1[[k + 1]], pos, 
              signs[[k]], b - a, tint], {
              k, 1, len1 - 1}]; 
        Return[{Graphics3D[Join[{tint}, stick, dots]], heads}]]MakeHead3D[a_, b_, c_, s_, slen_, tint_] := 
      Module[{u, v, w}, u = Min[2 (b - a), (slen/2)]; 
        Return[ArrowHead[{c[[1]], 
              c[[2]], 
              a ( .5 - (s/5)) + b ( .5 + (s/5))}, {0, 0, s u}, 
            VectorColor -> tint]]]VectorField[
        function_List, {var1_, a_, b_, sp1_:  1}, {var2_, c_, d_, 
          sp2_:  1}] := 
      Module[{i, j, U, V, UU, VV, ulow, uhigh, vlow, vhigh, maxval, minval, 
          lengths, directions, locations, mlen}, mlen = Min[sp1, sp2]; 
        normf[uu_, vv_] = 
          (Sqrt[function[[1]]^2 + 
                function[[2]]^2]) /. {
              var1 -> uu, var2 -> vv}; 
        lengths = Table[N[normf[U, V]], {U, a, b, sp1}, {V, c, d, sp2}]; 
        maxval = Max[lengths]; minval = Min[lengths]; 
        If[minval == maxval, maxval += 1]; 
        locations = Table[{uu, vv}, {uu, a, b, sp1}, {vv, c, d, sp2}]; 
        directions = 
          Table[If[N[normf[U, V]] == 0, {0, 0}, 
              ((mlen (function /. {var1 -> U, var2 -> V})
                    )/(1.3 N[normf[U, V]]))], {U, a, b, sp1}, {V, c, d, 
              sp2}]; {UU, VV} = 
          Dimensions[directions][[{1, 2}
              ]]; 
        Return[Table[
            Arrow[directions[[i, j]], 
              Tail -> 
                locations[[i, j]], 
              Aperture -> 1, HeadRatio ->  .4, 
              ShaftWidth -> 0.008, 
              VectorColor -> 
                RGBColor[
                  ((lengths[[i, j]] - 
                      minval)/(maxval - minval)), 0, 
                  ((maxval - 
                      lengths[[i, j
                        ]])/(maxval - minval))]], {i, 
              UU}, {j, VV}]]]VectorField[
        function_, {var1_, a_, b_, sp1_:  1}, {var2_, c_, d_, sp2_:  1}] := 
      VectorField[{1, function}, {var1, a, b, sp1}, {var2, c, d, sp2}]Needs["Utilities`FilterOptions`"]FixOptions[a_] := 
      Module[{picture = a, opt3}, 
        If[Options[picture] ≠ {}, 
          opt3 = (FilterOptions[Graphics3D, #1]&)/@Options[picture]; 
          opt3 = opt3 //. {
                (AxesLabel -> _) -> AxesLabel -> None, 
                (PlotRange -> _) -> 
                  PlotRange -> Automatic, 
                (PlotRegion -> _) -> 
                  PlotRegion -> Automatic, 
                (Ticks -> _) -> Ticks -> Automatic}; 
          picture = List@@picture; 
          picture[[-1]] = opt3; 
          picture = Graphics3D@@picture]; Return[picture]]StikPikXZ[picture_, a_:  0] := 
      Module[{PIK3 = picture}, 
        PIK3 = PIK3 //. {
              Graphics -> Graphics3D, {u_?NumberQ, v_?NumberQ} 
                :> {u, a, v}}; PIK3 = FixOptions[PIK3]; 
        Return[PIK3]]StikPikYZ[picture_, a_:  0] := 
      Module[{PIK3 = picture}, 
        PIK3 = PIK3 //. {
              Graphics -> Graphics3D, {u_?NumberQ, v_?NumberQ} 
                :> {a, u, v}}; PIK3 = FixOptions[PIK3]; 
        Return[PIK3]]StikPikXY[picture_, a_:  0] := 
      Module[{PIK3 = picture}, 
        PIK3 = PIK3 //. {
              Graphics -> Graphics3D, {u_?NumberQ, v_?NumberQ} 
                :> {u, v, a}}; PIK3 = FixOptions[PIK3]; 
        Return[PIK3]]End[]; EndPackage[];

ThreeAxes[u,v]

ThreeAxes[u_, v_] := 
      Graphics3D[{{Blue, Line[{{-u, 0, 0}, {u, 0, 0}}]}, 
          Text["x", {u + v, 0, 0}], {Blue, 
            Line[{{0, -u, 0}, {0, u, 0}}]}, 
          Text["y", {0, u + v, 0}], {Blue, Line[{{0, 0, 0}, {0, 0, u}}]}, 
          Text["z", {0, 0, u + v}]}]; ThreeAxes[u_] := ThreeAxes[u, (u/8)]; ThreeAxes::"usage" = 
      "ThreeAxes[a,b] makes a standard cartesian axis graphics object with \
x, y, and z running from -a to a, and with axis labels b units beyond the \
tips of the axes.  ThreeAxes[a] is ThreeAxes[a,a/8].";

Crisscross

\(Clear[x]; 

    crisscross = 
      Plot[{Cos[x], Sin[x]}, {x, π\/8, \(3\ π\)\/8}, 
        PlotStyle -> {{RGBColor[1, 0, 0], Thickness[0.02]}}, 
        Axes -> None, AspectRatio -> 1\/3, 
        DisplayFunction -> Identity]; \)

Pendulum Stuff

modticksX[gr_Graphics, m_] := 
      Module[{f, x}, f[{a_, "", st___}] := {a, ""}; 
        f[{a_, b_, st___}] := {a, b m}; 
        Show[gr, AxesOrigin -> Reverse[FullOptions[gr, AxesOrigin]], 
          Ticks -> {
              f/@FullOptions[gr, Ticks][[1
                  ]], Automatic}]]

modticksY[gr_Graphics, m_] := 
      Module[{f, x}, f[{a_, "", st___}] := {a, ""}; 
        f[{a_, b_, st___}] := {a, b m}; 
        Show[gr, AxesOrigin -> Reverse[FullOptions[gr, AxesOrigin]], 
          Ticks -> {Automatic, 
              f/@FullOptions[gr, Ticks][[2
                  ]]}]]

Clear[center, angle, length, a, l, pendulum, calibratedpendulum];

pendulum[length_, angle_] := 
      Module[{center := {length Sin[π - angle], 
              length Cos[π - angle]}}, 
        Show[Graphics[{Blue, Thickness[ .01], 
              Line[{{0, 0}, {0, -(length + 3)}}]}], 
          Graphics[{Blue, 
              Polygon[{{-5, -(length + 3)}, {-5, 
                    -(length + 3.5)}, {-5.3, 
                    -(length + 3.5)}, {-5.3, 
                    -(length + 4)}, {5.3, -(length + 4)}, {
                    5.3, -(length + 3.5)}, {5, 
                    -(length + 3.5)}, {5, -(length + 3)}, {
                    -5, -(length + 3)}}]}], 
          Graphics[{Black, 
              Disk[{0, 0}, 
                length, {-(π/2) + angle - (π/84), 
                  -(π/2) + angle + (π/84)}]}], 
          Graphics[{Black, 
              Disk[center, 
                length, {(π/2) + angle - (π/500), 
                  (π/2) + angle + (π/500)}]}], 
          Graphics[{Red, PointSize[ .05], Point[{0, 0}]}], 
          Graphics[{Red, Disk[center, (length/5), {0, 360 Degree}]}], 
          Graphics[{GoldenrodLight, 
              Disk[center, (length/6), {330 Degree, 350 Degree}]}], 
          Graphics[{Red, Disk[center, (length/7), {0, 360 Degree}]}], 
          Graphics[{Black, PointSize[ .02], Point[center]}], 
          AspectRatio -> Automatic, 
          PlotRange 
            -> {{length + 5, -(length + 3)}, {length + 4, 
                -(length + 4)}}, AxesOrigin -> {0, 0}, 
          DisplayFunction -> Identity]]

calibratedpendulum[length_, angle_]:=Module[{center := {length Sin[π - angle], length Cos[π - angle]}}
            ,Show[Graphics[{Blue, Thickness[ .01], 
                  Line[{{0, 0}, {0, -(length + 3)}}]}],Graphics[{Blue, 
                  Polygon[{{-5, -(length + 3)}, {-5, 
                        -(length + 3.5)}, {-5.3, 
                        -(length + 3.5)}, {-5.3, 
                        -(length + 4)}, {5.3, 
                        -(length + 4)}, {5.3, 
                        -(length + 3.5)}, {5, 
                        -(length + 3.5)}, {5, 
                        -(length + 3)}, {-5, 
                        -(length + 3)}}]}],Graphics[{Black, 
                  Disk[{0, 0}, 
                    length, {-(π/2) + angle - (π/84), 
                      -(π/2) + angle + (π/84)}]}],Graphics[{Black, 
                  Disk[center, 
                    length, {(π/2) + angle - (π/500), 
                      (π/2) + angle + (π/500)}]}],Graphics[{Red, PointSize[ .05], Point[{0, 0}]}],Graphics[{Red, Disk[center, (length/5), {0, 360 Degree}]}],Graphics[{GoldenrodLight, 
                  Disk[center, (length/6), {330 Degree, 350 Degree}]}],Graphics[{Red, 
                  Disk[center, (length/7), {0, 360 Degree}]}],Graphics[{Black, PointSize[ .02], Point[center]}],Graphics[Text["y[t] =  \!\(angle\)",{(8/8) length Sin[((15 π)/12)], 
                      (8/8) length Cos[((5 π)/6)]}]],AspectRatio -> Automatic,PlotRange 
                -> {{length + 5, -(length + 3)}, {length + 4, 
                    -(length + 4)}},AxesOrigin -> {0, 0},DisplayFunction -> Identity]]

L.1)

Look at these calculations of  
        (∫_0^∞) (E^(-s t)) f[t] 
          dt
and the Laplace transform of f[t] for three sample f[t]'s:

\(Clear[f, s, t]; 
f[t_] = Sin[t]; 
    
{∫\_0\%∞\( E\^\(\(-s\)\ t\)\ f[t]\) 
          \[DifferentialD]t, LaplaceTransform[f[t], t, s]}\)

\(Clear[f, s, t, k]; 
f[t_] = t; 
    
{∫\_0\%∞\( E\^\(\(-s\)\ t\)\ f[t]\) 
          \[DifferentialD]t, LaplaceTransform[f[t], t, s]}\)

\(Clear[f, s, t, k]; 
f[t_] = DiracDelta[t - 5.4]; 
    
{∫\_0\%∞\( E\^\(\(-s\)\ t\)\ f[t]\) 
          \[DifferentialD]t, LaplaceTransform[f[t], t, s]}\)

Explain why any Laplace literate person knows in advance that the calculations were guaranteed to come out the way they did.

L.2)

Here is Mathematica's calculation of the the Laplace transform of 
     f[t] = 2.2 DiracDelta[t - 3.5] + 3.8 DiracDelta[t - 5.6]:

\(Clear[f, t, s]; 

    f[t_] = 2.2\ DiracDelta[t - 3.5] + 3.8\ DiracDelta[t - 5.9]; 

    LaplaceTransform[f[t], t, s]\)

Use the definition
     LaplaceTransform[f[t], t, s] = 
        (∫_0^∞) (E^(-s t)) f[t] 
            dt
to  say why you could have written this down without help from Mathematica. 

Without machine help, write down the formula for the Laplace transform of
       f[t] = 
        DiracDelta[t - 1] + 2 DiracDelta[t - 2] + 3 DiracDelta[t - 3]

L.3)

When you go with a function of t such as
        f[t] = 3.8 (E^(-0.4 t)) Cos[4.7 t], 
and calculate its Laplace transform F[s], you get:

\(Clear[f, F, t, s]; 
f[t_] = 3.8\ E\^\(\(-0.4\)\ t\)\ Cos[4.7\ t]; 

    F[s_] = LaplaceTransform[f[t], t, s]\)

You began with a function f[t] of t and learned that its Laplace transform F[s] is a function of s.  
Is this a problem?

L.4)

Here is a little table of Laplace transforms:

Clear[f, F, s, t, a, b]; {f[t_] = (E^(a t)), F[s_] = LaplaceTransform[f[t], t, s]}Clear[f, F, s, t, a, b]; {f[t_] = Cos[a t], F[s_] = LaplaceTransform[f[t], t, s]}Clear[f, F, s, t, a, b]; {f[t_] = Sin[a t], F[s_] = LaplaceTransform[f[t], t, s]}Clear[f, F, s, t, a, b]; {f[t_] = (E^(a t)) Cos[b t], 
      F[s_] = Together[ExpandAll[LaplaceTransform[f[t], t, s]]]}Clear[f, F, s, t, a, b]; {f[t_] = (E^(a t)) Sin[b t], 
      F[s_] = Together[ExpandAll[LaplaceTransform[f[t], t, s]]]}

Use this table to come up with the function f[t] whose Laplace transform is:
         i) F[s] = ((3 s)/((s^2) +  4)) + (5/((s^2) +  9)),
         ii) F[s] = ((s - 3)/(13  - 6 s  +  (s^2))),
         iii) F[s] = ((s - 5)/(13  - 6 s  +  (s^2))),
         iv) F[s] = 
        (3/((s^2) + 5 s + 6)) = 
          (3/((s  +  2) (s  +  3))).
For iv), you might want to look at:

\(Clear[f, g, h, t, s, x, y]; 

    h[t_] = ∫\_0\%t\( f[t - x]\ g[x]\) \[DifferentialD]x; 

    LaplaceTransform[h[t], t, s]\)

L.4)

How do you express the Laplace Transform of y'[t] in terms of the Laplace transform of y[t]?
How do you express the Laplace Transform of y''[t] in terms of the Laplace transform of y[t]?

L.5)

Given
        y''[t]+4 y[t]=0.5
with y[0] = 2 and y'[0]=-1, 
Write down a formula for the Laplace transform of the solution y[t].
Use the table above to write down a formula for y[t].

L.6)

a) A certain function plots out this way:

\(Clear[f, t]; 
f[t_] = 4\ Sign[Sin[3\ t]]; 
\(L = \(2\ π\)\/3; 
    \)\)cycles = 6; Plot[f[t], {t, 0, cycles L}, 
      PlotStyle -> {{Thickness[0.01], Blue}}, 
      AxesLabel -> {"t", ""}, AspectRatio -> (1/3)];

Does this plot make you want to say that the plotted function is periodic? If you say that this function is periodic, then what's your best estimate of the period of the function? 

b) Another function plots out this way:

\(Clear[f, t]; 
f[t_] = t\/3 - Floor[t\/3]; 
\(L = 3; \)\)cycles = 4; Plot[f[t], {t, 0, cycles L}, 
      PlotStyle -> {{Thickness[0.02], Blue}}, 
      AxesLabel -> {"t", ""}, AspectRatio -> (1/3)];

Does this plot make you want to say that the plotted function is periodic?  If you say that this function is periodic, then what's your best estimate of the period of the function? 

c) Yet another function plots out this way:

\(Clear[f, t]; 
f[t_] = 8\ E\^\(\(-0.2\)\ t\)\ \((t\/2 - Floor[t\/2])\); 
    
\(L = 3; \)\)cycles = 7; Plot[f[t], {t, 0, cycles L}, 
      PlotStyle -> {{Thickness[0.015], Blue}}, 
      AxesLabel -> {"t", ""}, AspectRatio -> (1/3)];

Does this plot make you want to say that the plotted function is periodic?  If you say that this function is periodic, then what's your best estimate of the period of the function? 


d) Here's the plot of a certain function on [0, 2]:

\(Clear[f, t]; 
f[t_] = 4\ Sign[Cos[π\ t]]\ Sin[π\ t]; 

    \(Plot[f[t], {t, 0, 2}, PlotRange -> {{0, 4}, {\(-5\), 5}}, 
      PlotStyle -> {{Thickness[0.01], Blue}}, 
      AxesLabel -> {"t", "f[t]"}, AspectRatio -> 1\/2]; 
    \)\)

Given that f[t] is periodic with period L = 2, pencil in your sketch of how the plot of f[t] looks on [0, 4].

L.7)

a)  Look at this plot of 
       f[t] = 3 (Ceiling[(t/4)] - (t/4)):

\(Clear[f, t]; 
f[t_] = 3\ \((Ceiling[t\/4] - t\/4)\); 

    \(Plot[f[t], {t, 0, 13}, PlotStyle -> {{Thickness[0.01], Blue}}, 
      AspectRatio -> 1\/GoldenRatio, 
      AxesLabel -> {"t", "f[t]"}, PlotRange -> All]; \)\)

This function is periodic. 
Identify the period L of this function.

b) Look at this plot of 
       f[t] = 10 (Ceiling[(t/3)] + Floor[(t/2)] - ((5 t)/6)):

\(Clear[f, t]; 

    f[t_] = 10\ \((Ceiling[t\/3] + Floor[t\/2] - \(5\ t\)\/6)\); 

    \(Plot[f[t], {t, 0, 21}, PlotStyle -> {{Thickness[0.01], Blue}}, 
      AxesLabel -> {"t", "f[t]"}]; \)\)

This function is periodic. 
Identify the period L of this function.

c) Look at this plot of 
       f[t] = 2 (Sign[Sin[3 π t]] + 0.5 Cos[2 π t]):

\(Clear[f, t]; 

    f[t_] = 2\ \((Sign[Sin[2\ π\ t]] + 0.5\ Cos[3\ π\ t])\); 

    \(Plot[f[t], {t, 0, 9}, PlotStyle -> {{Thickness[0.01], Blue}}, 
      AxesLabel -> {"t", "f[t]"}]; \)\)

This function is periodic. 
Identify the period L of this function.

d) Look at this plot of 
      f[t] = 7 Cos[t/2]  -  5 Sin[3 t]:

\(Clear[f, t]; 
f[t_] = 7\ Cos[t\/2] - 5\ Sin[3\ t]; 

    \(Plot[f[t], {t, 0, 35}, PlotStyle -> {{Thickness[0.01], Blue}}, 
      AxesLabel -> {"t", "f[t]"}]; \)\)

This function is periodic. 
Identify the period L of this function.

L.8)

That nitwit Calculus Cal starts to plot this periodic function:

\(Clear[f, t]; 
f[t_] = 3\ \((Ceiling[t\/4] - t\/4)\); 

    Plot[f[t], {t, 0, 6}, PlotStyle -> {{Thickness[0.02], Blue}}, 
      AxesLabel -> {"t", "f[t]"}, 
      AspectRatio -> 1\/GoldenRatio]; \)

Intent on getting a decent fast Fourier fit with as little thought as possible, Cal copies and pastes some code:

\(L\  = \ 2; 
n\  = \ 9; 
Clear[t, realfastfit]; 

    realfastfit[t_]\  = \ Chop[ComplexExpand[FastFourierfit[f, L, n, t]]]\)

Smiling in satisfaction, Cal plots f[t] and his fast Fourier fit:

\(\(Plot[{f[t], realfastfit[t]}, {t, 0, 6}, 
\ \ \ \ \ 
      PlotStyle -> {{Thickness[0.02], Blue}, {Thickness[0.01], Red}}, 

      \ \ \ \ \ AxesLabel -> {"t", ""}, 
\ \ \ \ \ 
      AspectRatio -> 1\/GoldenRatio]; \)\)

Cal is dumbfounded (as always).
Step in and tell Cal what he did wrong and then tell him how to fix it.

L.9)

Here is a function f[t] plotted on [0, 3]:

\(Clear[f, t]; 
f[t_]\  = \ E\^\(\(-3\)\ \((t - 1.5)\)\^2\); 

    fplot\  = 
      Plot[f[t], {t, 0, 6}, PlotStyle -> {{Thickness[0.025], Blue}}, 
        AspectRatio -> 1\/GoldenRatio, 
        AxesLabel -> {"t", "f[t]"}, PlotRange -> All]; \)

Here's a Fourier fit of f[t] on [0, 3]:

L = 3; n = 7; \(Clear[approxf]; 

    approxf[t_] = Chop[ComplexExpand[FastFourierfit[f, L, n, t]]]\)

Now see the plot of approxf[t] on [0, L] along with the plot of f[t] on [0, 6]:

\(approxfplot\  = \ \ 
      Plot[approxf[t], {t, 0, 3}, 
\ \ \ \ \ 
        PlotStyle -> {{Thickness[0.01], Red}}, DisplayFunction -> Identity]; 
    
	Show[fplot, approxfplot]; \)

Your job is to pencil in the plot of approxf[t] on [3, 6].

L.10)

a) Here is a function f[t]:

\(Clear[f, t]; 
f[t_] = 3\ Sin[2\ π\ t]\ \((Ceiling[t\/2] - t\/2)\); 
    
\(fplot = 
      Plot[f[t], {t, 0, 4}, 
		
        PlotStyle -> {{Thickness[0.02], Blue}}, 
        AspectRatio -> 1\/GoldenRatio, 
        AxesLabel -> {"t", "f[t]"}, PlotRange -> All]; 
    \)\)

This function is periodic with period L = 2. 
Pick 5 data points off the first period:

\(L = 2; 
n\  = \ 3; 

    fdata\  = \ 
      Table[N[{t, f[t]}], {t, 0, L\  - \ L/\((2\ n\  - \ 1)\), 
          L/\((2\ n\  - \ 1)\)}]; 

    fdataplot\  = \ 
      ListPlot[fdata, PlotStyle -> {HotPink, PointSize[0.05]}, 

        DisplayFunction -> Identity]; 


    both\  = \ 
      Show[fplot, fdataplot, 
\ \ \ \ \ \ 
        DisplayFunction -> $DisplayFunction]; \)

Stay with L = 2 and n = 3 and look at:

\(Clear[approxf]; 

    approxf[t_] = Chop[ComplexExpand[FastFourierfit[f, L, n, t]]]\)

Now see the plot of approxf[t] along with the other plots:

\(approxfplot\  = \ \ 
      Plot[approxf[t], {t, 0, 4}, 
\ \ \ \ \ 
        PlotStyle -> {{Thickness[0.01], Red}}, DisplayFunction -> Identity]; 
    
	Show[fplot, fdataplot, approxfplot]; \)

Use this plot to explain how the fast Fourier fit works.

b) Here's what happens when you raise n:

\(L = 2; 
n\  = \ 8; 

    fdata\  = \ 
      Table[N[{t, f[t]}], {t, 0, L\  - \ L/\((2\ n\  - \ 1)\), 
          L/\((2\ n\  - \ 1)\)}]; 

    fdataplot\  = \ 
      ListPlot[fdata, PlotStyle -> {HotPink, PointSize[0.04]}, 

        DisplayFunction -> Identity]; 


    both\  = \ 
      Show[fplot, fdataplot, 
\ \ \ \ \ \ 
        DisplayFunction -> $DisplayFunction]; \)

Here is the corresponding Fourier fit:

\(Clear[approxf]; 

    approxf[t_] = Chop[ComplexExpand[FastFourierfit[f, L, n, t]]]\)

Now see the plot of approxf[t] along with the other plots:

\(approxfplot\  = \ \ 
      Plot[approxf[t], {t, 0, 4}, 
\ \ \ \ \ 
        PlotStyle -> {{Thickness[0.01], Red}}, DisplayFunction -> Identity]; 
    
	Show[fplot, fdataplot, approxfplot]; \)

Use this plot as a basis to explain this:
If you use a lot of data points, then you can expect an excellent Fourier fit.

L.11)

You are given a periodic forcing function f[t] and an forced oscillator diffeq
             y''[t]+b y'[t]+c y[t]=f[t]
with y[0] = p and y'[0]=q given. But try as you might, you cannot get Mathematica to calculate either the Laplace transform of f[t] or the convolution integral involving f[t].

Instead, you get a good Fourier approximation of f[t] and use the Laplace transform (or convolution integral method) to get an exact formula for the solution of
               y''[t]+b y'[t]+c y[t]=good Fourier approximation of f[t]
 with y[0] = p and y'[0]=q.
 
 Comment on this statement:
Although the solution you got is not the exact solution to the original problem, it is the exact solution to a problem virtually indistinguishable from the original problem.

L.12)

What are the main ideas behind the technique of combining Fourier fit and the Laplace transform to come up with good approximate formulas for periodically forced oscillators?

L.13)

Here is a forcing function and a pretty good Fourier fit:

\(Clear[f, t]; 
f[t_] = 4\ Sign[Cos[1.6\ t]]; \)

You can get a period of f[t] by solving

Solve[1.6 t == 2 π, t]

And a Fourier Fit:

L = 3.92699; \(n = 20; 

    realfit[t_] = Chop[N[ComplexExpand[FastFourierfit[f, L, n, t]]]]\)

Plot[{f[t], realfit[t]}, {t, 0, 3  L}, 
      PlotStyle -> {{Thickness[0.015], Blue}, {Thickness[0.0075], Red}}, 
      AxesLabel -> {"t", ""}, AspectRatio ->  .33];

Go with this forcing function and use what you see to report on which of the following undamped oscillators you expect to be in danger of going into resonance or near resonance (beating):
          y''[t]+24.6 y'[t]=f[t],
          y''[t]+2.5 y[t]=f[t],
          y''[t]+64.0 y[t]=f[t],
          y''[t]+123 y[t]=f[t], 
 and
          y''[t]+5 y[t]=f[t].