Mathematica Asked by Tom G on November 26, 2020
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!
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}]
Correct answer by kglr on November 26, 2020
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"}]
Answered by Bob Hanlon on November 26, 2020
Get help from others!
Recent Questions
Recent Answers
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP