0
$\begingroup$

I am trying to solve for \[Epsilon], given three input paramters n, x and eps. Only FindInstance provides a solution for me whereas NSolve and NSolveValues fail.

Why does this happen?

$PreRead = (# /. 
     s_String /; 
       StringMatchQ[s, NumberString] && 
        Precision@ToExpression@s == MachinePrecision :> s <> "`50." &);

kldFunc[x_, y_] := x Log[x/y] + (1 - x) Log[(1 - x)/(1 - y)];

n = 10.^13.; x = 6. 10.^9.; eps = 10.^-20.; 

Clear[\[Epsilon], \[Mu], p]; 
\[Mu] = x + n \[Epsilon];
p = \[Mu]/n; 
\[Epsilon] = \[Epsilon] /. 
    Flatten[FindInstance[
      Exp[-kldFunc[p - \[Epsilon], p] n] == eps && 
       1. > \[Epsilon] > 0., \[Epsilon], Reals] ]

Clear[\[Epsilon], \[Mu], p]; 
\[Mu] = x + n \[Epsilon];
p = \[Mu]/n; 
\[Epsilon] = 
   NSolveValues[
    Exp[-kldFunc[p - \[Epsilon], p] n] == eps && 
     1. > \[Epsilon] > 0., \[Epsilon], Reals] 

Clear[\[Epsilon], \[Mu], p]; 
\[Mu] = x + n \[Epsilon];
p = \[Mu]/n; 
\[Epsilon] = 
   NSolve[Exp[-kldFunc[p - \[Epsilon], p] n] == eps && 
     1. > \[Epsilon] > 0., \[Epsilon], Reals] 

EDIT

I tried plotting the two function to find the intersection

$PreRead = (# /. 
     s_String /; 
       StringMatchQ[s, NumberString] && 
        Precision@ToExpression@s == MachinePrecision :> 
      s <> "`100." &);
kldFunc[x_, y_] := x Log[x/y] + (1 - x) Log[(1 - x)/(1 - y)];
n = 10.^13.; x = 6.  10.^9.; eps = 10.^-20.; 



Clear[\[Epsilon], \[Mu], p]; 
\[Mu] = x + n \[Epsilon];
p = \[Mu]/n; 
Plot[{10^-20, Exp[-kldFunc[p - \[Epsilon], p] n]}, {\[Epsilon], 
  7 10^-8, 8  10^-8}, WorkingPrecision -> 50]


enter image description here

I tried to extract the intersection point using


plot1 = Plot[
   Exp[-kldFunc[p - \[Epsilon], p] n], {\[Epsilon], 7 10^-8, 
    8  10^-8}, WorkingPrecision -> 50];
plot2 = Plot[10^-20, {\[Epsilon], 7 10^-8, 8  10^-8}, 
   WorkingPrecision -> 50];


intersections = Graphics`Mesh`FindIntersections[{plot2, plot1}]

but it does'nt give an output.(I'm running on 13.3. See related)

$\endgroup$
7
  • $\begingroup$ Per documentation for NSolve, Details and Options bullet item: "NSolve deals primarily with linear and polynomial equations.` It has only limited capabilities for handling transcendental equations. $\endgroup$ Sep 26, 2023 at 14:51
  • $\begingroup$ So what can I use to solve such equations?. FindInstance works most of the time but sometimes it runs for a couple of minutes without being able to find a solution. $\endgroup$
    – Dotman
    Sep 26, 2023 at 15:01
  • $\begingroup$ Here is is your equation E^(1.0...00*10^13 (-((1 +\[Epsilon] - 1.0...00*10^-13 (6.00...0*10^9 + 1.000...000*10^13\[Epsilon])) Log[( 1 + \[Epsilon] - 1.0000..0000*10^-13 (6.0000...00*10^9 + 1.0000...000*10^13 \[Epsilon]))/( 1 - 1.0000..000*10^-13 (6.00...0*10^9 + 1.000...0000*10^13 \[Epsilon]))]) - (-\[Epsilon] + 1.0000..0000*10^-13 (6.0000...0000*10^9 + 1.00...000*10^13 \[Epsilon])) Log[( 1.000...000*10^13 (-\[Epsilon] + 1.0000...0000*10^-13 (6.00...000*10^9 + 1.00...00000*10^13 \[Epsilon])))/( 6.00000...0000*10^9 + 1.000..000000*10^13 \[Epsilon])])) == 1.0..0000000*10^-20. $\endgroup$
    – user64494
    Sep 26, 2023 at 16:15
  • $\begingroup$ Isn't it art for art's sake? $\endgroup$
    – user64494
    Sep 26, 2023 at 16:16
  • $\begingroup$ FindRoot would be my go-to for this. kldFunc[x_, y_] := x Log[x/y] + (1 - x) Log[(1 - x)/(1 - y)]; n = 10^13; x = 6 *10^9; eps = 10^-20; \[Mu] = x + n \[Epsilon]; p = \[Mu]/n; In[59]:= FindRoot[ N[Exp[-kldFunc[p - \[Epsilon], p] n] - eps, 50] == 0, {\[Epsilon], 0, 1}, WorkingPrecision -> 30] Out[59]= {\[Epsilon] -> 7.43192053584110156413007451123*10^-8} $\endgroup$ Sep 26, 2023 at 20:09

