Manipulate and Plot of Tangent Point in Optimization Problem: Solve Problems

Question

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,

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;

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!

kglr · Accepted Answer

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}]

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}]

Bob Hanlon · Answer

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"}]

Manipulate and Plot of Tangent Point in Optimization Problem: Solve Problems

2 Answers

Add your own answers!

Ask a Question