3
$\begingroup$

What is the fastest way to find the smallest positive root of the following transcendental equation:

$$a + b\cdot e^{-0.045 t} = n \sin(t) - m \cos(t)$$

eq = a + b E^(-0.045 t) == n Sin[t] - m Cos[t];

where $a,b,n,m$ are some real constants.

for instance I tried :

eq = 5  E^(-0.045 t) + 0.1 == -0.3 Cos[t] + 0.009 Sin[t];

sol = FindRoot[eq, {t, 1}]

{t -> 117.349}

There is an answer but it doesn't mean that this is the smallest positive root ))

I don't like FindRoot[] because you need starting point, for different initial parameters $(a,b,n,m)$

Is there a way to find the smallest positive root of equation for any $(a,b,n,m)$ (if there exist the solution), without starting points?

If No. how to determine automatically starting point for a given parameters?

there is a numerical and graphical answers in Wolfram Alpha

enter image description here

$\endgroup$
  • 3
    $\begingroup$ I'm not sure the values you have chosen are sensible. The left hand side is of size about 11 and the right hand size oscillates between +/-1.2. How can they be equal? If you change $a$ to 1, you get an answer. $\endgroup$ – bill s Nov 13 '18 at 14:53
5
$\begingroup$

Amplifying on comment by @bills; for your specific example there are no roots

eq = 11 + 5 E^(-0.045 t) == 0.03 Sin[t] - 1.2 Cos[t] // Rationalize;

The FunctionRange of the LHS and RHS of the equation do not intersect

FunctionRange[#, t, y] & /@ List @@ eq // N

(* {y > 11., -1.20037 <= y <= 1.20037} *)

Or look at the Plot

Plot[Evaluate[List @@ eq], {t, 0, 100},
 Frame -> True,
 PlotLegends -> Placed["Expressions", {0.5, 0.45}]]

enter image description here

For values of the parameters for which the plots intersect, the Plot will provide an initial value for FindRoot or constraint for use with NSolve.

eq = 1 + 5 E^(-0.045 t) == 0.03 Sin[t] - 1.2 Cos[t] // Rationalize;

Plot[Evaluate[List @@ eq], {t, 60, 100},
 Frame -> True,
 PlotLegends -> "Expressions"]

enter image description here

FindRoot[eq, {t, 72}]

(* {t -> 72.1339} *)

NSolve[{eq, 60 < t < 80}, t][[1]]

(* {t -> 72.1339} *)

Note that for NSolve the constraint can be loose; whereas, for FindRoot the initial estimate must be closer to the actual value.

$\endgroup$
  • 1
    $\begingroup$ ok, good. but this is not a "fast way" because you need starting point in FindRoot[] (72). why 72 and not 73 ?? how do you know the numerical value of starting point? $\endgroup$ – vito Dec 29 '18 at 9:18
  • $\begingroup$ @vito - As stated above, you use the Plot to get an initial estimate for FindRoot. A value on the leading edge of the yellow curve will work, e.g., anything between 69.9 to 72.1. Zoom in on the Plotto get a better view. Plot[Evaluate[List@@eq], {t, 69, 73}, Frame -> True, PlotLegends -> "Expressions"] A tight initial estimate is unnecessary if you use NSolve. The range for NSolve can be very broad, e.g., NSolve[{eq, 0 < t < 1000}, t][[1]] will give the smallest positive root since Part is used to take the smallest value. $\endgroup$ – Bob Hanlon Dec 29 '18 at 13:25
1
$\begingroup$
eq = 1 + 5 E^(-0.045 t) - (0.03 Sin[t] - 1.2 Cos[t]);

To find the first root, plot the equation and marker the roots.

Plot[eq, {t, 50, 150}, Mesh -> {{0}}, MeshFunctions -> {#2 &}, MeshStyle -> Directive[Red, PointSize@Medium]]

enter image description here

The first root lies between 70 < t < 75

NSolve[eq == 0 && 70 < t < 75, t]
{{t -> 72.1339}, {t -> 72.3439}}
$\endgroup$
1
$\begingroup$

You can solve by hand for to isolate the root. The following identity is helpful:

n Sin[t] - m Cos[t] == Sqrt[m^2 + n^2] Cos[t - ArcTan[-m, n]]

Then you can figure out that the earliest to start your search is here:

Solve[a + b E^(-45/1000 t) == Sqrt[m^2 + n^2], t, Reals]

Then you just have to deal with the different cases (intersects one to three times in the first period where there are intersections):

Block[{b = 5, a = 0.1, m = 0.3, n = 0.009},
 (* Assumes b > 0 and a < Sqrt[m^2+n^2] *)
 Module[{tmax, t0, t1, tcrit, t2, y0, y2},
  tmax = Mod[ArcTan[-m, n], 2 Pi];
  t0 = 200/9 Log[b/(-a + Sqrt[m^2 + n^2])];
  t1 = Floor[t0 - tmax, 2 Pi] + tmax;
  tcrit = 
   Mod[ArcSin[Min[(9 b E^(-9 t1/200))/(200 Sqrt[m^2 + n^2]), 1]] + 0 ArcTan[-m, n], 2 Pi];
  t2 = t1 + tcrit;
  With[{y = Subtract @@ eq},
   y0 = y /. t -> t0;
   y2 = y /. t -> t2
   ];
  Which[
   y0 == 0, {t -> t0},
   y2 == 0, {t -> t2},
   y0*y2 < 0, FindRoot[eq, {t, (t0 + t2)/2, t0, t2}],
   True, FindRoot[eq, {t, (t1 + 3 Pi/2), t1 + Pi, t1 + 2 Pi}]
   ]
  ]]

(*  {t -> 72.0486}  *)

For {b = 5, a = 0.0775, m = -0.3, n = 0.009}, we get

{t -> 69.1481}

For {b = 1, a = 0, m = -1, n = 0}, we get

{t -> 0}

The other measure-zero case is harder to achieve.

Hopefully I didn't make any fence-post type errors. :)

$\endgroup$
1
$\begingroup$

Here's a method that requires no plotting or guessing of initial points. It uses FindInstance to find successively smaller solutions until no smaller solution can be found.

try[tt_] := With[{r = FindInstance[eq && t < tt, t, Reals]},
   If[r == {}, tt, t /. r[[1]]]]
FixedPoint[try, Infinity]
(* 72.0486 *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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