4
$\begingroup$

I have the following symmetric curves

Plot[{Exp[-x] Sin[5 x], -Exp[-x] Sin[5 x]}, {x, 0, 2 π}, PlotRange -> All]

I want to join all the maxima and minima, foming envelope above and below the curves. How can this be done?

$\endgroup$
0

2 Answers 2

6
$\begingroup$

Edit: plotting an NDSolve result:

{g[x_], xm} = Reap[
  NDSolveValue[ {
    f''[x] == -2 (5 Cos[5 x] + 12  Sin[5 x] ) E^-x,
    f[0] == 0, f'[0] == 5,
    WhenEvent[f'[x] == 0 && f''[x] < 0, Sow[{x, f[x]}, 1]],
    WhenEvent[f'[x] == 0 && f''[x] > 0, Sow[{x, f[x]}, 2]]}, 
   f[x], {x, 0, 6}]]
Plot[g[x], {x, 0, 5}, Epilog -> {Line /@ xm}, PlotRange -> All]

enter image description here

//original version

exp = Exp[-x] Sin[5 x];
top = {#, Abs[exp /. x -> #]} & /@
   Sort@Flatten[x /. NSolve[D[exp, x] == 0 && 0 < x < 6 , x]];
Show[{
  Plot[Evaluate[exp {1, -1}], {x, 0, 2 \[Pi]}, PlotRange -> All],
  ListPlot[{top, {1, -1} # & /@ top}, Joined -> True, PlotRange -> All]
  }]

enter image description here

$\endgroup$
6
$\begingroup$

Update: For the case where

f1 and f2 are ... numerical solutions to a set of differential equations:

s = NDSolve[{x'[t] == -y[t] - x[t]^2, y'[t] == 2 x[t] - y[t]^3, x[0] == y[0] == 1}, 
  {x, y}, {t, 21}];

ClearAll[f1, f2]
f1[z_] := First[x /. s][z];
f2[z_] := First[y /. s][z];
colors = ColorData[97, "ColorList"][[;; 2]]; 
plt = Show[Plot[{f1[x], f2[x]}, {x, 0, 20.1}, Filling-> 1 -> {2},  PlotRange -> All],
 With[{f = #, col = First[colors = RotateRight[colors]]}, 
  Plot[#[x], {x, 0, 20.1},  PlotStyle -> col,  PlotRange -> All, 
   PlotRangeClipping -> False, MeshFunctions -> {f'[#] &}, Mesh -> {{0}}]]&/@ {f1, f2}];
Show[plt, ListLinePlot[SortBy[First] /@ 
  GatherBy[Cases[Normal @ plt, Point[x_] :> x, ∞], NonPositive[Last@#]&], 
 Filling -> Axis, FillingStyle -> Opacity[.3, Yellow], PlotRange -> All, 
 Mesh -> Full], PlotRange->{{0,20},All}, ImageSize -> 600]

enter image description here

Original answer:

f1[x_]:=Exp[-x] Sin[5 x];
f2[x_]:=-Exp[-x] Sin[5 x];
plt = Plot[{f1[x],f2[x]}, {x, 0, 2 π}, PlotRange -> All, Filling -> 1 -> {2}, 
   MeshFunctions -> {f1'[#]&,f2'[#]&}, Mesh->{{0},{0}}];

Show[plt, ListLinePlot[GatherBy[SortBy[Cases[Normal @ plt, Point[x_] :> x, ∞], Last], 
     Positive[Last @ #]&], 
   Filling -> Axis, FillingStyle -> Opacity[.5, Yellow], 
   PlotRange -> Full], PlotRange -> All, ImageSize->600]

enter image description here

$\endgroup$
4
  • $\begingroup$ thank you. My functions f1 and f2 are actually not so simple. They are numerical solutions to a set of differential equations. I can not post the problem here. Could it be possible for you to contact me at [email protected] ? $\endgroup$
    – H. Kenan
    Commented Feb 1, 2018 at 21:19
  • $\begingroup$ @user149973, i will post a version in a moment that doesn't rely on symmetry of the two functions. $\endgroup$
    – kglr
    Commented Feb 1, 2018 at 21:34
  • $\begingroup$ I mean, I do not have the functional form of f1 and f2. They are like f1=Evaluate[{....}/.sol]. where sol is the solution for a set of 14 differential equations. $\endgroup$
    – H. Kenan
    Commented Feb 1, 2018 at 21:41
  • $\begingroup$ @user149973 if you are using NDSolve you may want to use WhenEvent to find the extrema for you. $\endgroup$
    – george2079
    Commented Feb 1, 2018 at 21:41

Not the answer you're looking for? Browse other questions tagged or ask your own question.