# Plotting with implicit function

I have a problem similar to this. I followed the solution therein but my problem is still not resolved.

I have an implicit function, $$F(e,w;a,i,b,n)=0$$ that implicitly yields $$e$$ has a function of $$w$$ along with the parameters, $$a$$, $$i$$, $$n$$, and $$b$$, i.e. $$e = e(w;a,i,n,b)$$. Next, $$w$$ is also endogenously determined as the solution of $$\frac{\partial e}{\partial w} = \frac{e}{w}$$. The relevant ranges are: $$0\leq e \leq 1$$, $$w \geq 0$$, $$0\leq a \leq 1$$, $$0\leq i \leq 1$$, $$0\leq b \leq 1$$, $$n \geq 0$$.

I would like to produce two diagrams. First, a plot of $$e$$ against $$w$$ for three different values of $$a$$, $$a=0.1$$, $$a=0.5$$, $$a=0.9$$, for given $$i=0.1$$, $$b=0.7$$, $$n=1$$. It would look something like:

Second, I would like to plot $$\frac{w}{ae}$$ against $$a$$ for varying parameter values of $$i=[0,1]$$, $$b=[0,1]$$, and $$n=1$$, using Manipulate.

My code is the following:

Clear["Global*"]
n = 1
eqns[i_, b_] = {D[w - 1/((1 - e) w), e] == D[1 - e, e] ((-((-a (i + ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 - n e (w/(b e^b))^(1/(b - 1)))) + (-1 + a^2) (-1 + e)^2 w - a (-1 + e) (i + ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 - n e (w/(b e^b))^(1/(b - 1)))) w^2)/(a (-1 + e) i (1 - e + i + ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 - n e (w/(b e^b))^(1/(b - 1)))) w))) - (-((-a ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 - n e (w/(b e^b))^(1/(b - 1))) + (-1 + a^2) (-1 + e) (-1 + e - i) w - a (-1 + e) ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 - n e (w/(b e^b))^(1/(b - 1)))w^2)/(a (-1 + e) i (1 - e + i + ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 - n e (w/(b e^b))^(1/(b - 1)))) w)))), D[e, w] == e/w, r == w/a e, 0 <= i <= 1, 0 <= a <= 1, 0 <= e <= 1, w >= 0, 0 <= b <= 1}
Plot[Evaluate@Table[e, {a, {0.1, 0.5, 0.9}}], {w, 0, 5}, PlotRange -> {0, 1}, PlotLabels -> {"a=0.1", "a=0.5", "a=0.9"}, AxesLabel -> {w, e}]
Manipulate[Module[{i = Rationalize[iv], b = Rationalize[bv]}, sol = SolveValues[eqns[i, b], r, {e, w}, Reals]; Plot[Evaluate@sol, {a, 0, 1}, PlotRange -> {0, 23}, PlotRangePadding -> Scaled[.05], Frame -> True, FrameLabel -> (Style[#, 14] & /@ {"w/(ae)", HoldForm[w/(a e)]})]] // Quiet, {{iv, 0.1, "i"}, 0, 1, 0.01, Appearance -> "Labeled"}, {{bv, 0.1, "b"}, 0, 1, 0.01, Appearance -> "Labeled"}, SynchronousUpdating -> False, TrackedSymbols :> All]


\$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 + ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 -
n e (w/(b e^b))^(1/(b - 1)))) + (-1 + a^2) (-1 + e)^2 w -
a (-1 + e) (i + ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 -
n e (w/(b e^b))^(1/(b - 1)))) w^2)/(a (-1 + e) i (1 - e +
i + ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 -
n e (w/(b e^b))^(1/(b - 1)))) w))) - (-((-a ((1 -
e) n (w/(b e^b))^(1/(b - 1)))/(1 -
n e (w/(b e^b))^(1/(b - 1))) + (-1 + a^2) (-1 + e) (-1 + e -
i) w - a (-1 +
e) ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 -
n e (w/(b e^b))^(1/(b - 1))) w^2)/(a (-1 + e) i (1 - e +
i + ((1 - e) n (w/(b e^b))^(1/(b - 1)))/(1 -
n e (w/(b e^b))^(1/(b - 1)))) w)))),
D[e, w] == e/w, r == w/(a e), 0 <= i <= 1, 0 <= a <= 1, 0 <= e <= 1,
w >= 0, 0 <= b <= 1};


Note that r == w/a e was changed to r == w/(a e) to agree with the use in Manipulate and the stated desire to plot w/(a e) against a.

To plot an implicit equation use ContourPlot

EDIT 2: The color issues was caused by plotting eqns[1/10, 7/10] rather than just its first element eqns[1/10, 7/10][[1]]

ContourPlot[
Evaluate@Table[Simplify@eqns[1/10, 7/10][[1]], {a, {1/10, 1/2, 9/10}}], {w,
0, 5}, {e, 0, 1}, ContourStyle -> colors, PlotPoints -> 50,
MaxRecursion -> 4, FrameLabel -> (Style[#, 14] & /@ {w, e}),
RotateLabel -> False,
PlotLegends ->
Placed[LineLegend[{1/10, 1/2, 9/10}, LegendLabel -> "a ="], {.7, .4}]]


Since e does not have an explicit dependence on w, D[e, w] is zero and the equation D[e, w] == e/w evaluates to 0 == e/w. This requires that e == 0 and causes r to be undefined. This needs to be resolved before the Manipulate can result in a plot.

• @ Thanks, Bob! Do you know why we have extra curves at the top left of the plot?
– ppp
Feb 12, 2023 at 2:43
• Perhaps if you resolve the issue with D[e, w] == e/w there would be a constraint that would eliminate that portion of the solution. I have no idea what "endogenously" means. Feb 12, 2023 at 3:27
• @ Bob, thanks! For this issue, I posted another question. Can you please help me with this? I really appreciate it. mathematica.stackexchange.com/questions/279949/…
– ppp
Feb 13, 2023 at 16:43
• Remove the Placed wrapper. Feb 15, 2023 at 16:53
• Don't know why the inheritance didn't work. Just specify them as in the edit. Feb 16, 2023 at 4:17