2 Answers 2

4
$\begingroup$

Use FindRoot

Clear["Global`*"]

kldFunc[x_, y_] := x Log[x/y] + (1 - x) Log[(1 - x)/(1 - y)];

n = 10^13; x = 6*10^9; eps = 10^-20;
μ = x + n ϵ;
p = μ/n;

expr = N[Exp[-kldFunc[p - ϵ, p] n] - eps, 100] // Simplify;

With FindRoot you need to provide a starting value and only a single result is returned irrespective of the number of roots.

(sol1 = FindRoot[expr == 0, {ϵ, 10^-8}, WorkingPrecision -> 80]) // N

(* {ϵ -> 7.43192*10^-8} *)

expr /. sol1

(* 0.*10^-94 *)

(sol2 = FindRoot[expr == 0, {ϵ, 10^-7}, WorkingPrecision -> 80]) // N

(* {ϵ -> 7.43192*10^-8} *)

expr /. sol2

(* 0.*10^-94 *)

With two starting values, FindRoot avoids the use of derivatives

(sol3 = FindRoot[expr == 0, {ϵ, 10^-9, 10^-6}, 
    WorkingPrecision -> 80]) // N

(* {ϵ -> 7.43192*10^-8} *)

expr /. sol3

(* 0.*10^-94 *)

EDIT: For your revised values given in the comment

n = 10^15; x = 6*10^9; eps = 10^-20;
μ = x - n ϵ;
p = μ/n;

Increase the precision for expr

expr = N[Exp[-kldFunc[p - ϵ, p] n] - eps, 105] // Simplify;

The starting value must be close to the actual value

(sol4 = FindRoot[expr == 0, {ϵ, 7*10^-10}, WorkingPrecision -> 80]) //
  N

(* {ϵ -> 7.43321*10^-10} *)

expr /. sol4

(* 0.*10^-92 *)
$\endgroup$
1
  • $\begingroup$ This is nice and works a lot faster than my code.Thanks. However, as I modified my input values to n = 10^15; x = 6*10^9; eps = 10^-20; \[Mu] = x - n \[Epsilon]; p = \[Mu]/n;, the code failed to converge to a solution $\endgroup$
    – Dotman
    Sep 26, 2023 at 16:26
3
$\begingroup$

NSolve work if we use infinite precision number n,x,eps.

Clear["Global`*"];
kldFunc[x_, y_] := x Log[x/y] + (1 - x) Log[(1 - x)/(1 - y)];
n = 10^13; x = 6*10^9; eps = 10^-20;
μ = x + n ϵ;
p = μ/n;
NSolve[{Exp[-kldFunc[p - ϵ, p] n] == eps, 
  0 < ϵ < 10^-1}, ϵ]

{{ϵ -> 7.43192*10^-8}}

  • test another values.
NSolve[{Exp[-kldFunc[p - ϵ, p] n] == 10^-3, 
  0 < ϵ < 10^-1}, ϵ]

{{ϵ -> 2.8783*10^-8}}

$\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.