1
$\begingroup$

I want to illustrate how changes in the values of exogenous variables and parameters (T,w,[Alpha]) are changing the optimal values of two endogenous variables (f,c)=(f*,c*). The solution is with a tangency condition and a constraint.

Changes in alpha should move the U-graph along the Bcon-graph; changes in T and w change the Bcon-graph and therefore the optimal values of f and c as well as the U-graph.

U = f^\[Alpha]*c^(1 - \[Alpha]) 
Bcon = c - (T - f)*w
MRS = D[U, f]/D[U, c]
AbsSlpCon = D[Bcon, f]
TC = MRS - AbsSlpCon
sols = Solve[{TC == 0, Bcon == 0}, {f, c}]
{SuperStar[f], SuperStar[c]} = {f, c} /. Last[sols]
c1[T_, w_] := c /. Solve[c - (T - f)*w == 0, c]
c2[T_, w_, \[Alpha]_] := c /. Solve[U[SuperStar[f], SuperStar[c]] == U[f, c], c]
Manipulate[Plot[{c1[T, w], c2[T, w, \[Alpha]]}, {f, 0, 24}, PlotRange -> {25, 3000}], {T, 8, 24}, {w, 100, 500}, {\[Alpha], 0, 1}]

Unfortunately,

  1. I cannot use Bcon in line 8 to describe c1[T_,w_] but have to copy the function there to get a linear graph in the plot;

  2. get no output for c2[T_, w_, [Alpha]_] in line 9, which is showing the tangent U-graph on the Bcon-graph.

"Solve::ifun: Inverse functions are being used by Solve, so some solutions may not be found; use Reduce for complete solution information."

Any hints or suggestions?

Thanks!

$\endgroup$

2 Answers 2

1
$\begingroup$

1. Define U and Bcon so that the parameters each depends on appear as arguments:

ClearAll[U, Bcon, MRS, AbsSlpCon, f, c, α, T, w, sols, c1, c2, fcopt]

U[f_, c_, α_] := f^α*c^(1 - α);
Bcon[f_, c_, T_, w_] := c - (T - f)*w;

MRS = D[U[f, c, α], f]/D[U[f, c, α], c];

AbsSlpCon = D[Bcon[f, c, T, w], f];

TC = MRS - AbsSlpCon;

sols = Solve[{TC == 0, Bcon[f, c, T, w] == 0}, {f, c}];

fcopt[T_, w_, α_] := Evaluate[{f, c} /. Last[sols]]

c1[T_, w_] := c /. Solve[Bcon[f, c, T, w] == 0, c][[1]]

c2[T_, w_, α_] = Quiet[c /. 
   Solve[U[## & @@ fcopt[T, w, α], α] ==  U[f, c, α], c][[1]]];

Manipulate[
 Plot[{c1[T, w], c2[T, w, α]}, {f, 0, 24}, 
  PlotRange -> {25, 3000}, 
  Epilog -> {Red, PointSize @ Large, Point @ fcopt[T, w, α]}], 
 {T, 8, 24}, {w, 100, 500}, {{α, 1/2}, 10^-2, 1}]

enter image description here

2. An alternative approach using Maximize and ContourPlot:

ClearAll[opt, uopt, fcopt]
opt[T_, w_, a_] := FullSimplify[
   Maximize[{U[f, c, a], And[Bcon[f, c, T, w] <= 0, f >= 0, c >= 0]}, {f, c}],
   {w > 0, T > 0}]

uopt[T_, w_, a_] := opt[T, w, a][[1]]

fcopt[T_, w_, a_] := {f, c} /. opt[T, w, a][[2]]

Manipulate[With[{u0 = uopt[T, w, α], optfc = fcopt[T, w, α]}, 
  ContourPlot[Evaluate@{U[f, c, α] == u0, Bcon[f, c, T, w] == 0}, 
   {f, 0, 24}, {c, 0, 3000}, 
   ContourStyle -> {Directive[Thick, Orange], Directive[Thick, Blue]},
   PerformanceGoal -> "Quality", 
   Epilog -> {PointSize[Large], Red, Point @ optfc}, 
   PlotRange -> {25, 3000}]], 
 {T, 8, 24}, {w, 100, 500}, {{α, 1/2}, 10^-2, 1}]

enter image description here

$\endgroup$
2
  • $\begingroup$ I'm trying to define the values/point into the first version so I can add the red point into the first output: "Coordinate $CellContext`optfc should be a pair of numbers, or a Scaled or Offset form." Does the red point only work with ContourPlot? $\endgroup$
    – Tom
    Commented Nov 15, 2020 at 22:46
  • 1
    $\begingroup$ @TomG, added the red point in the Plot. $\endgroup$
    – kglr
    Commented Nov 15, 2020 at 23:02
2
$\begingroup$
Clear["Global`*"]

U = f^α*c^(1 - α);
Bcon = c - (T - f)*w;
MRS = D[U, f]/D[U, c];
AbsSlpCon = D[Bcon, f];
TC = MRS - AbsSlpCon;
sols = Solve[{TC == 0, Bcon == 0}, {f, c}];
{SuperStar[f], SuperStar[c]} = {f, c} /. Last[sols] // Simplify;
c1[T_, w_] = c /. Solve[Bcon == 0, c];

U is not defined as a function (i.e, with arguments), so it cannot be used with arguments.

c2[T_, w_, α_] = 
   c /. Solve[(U /. {f -> SuperStar[f], c -> SuperStar[c]}) == U, c]; // Quiet

α must be greater than 0 and less than 1

Manipulate[
 Plot[{c1[T, w], c2[T, w, α]}, {f, 0, 24}, PlotRange -> {25, 3000}],
 {{T, 8}, 8, 24, 1, Appearance -> "Labeled"},
 {{w, 100}, 100, 500, 10, Appearance -> "Labeled"},
 {{α, 0.5}, 0.01, 0.99, 0.01, Appearance -> "Labeled"}]

enter image description here

$\endgroup$

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.