1
$\begingroup$

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: enter image description here

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]
$\endgroup$

1 Answer 1

4
$\begingroup$
$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}]]

enter image description here

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.

$\endgroup$
8
  • $\begingroup$ @ Thanks, Bob! Do you know why we have extra curves at the top left of the plot? $\endgroup$
    – ppp
    Feb 12, 2023 at 2:43
  • 1
    $\begingroup$ 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. $\endgroup$
    – Bob Hanlon
    Feb 12, 2023 at 3:27
  • $\begingroup$ @ 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/… $\endgroup$
    – ppp
    Feb 13, 2023 at 16:43
  • 1
    $\begingroup$ Remove the Placed wrapper. $\endgroup$
    – Bob Hanlon
    Feb 15, 2023 at 16:53
  • 1
    $\begingroup$ Don't know why the inheritance didn't work. Just specify them as in the edit. $\endgroup$
    – Bob Hanlon
    Feb 16, 2023 at 4:17

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.