0
$\begingroup$

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][[1]], {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: enter image description here

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

Improve this question
$\endgroup$

1 Answer 1

Reset to default
1
$\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 + (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][[1]], 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]

enter image description here

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]

enter image description here

Improve this answer
$\endgroup$
7
  • $\begingroup$ 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. $\endgroup$
    – ppp
    Jun 28 at 2:23
  • $\begingroup$ 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. $\endgroup$
    – ppp
    Jun 28 at 2:27
  • $\begingroup$ 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! $\endgroup$
    – ppp
    Jun 29 at 5:46
  • $\begingroup$ 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. $\endgroup$
    – Bob Hanlon
    Jun 29 at 19:32
  • $\begingroup$ 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! $\endgroup$
    – ppp
    Jul 5 at 3:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.