# Solve an implicit function numerically and plot the solution against a parameter

Consider an implicit function, $$F(e,w,a,b,i,n)=0$$, whose code is:

D[w - 1/((1 - e) w), e] ==  D[1 - e, e] ((-((-a (i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) + (-1 + a^2) (-1 + e)^2 w - a (-1 + e) (i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) w^2)/(a (-1 + e) i (1 - e + i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) w))) - (-((-a (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1))) + (-1 + a^2) (-1 +   e) (-1 + e - i) w -  a (-1 + e) (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(
1 - n e (1/(b (a e)^(b)))^(1/(b - 1))) w^2)/( a (-1 + e) i (1 - e + i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) w))))


From the above implicit function, $$e$$ is implicitly defined as a function of $$w$$, and I would like to find the values of $$e$$ and $$w$$ as the solution of $$\frac{\partial e}{\partial w}=\frac{e}{w}$$. And my ultimate goal is to plot each of these values of $$e$$ and $$w$$ against $$a$$.

First, I found the $$e$$ function, $$e=e(w)$$ numerically for various values of $$a$$: $$a = 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1$$ along with the other simulation values of $$n=1$$, $$b=0.7$$, $$i=0.1$$. My code for this is:

Clear["Global*"]
n = 1;
eqns[i_, b_] = {D[w - 1/((1 - e) w), e] ==
D[1 - e, e] ((-((-a (i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(
1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) + (-1 +
a^2) (-1 + e)^2 w -
a (-1 + e) (i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(
1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) w^2)/(
a (-1 + e) i (1 - e + i + (
n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(
1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) w))) - (-((-a (
n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(
1 - n e (1/(b (a e)^(b)))^(1/(b - 1))) + (-1 + a^2) (-1 +
e) (-1 + e - i) w -
a (-1 + e) (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(
1 - n e (1/(b (a e)^(b)))^(1/(b - 1))) w^2)/(
a (-1 + e) i (1 - e + i + (
n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(
1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) w)))), 0 <= i <= 1, 0 <= a <= 1, 0 <= e <= 1, w >= 0, 0 <= b <= 1};
ContourPlot[Evaluate@ Table[Simplify@    eqns[1/10, 7/10][], {a, {0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1}}], {w, 0, 5}, {e, 0, 1}, PlotPoints -> 50, MaxRecursion -> 4, FrameLabel -> (Style[#, 14] & /@ {w, e}), RotateLabel -> False, PlotLegends -> Placed[LineLegend[{0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1},
LegendLabel -> "a"], {.7, .4}]]


And the result is: Now, I would like to use this $$e=e(w)$$ function numerically found as above to solve $$\frac{\partial e}{\partial w}=\frac{e}{w}$$ and use the solutions for $$e$$ and $$w$$, which would be a function of $$a$$, to plot each of them against $$a$$. The plots I'm looking for would be something like these. Please help.  $Version (* "13.2.1 for Mac OS X ARM (64-bit) (January 27, 2023)" *) Clear["Global*"] n = 1; eqns[i_, b_] = {D[w - 1/((1 - e) w), e] == D[1 - e, e] ((-((-a (i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) + (-1 + a^2) (-1 + e)^2 w - a (-1 + e) (i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) w^2)/(a (-1 + e) i (1 - e + i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) w))) - (-((-a (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1))) + (-1 + a^2) (-1 + e) (-1 + e - i) w - a (-1 + e) (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1))) w^2)/(a (-1 + e) i (1 - e + i + (n (1 - e) (1/(b (a e)^(b)))^(1/(b - 1)))/(1 - n e (1/(b (a e)^(b)))^(1/(b - 1)))) w)))), 0 <= i <= 1, 0 <= a <= 1, 0 <= e <= 1, w >= 0, 0 <= b <= 1};  ImplicitD was introduced in version 13.1 eqn[a_, e_, w_] = FullSimplify[ImplicitD[eqns[1/10, 7/10][], e, w] == e/w]; ContourPlot[ Evaluate@Simplify[ Table[eqn[a, e, w], {w, 1, 5}]], {a, 0, 1}, {e, 0, 1}, FrameLabel -> (Style[#, 14] & /@ {HoldForm[a], HoldForm[e]}), RotateLabel -> False, PlotPoints -> 35, MaxRecursion -> 4, PlotLegends -> Placed[ LineLegend[Range[1, 5], LegendLabel -> Style[HoldForm[w], 14]], {.2, .25}], WorkingPrecision -> 15] ContourPlot[ Evaluate@Simplify[ Table[eqn[a, e, w], {e, 2/5, 4/5, 1/10}]], {a, 0, 1}, {w, 0, 5}, FrameLabel -> (Style[#, 14] & /@ {HoldForm[a], HoldForm[w]}), RotateLabel -> False, PlotPoints -> 35, MaxRecursion -> 4, PlotLegends -> LineLegend[Range[0.4, 0.8, 0.1], LegendLabel -> Style[HoldForm[e], 14]], WorkingPrecision -> 15] • Thanks, Bob, for your help. But it seems my question was misunderstood. Here is a short version of what I'm looking for: Given$e=e(w)$numerically derived as in the first figure, I would like to find$e$and$w$that solve$e_w = e/w$for varying values of$a \in [0,1]$while the rest of the parameter values are fixed. Finally, I would like to plot each of those$e$and$w$against$a \in [0,1]$. The plots will look something like my second and third figures. – ppp Jun 28 at 2:23 • Note: Each of the solution pairs of$e$and$w$corresponding to$s \in [0,1]$would be found graphically in my first figure at a point where the ray from the origin meets at a tangent point on each of the curve therein. – ppp Jun 28 at 2:27 • Hello Bob, Thanks for your answer post. May I ask for your additional help on my follow-up comments I made above? Many thanks in advance! – ppp Jun 29 at 5:46 • Your equation and the subsequent D[e, w] == e/w have three variables, i.e., {a, e, w}. In any 2D plot, the third variable will be represented by a family of curves, not a single curve as you suggest in your plots of e vs. a and w vs. a. The ContourPlots that I show are for the equation D[e, w] == e/w. What I have shown is how I would approach the problem. Jun 29 at 19:32 • Bob, thanks for your explanation. Let me clarify:$a$is an exogenous parameter, while$e$and$w$are variables endogenously determined within the model. I'm interested in how the determination of$e$and$w$would depend on$a$. That is, for each level of$a \in [0,1]$, there is a unique pair of (e,w). With this relation, I would like to plot$e$and$w$against$a$but separately, i.e. a plot of$e$against$a$and another plot of$w$against$a\$. I hope this clarifies. I would really appreciate your help once more!