1
$\begingroup$

I am trying to find the local maximum and minimum of a function. The code below works if function is an exponential but when function involves a sinusoid, it does not give numerical values and instead outputs complex conditional expressions. I am unsure what is missing? Do I need to add the domain?

tt = 3;
(*f[t_]:=3\[ExponentialE]^(-2t)-4\[ExponentialE]^(-3t)+\[ExponentialE]\
^(-5t);*)
f[t_] := 3 E^(-2 t) Sin[3 t]
NSolve[D[f[t], t] == 0, t, PositiveReals]
Plot[f[t], {t, 0, tt}]

Thank you so much. When the function is a simple exponential, then the code suggested dosent seem to pick up the maximum value to t=0. Can you please help. Also, the plotting dosent seem to work as well.

Clear["Global`*"]
tt = 3;
f[t_] := 2 E^(-1000 t) 
cpts = SortBy[N][
   Solve[{D[f[t], t] == 0, 0 <= t <= tt}, t] // Simplify];
cpts // N;
#[{f[t], 0 <= t <= tt}, t] & /@ {Minimize, Maximize} // FullSimplify;
% // N
Plot[f[t], {t, 0, tt}, 
 Epilog -> {Red, AbsolutePointSize[4], Point[{t, f[t]} /. cpts]}]
$\endgroup$
1
  • $\begingroup$ : dosent seem to pick up the maximum value to t=0": Is it this?: You need to check end points, not just stationary points (crit. pts.)? They made a big deal of it in my AP calc class. They seemed to think everyone always forgets that. $\endgroup$
    – Michael E2
    Commented Jun 10 at 18:55

2 Answers 2

0
$\begingroup$
$Version

(* "14.0.0 for Mac OS X ARM (64-bit) (December 13, 2023)" *)

Clear["Global`*"]

tt = 3;

f[t_] := 3  E^(-2  t)  Sin[3  t]
cpts = SortBy[N][Solve[{D[f[t], t] == 0, 0 <= t <= tt}, t] // Simplify]

(* {{t -> 2/3 ArcTan[1/3 (-2 + Sqrt[13])]}, 
    {t -> 2/3 (π + ArcTan[1/3 (-2 - Sqrt[13])])}, 
    {t -> 2/3 (π + ArcTan[1/3 (-2 + Sqrt[13])])}} *)

cpts // N

(* {{t -> 0.327598}, {t -> 1.3748}, {t -> 2.42199}} *)

EDIT: Alternatively,

#[{f[t], 0 <= t <= tt}, t] & /@ {Minimize, Maximize} // FullSimplify

(* {{-((9 E^(-(4/3) (π - ArcTan[1/3 (2 + Sqrt[13])])))/Sqrt[
   13]), {t -> 2/3 (π - ArcTan[1/3 (2 + Sqrt[13])])}}, {(
  9 E^(-(4/3) ArcTan[1/3 (-2 + Sqrt[13])]))/Sqrt[
  13], {t -> 2/3 ArcTan[1/3 (-2 + Sqrt[13])]}}} *)

% // N

(* {{-0.159639, {t -> 1.3748}}, {1.29635, {t -> 0.327598}}} *)

Plot[f[t], {t, 0, tt},
 Epilog -> {Red, AbsolutePointSize[4], Point[{t, f[t]} /. cpts]}]

enter image description here

f2[t_] := 3 E^(-2 t) - 4 E^(-3 t) + E^(-5 t);

(cpts2 = Solve[D[f2[t], t] == 0, t, Reals]) // InputForm

(* {{t -> Log[Root[5 - 12*#1^2 + 6*#1^3 & , 2, 0]]}, 
    {t -> Log[Root[5 - 12*#1^2 + 6*#1^3 & , 3, 0]]}} *)

cpts2 // ToRadicals // Simplify

(* {{t -> Log[
    1/12 (8 + (8 I 2^(2/3) (I + Sqrt[3]))/(-13 + 3 I Sqrt[95])^(1/3) + 
       (-1 - I Sqrt[3]) (-26 + 6 I Sqrt[95])^(1/3))]}, 
    {t -> Log[1/6 (4 + (8 2^(2/3))/(-13 + 3 I Sqrt[95])^(1/3) + 
       (-26 + 6 I Sqrt[95])^(1/3))]}} *)

cpts2 // N

(* {{t -> -0.160173}, {t -> 0.540866}} *)

EDIT: Alternatively,

#[{f2[t], -3/10 <= t <= tt}, t] & /@ {Minimize, Maximize} // Simplify

(* {{1/125  (780 - 237  Root[180 - 12 #^2 + #^3& , 2, 0] + 
     16  Root[180 - 12 #^2 + #^3& , 2, 0]^2), {t -> Log[
Root[5 - 12 #^2 + 6 #^3& , 2, 0]]}}, {1/
   125  (780 - 237  Root[180 - 12 #^2 + #^3& , 3, 0] + 
     16  Root[180 - 12 #^2 + #^3& , 3, 0]^2), {t -> Log[
Root[5 - 12 #^2 + 6 #^3& , 3, 0]]}}} *)

% // N

(* {{-0.107374, {t -> -0.160173}}, {0.294398, {t -> 0.540866}}} *)

Plot[f2[t], {t, -1, tt},
 Epilog -> {Red, AbsolutePointSize[4], Point[{t, f2[t]} /. cpts2]}]

enter image description here

EDIT 2:

f[t_] := 2  E^(-1000  t)

The derivative is not zero for any finite value of t

cpts = Solve[D[f[t], t] == 0, t]

(* {} *)

The min and max occur at the boundaries of the interval

cpts = #[{f[t], 0 <= t <= tt}, t] & /@ {Minimize, Maximize} // FullSimplify

(* {{2/E^3000, {t -> 3}}, {2, {t -> 0}}} *)

 Plot[f[t], {t, 0, tt},
 PlotRange -> All,
 Epilog -> {Red, AbsolutePointSize[4],
   Point[{t, f[t]} /. cpts[[All, 2]]]},
 ImageSize -> 300]

enter image description here

$\endgroup$
3
  • $\begingroup$ Thank you so much. When the function is a simple exponential, then the code dosent seem to pick up the maximum value to t=0. Can you please help. Also, the plotting dosent seem to work as well. Clear["Global`*"] tt = 3; f[t_] := 2 E^(-1000 t) cpts = SortBy[N][ Solve[{D[f[t], t] == 0, 0 <= t <= tt}, t] // Simplify]; cpts // N; #[{f[t], 0 <= t <= tt}, t] & /@ {Minimize, Maximize} // FullSimplify; % // N Plot[f[t], {t, 0, tt}, Epilog -> {Red, AbsolutePointSize[4], Point[{t, f[t]} /. cpts]}] $\endgroup$
    – kahless96
    Commented Jun 10 at 6:43
  • $\begingroup$ You should not assume that code given in response to a question can be blindly applied to a different question. Plotting 2 E^(-1000 t) over some intervals clearly shows that the behavior of function is radically different from the other examples. $\endgroup$
    – Bob Hanlon
    Commented Jun 10 at 16:11
  • $\begingroup$ Thank you for the comprehensive responses. The problem is solved now. $\endgroup$
    – kahless96
    Commented Jun 11 at 7:10
0
$\begingroup$

Example for domain $(0,2\pi)$ coloring maximum green and minimum red:

f[t_] := 3  E^(-2  t)  Sin[3  t]
sol = Solve[{D[f[t], t] == 0, 0 <= t <= 2 Pi}, t];
mm = Sign[D[f[t], {t, 2}]] /. sol;
p = {t, f[t]} /. sol;
pts = Thread[{p, 
     mm}] /. {{a_, 1} :> {Red, Point[a]}, {b_, -1} :> {Green, 
      Point[b]}};
Plot[f[t], {t, 0, 2 Pi}, Epilog -> pts, PlotRange -> All]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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