Alternatives to NSolve when equation is complicated

Questions
, ,
1

Hello,
I am trying to find the solution to an equation that is relatively complicated. When I tabulate values of the function, I see that it is well behaved and there is a clear solution. However, when I use NSolve, it takes forever, and if I use FindRoot it simply returns back my equation. I am wondering if there is an alternative:

I am trying to do

NSolve[f[sj]==0,sj]

where f[sj] is:

-1. - (1000. E^( 1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj)))/
( 2.71828 + E^( 1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj))) 
+ (1000. E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/ sj)) 
(1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)]))/
(2.71828 + E^( 1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj)))
2

Fresh start of Win 7 MMA 10 notebook.

In[1]:= f[sj_] := -1. - (1000. E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj)))/(2.71828 + 
     E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj)))+(1000. E^(1. (2. - (1. + 1. sj + 
     1. sj ProductLog[E^(-1. - 1./sj)])/sj)) (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)]))/(2.71828 + 
     E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj)));
  FindRoot[f[sj], {sj, .2}]

During evaluation of In[1]:= FindRoot::lstol: The line search decreased the step size to within tolerance
specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the merit
function. You may need more than MachinePrecision digits of working precision to meet these tolerances. >>

Out[2]= {sj -> 0.0172505}

In[3]:= Plot[f[sj], {sj, 0, .3}]

7863g1.jpg
7863g1.jpg360×212 5.69 KB

Hummm… Evaluation->quit kernel->local->quit

Now, instead of defining that function, paste that identical expression inside FindRoot and Plot

In[1]:= FindRoot[-1. - (1000. E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj)))/(2.71828 + 
     E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj))) + (1000. E^(1. (2. - (1. + 1. sj + 
     1. sj ProductLog[E^(-1. - 1./sj)])/sj)) (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)]))/(2.71828 + 
     E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj))), {sj, .2}]

Out[1]= {sj -> 0.190651}

In[2]:= Plot[-1. - (1000. E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj)))/(2.71828 + 
      E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj))) + (1000. E^(1. (2. - (1. + 1. sj + 
      1. sj ProductLog[E^(-1. - 1./sj)])/sj)) (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)]))/(2.71828 + 
      E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/sj))), {sj, 0, .3}]

9136g1.jpg
9136g1.jpg360×220 5.27 KB

That seems unexpected to me.

This seems to make the problem go away

In[1]:= f[sj_] := FullSimplify[Rationalize[...]];
   FindRoot[f[sj], {sj, .2}]

Out[2]= {sj -> 0.190651}
3

I didn’t get any errors with the same code. With exact coefficients and Solve we get an analytical solution with arbitrary precision:

f1[sj_] = 
 Simplify@Rationalize[-1. - (1000. E^(1. (2. - (1. + 1. sj + 
               1. sj ProductLog[E^(-1. - 1./sj)])/sj)))/(E + 
       E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/
             sj))) + (1000. E^(1. (2. - (1. + 1. sj + 
               1. sj ProductLog[E^(-1. - 1./sj)])/sj)) (1. + 1. sj + 
         1. sj ProductLog[E^(-1. - 1./sj)]))/(E + 
       E^(1. (2. - (1. + 1. sj + 1. sj ProductLog[E^(-1. - 1./sj)])/
             sj)))]
Solve[f1[sj] == 0 && 0 < sj < 1, sj]