1
$\begingroup$

I am trying to obtain numerically the roots of a function, but Mathematica is not able to obtain them. I used NSolve, FindRoot and even the custom Jens' findAllRoots function, but none of them work. Any solution? The code that I used is the following:

ClearAll[ff, f, FF, F, kb, T, TL, TR, m, mr, ml, V]

ff[e_, m_?NumberQ, t_?NumberQ] := 1/(1 + Exp[(e - m)/t])(*temperature is expressed in units of T/Subscript[k, B]*)

tt[e_, e0_?NumberQ, w_?NumberQ] := 1/(1 + Exp[-(e - e0)/w])(*transmission probability*)

e0 = 0;
w = .3;
ml = .4;
mr = -.4;
tl = 1;
tr = 1;

kk[e_] = D[tt[e, e0, w]*(ff[e, ml, tl] - ff[e, ml, tl]^2 + 
                         ff[e, mr, tr] - ff[e, mr, tr]^2), e];

NSolve[kk[e]==0,e]
FindRoot[kk[e],{e,0}]
findAllRoots[kk[e], {e, -2, 5}, "ShowPlot" -> False]

The outputs show convergence problems. Thanks for your help.

$\endgroup$
7
  • 2
    $\begingroup$ FindRoot[kk[e], {e, 1}] (* {e -> 0.694818} *) Plotting ff[e] helps to find a starting value. $\endgroup$ – LouisB Jan 21 at 21:30
  • 2
    $\begingroup$ NSolve[kk[e] == 0, e, Reals] (* {e -> 0.694818} *) also works. $\endgroup$ – LouisB Jan 21 at 21:37
  • 2
    $\begingroup$ Restricting the arguments of ff and tt to being numbers is unnecessary since these functions do not use numeric techniques. However, if it were necessary to restrict their arguments, NumericQ should be used rather than NumberQ. NumberQ returns False for symbolic numbers such as Pi or E. $\endgroup$ – Bob Hanlon Jan 21 at 22:02
  • 1
    $\begingroup$ NSolve[kk[e] == 0 && -2 < e < 5, e], using the limits in your findAllRoots, also works. $\endgroup$ – Michael E2 Jan 21 at 23:47
  • 1
    $\begingroup$ @V.Arjona - "NSolve deals primarily with linear and polynomial equations." Your problem is neither and Mathematica generally assumes that all variables can be complex. In this case it needs to be told that the variable is real, either explicitly by specifying the domain or implicitly by using the variable in an inequality. The performance of FindRoot is always highly dependent on the starting value. $\endgroup$ – Bob Hanlon Jan 22 at 16:10
4
$\begingroup$

Use the transformation $$e \to \log s$$ we can relatively easy to plot the figure. And I guess that only one root around $s=2$. ( The MeshFunctions -> (#2 &) and Mesh->{{0}} can also locate the root, but I don't how to extract the root from the FullForm of the plot)

ff[e_, m_, t_] := 
 1/(1 + Exp[(e - m)/
      t])(*temperature is expressed in units of T/Subscript[k,B]*)

tt[e_, e0_, w_] := 1/(1 + Exp[-(e - e0)/w])(*transmission probability*)

e0 = 0;
w = .3;
ml = .4;
mr = -.4;
tl = 1;
tr = 1;
kk[e_] = D[
   tt[e, e0, 
     w]*(ff[e, ml, tl] - ff[e, ml, tl]^2 + ff[e, mr, tr] - 
      ff[e, mr, tr]^2), e];
g[s_] := (kk[e] /. e -> Log[s]);
Plot[g[s], {s, 0, 4}, MeshFunctions -> (#2 &), 
 MeshStyle -> {PointSize[Large], Red}, Mesh -> {{0}}, 
 AxesLabel -> {s, kk}, Method -> {"AxesInFront" -> False}]
FindRoot[g[s], {s, 2}]
Log[s] /. %

{s -> 2.00334}

0.694818

enter image description here

Edit

We can also do this directly by NMinimize or NMaximize to find a root.

Plot[kk[e], {e, -10, 10}, MeshFunctions -> (#2 &), 
 MeshStyle -> {PointSize[Large], Red}, Mesh -> {{0}}, 
 AxesLabel -> {e, kk}, Method -> {"AxesInFront" -> False}]
NMinimize[{kk[e]^2, e > 0}, e]
NMinimize[{0, kk[e] == 0, e > 0}, e]

{1.49378*10^-17, {e -> 0.694818}}

{0., {e -> 0.694818}}

$\endgroup$
2
  • $\begingroup$ Thanks for your answer, this solution solves the problem. But why did I have those problems using the standard methods of mathematica? Why does it necessary to use this trick? $\endgroup$ – V. Arjona Jan 22 at 9:39
  • 1
    $\begingroup$ @V.Arjona Another way to find a root is using NMinimize, see the updated. $\endgroup$ – cvgmt Jan 22 at 9:47

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