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

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!

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


• I'm trying to define the values/point into the first version so I can add the red point into the first output: "Coordinate \$CellContextoptfc should be a pair of numbers, or a Scaled or Offset form." Does the red point only work with ContourPlot?
– Tom
Commented Nov 15, 2020 at 22:46
• @TomG, added the red point in the Plot.
– kglr
Commented Nov 15, 2020 at 23:02
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"}]