Plotting solutions to an equation for varying parameter value produces empty graphs

Questions
, ,
1

Consider an objective function

v = ((i + lambda) Uem - (-1 + e) Uun)/(i (1 - e + i + lambda))

where

n = 1; beta = 0.6; W = 60; i=0.05;
L = (w/(beta (a e)^beta))^(1/(beta - 1));
lambda = ((1 - e) n L)/(1 - e n L);
Uem = w - 1/(w (1 - e));
b[e_] := b /. Solve[a W (1 + i)^(1/(1 - e) + 1/lambda - 1)- b \!\(\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(\*FractionBox[\(1\), \(lambda\)] - 1\)]\(\((1 + i)\)^j\)\) == b + a W, b][[1]];
Uun = b[e] - 1/b[e];

under the conditions of 0\leq e \leq 1 and U_{em} > U_{un}.

I would like to do some plotting by taking the following steps.

Step 1: Find e that maximizes v which will be yielded as a function of w with the parameter a, i.e., e = f(w; a).

Step 2: Find e and w as the solution of \frac{\partial f}{\partial w}=\frac{e}{w} for varying values of a \in [0,1].

Step 3: Plot e and w obtained in Step 2 against a \in [0,1].

My entire code for this is:

Clear["Global`*"];
n = 1; beta = 0.6; W = 60;
L = (w/(beta (a e)^beta))^(1/(beta - 1));
lambda = ((1 - e) n L)/(1 - e n L);
Uem = w - 1/(w (1 - e));
b[e_] := b /. Solve[a^2 W (1 + i)^(1/(1 - e) + 1/lambda -1) - b \!\(\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(\*FractionBox[\(1\), \(lambda\)] - 1\)]\(\((1 + i)\)^j\)\) ==b + a^2 W, b][[1]];
Uun = b[e] - 1/b[e];
v = ((i + lambda) Uem - (-1 + e) Uun)/(i (1 - e + i + lambda));
f[e_, w_, a_, i_] = ArgMax[{v, e >= 0, e <= 1, Uem > Uun}, e];
With[{i = 5/100}, sol[a_] := sol[a] = FindRoot[D[f[e, w, a, i], w] == e/w, {{e, 0.5}, {w, 0.5}}]; {estar[a_], wstar[a_]} := {e /. sol[a], w /. sol[a]}; estarplot = Plot[estar[a], {a, 0, 1}, AxesLabel -> {s, SuperStar[\[CurlyEpsilon]]}, PlotRange -> {{0, 1}, {0, 1}}]; wstarplot = Plot[wstar[a], {a, 0, 1}, AxesLabel -> {s, SuperStar[w]}, PlotRange -> {{0, 1}, {0, 10}}];]
e = estarplot;
w = wstarplot;
Style[Row[{e, w}], ImageSizeMultipliers -> {0.6, 0.6}]

And I get empty graphs along with a list of error messages as follows.

Capture.PNG.jpg
Capture.PNG.jpg1703×1015 221 KB

I also tried

f[e0_?NumericQ, a0_?NumericQ, w0_?NumericQ, i0_?NumericQ] := Block[{e = e0, a = a0, w = w0, i = i0}, ArgMax[{v, e >= 0, e <= 1, Uem > Uun}, e]];

in place of

f[e_, w_, a_, i_] = ArgMax[{v, e >= 0, e <= 1, Uem > Uun}, e];

but the result is the same. Can anyone help please?

2

I stopped at the first error I caught:

f[e_, w_, a_, i_] = ArgMax[{v, e >= 0, e <= 1, Uem > Uun}, e]

The variable e is dummy inside ArgMax. You cannot refer to it in the definition of f.

3

Thanks, Gianluca! But even after fixing this, I get the same outcome. May I ask for your additional advice?

4

The expression

D[f[e, w, a, i], w] == e/w

makes little sense to me, because (1) how do you calculate the derivative of ArgMax? (2) the function f cannot depend on e, but e appears on the right hand side.

5

Thanks. This is my understanding: (1) ArgMax will generate e that maximizes v, and that e will come out as a function of w, a, and i, i.e., e=f(w,a,i). So we can calculate the derivative of f[] with respect to w. (2) Yes, you are correct, I removed e from f[]. Please do let me know if I misunderstood. Thanks for your help in advance!

6

The value of e that maximizes v is not a simple function of the parameters. Its derivative is even more complicated, if it exists at all.

What is the e in the right hand side of D[f[w, a, i], w] == e/w ?

With FindRoot you are trying to solve one equation in two unknowns. What do you expect to find?

7

Thanks, Gianluca! Let me clarify my goal by referring to the following graph:

5029Graph.PNG
5029Graph.PNG387×381 49.6 KB

Each curve is a plot of e that maximizes v as a function of w for a given a, and the curve shifts rightward with an increase in a. (Typo in the graph: s should be a.) I would like to find an equilibrium pair of (e,w) for different level of a, and that is indicated by the dot in each curve. And the equilibrium condition is \frac{\partial e}{\partial w} = \frac{e}{w}, i.e. the point where the ray from the origin meets the curve tangentially.

I’m also attaching a Notebook file which contains my previous code where I used f[...] = D[v,e] instead of f[...] = ArgMax[v,e] and hence what’s inside FindRoot[] was also different. As you can see in the file, this code did generate a result. But I was dubious of the shape of the plots obtained. And I was suspecting D[v,e] could be the problem since in this code, only the first-order condition, but not the second-order condition, was verified; hence we cannot guarantee whether it is maximum or minimum. That is why I have changed over to ArgMax[v,e], which however does not yield an outcome at all in the first place. I hope this clarifies what my goal is. If not, please let me know.
Thank you so much for taking time to help!

Previous Code.nb (31.3 KB)

8

If I understand it correctly, the e in D[f[w, a, i], w] == e/w should be f[w, a, i]. However, the calculation of f[w, a, i] is terribly complicated, just as the inequality Uem > Uun.

9

In fact, f[w, a, i] is the curve in the figure whereas e in e/w is on the straight ray (dotted line) from the origin. The equality D[f[w, a, i], w] == e/w defines the dot where the two meet tangentially. I hope this clarifies.

10

I think you should write not D[f[w, a, i], w] == e/w but

D[f[w, a, i], w] == f[w, a, i]/w

because your e and f[w, a, i] are not independent objects.

11

Thanks for your comment, Gianluca! I looked at it several times but it seems to me that the code for \frac{\partial e}{\partial w} = \frac{e}{w} is D[f[w, a, i], w] == e/w. I think this can also be verified graphically by referring to the graph above.

12

If you are right then the equation D[f[w, a, i], w] == e/w is trivially solved as

e == w D[f[w, a, i], w]

and w is arbitrary.