# How to Add Vertical Line and Intersection in Manipulate-Plot-Row Diagram

I would like to represent i) the K^s value as a vertical line in the right diagram and ii) identify the intersection of the vertical line with the downward-sloping curve with "E" (as well as vertical and horizontal values) as in the left diagram.

So when sliding the K^s-bar, the blue curve shifts up/down changing "E" on the left and the vertical line shifting right/left changing the "E" on the right.

Thank you for any hints or solutions!

Clear["Global*"]
y[a_, k_, l_, c_] := a*k^c*l^(1 - c);
mpl[a_, k_, l_, c_] := (1 - c)*a*k^c*l^(-c);
mpk[a_, k_, l_, c_] := c*a*k^(c - 1)*l^(1 - c);
lsupply[b_, m_, l_] := b + m*l;

(* Intersection in Left Diagram - point, dashed lines *)

intersectlabor[a_, k_, c_, b_, m_] := {l, mpl[a, k, l, c]} /.NSolve[{mpl[a, k, l, c] == lsupply[b, m, l], a > 0, b > 0, m > 0, l > 0, k > 0, c > 0}, l][[1]]

xintersectlabor[a_, k_, l_, c_, b_, m_] := Part[intersectlabor[a, k, c, b, m], 1]
yintersectlabor[a_, k_, l_, c_, b_, m_] := Part[intersectlabor[a, k, c, b, m], 2]

hinterceptline[a_, k_, l_, c_, b_, m_] := Line[{{0,yintersectlabor[a, k, l, c, b, m]}, xintersectlabor[a, k, l, c, b, m], yintersectlabor[a, k, l, c, b, m]}}]
vinterceptline[a_, k_, l_, c_, b_, m_] := Line[{{xintersectlabor[a, k, l, c, b, m],0}, {xintersectlabor[a, k, l, c, b, m],yintersectlabor[a, k, l, c, b, m]}}]

Manipulate[Row[{
Plot[{mpl[a, k, l, c], lsupply[b, m, l]}, {l, 0, 100}, PlotRange -> {25, 1000}, AxesLabel -> {"N", "\!$$\*SubscriptBox[\(MP$$, $$N$$]\), w"}, PlotLabel -> "Left Diagram", LabelStyle -> Black, ImageSize -> {400, 250}, Epilog -> {Red, PointSize@Large, Point@intersectlabor[a, k, c, b, m], Text["E", intersectlabor[a, k, c, b, m], {-1, -1.5}], Text["\!$$\*SuperscriptBox[\(w$$, $$*$$]\)", {0, yintersectlabor[a, k, l, c, b, m]}, {-2, 1.2}], Text["\!$$\*SuperscriptBox[\(N$$, $$*$$]\)", {xintersectlabor[a, k, l, c, b, m], 0}, {1, -1.5}], Dashed, hinterceptline[a, k, l, c, b, m], vinterceptline[a, k, l, c, b, m]}],
Plot[mpk[a, k, xintersectlabor[a, k, l, c, b, m], c], {k, 0, 500}, PlotRange -> {5, 125}, AxesLabel -> {"Capital, K", "\!$$\*SubscriptBox[\(MP$$, $$K$$]\)"}, PlotLabel -> "Right Diagram", LabelStyle -> Black, ImageSize -> {400, 250}]}],
{{a, 150, "TFP, A"}, 1, 400, 1, Appearance -> "Labeled"}, {{k, 350, "Capital, \!$$\*SuperscriptBox[\(K$$, $$s$$]\)"}, 15, 1000, 5, Appearance -> "Labeled"}, {{c, 1/3}, 0.01, 0.99, 0.01, Appearance -> "Labeled"}, {{b, 150, "Shifter \!$$\*SuperscriptBox[\(L$$, $$s$$]\)"}, 400, 0.002, 5}, {{m, 5, "Slope!$$\*SuperscriptBox[\(L$$, $$s$$]\)"}, 0.1, 200, 1, Appearance -> "Labeled"}, ContentSize -> {900, 300}]


For a minimal change in your code, replace the second plot with

Plot[mpk[a, kk, xintersectlabor[a, kk, l, c, b, m], c], {kk, 0, 500},
PlotRange -> {5, 125},
AxesLabel -> {"Capital, K", "\!$$\*SubscriptBox[\(MP$$, $$K$$]\)"},
PlotLabel -> "Right Diagram", LabelStyle -> Black,
ImageSize -> {400, 250},
MeshFunctions -> {# &},
Mesh -> {{k}},
MeshStyle -> Directive[Red, PointSize[Large]],
GridLines -> {{{k, Red}}, None}]


to get

Update: An alternative, more streamlined, approach using MeshFunctions to mark the equilibrium on the left panel, and post-processing to add annotations using the coordinates of the intersection:

First the functions we need for the plots:

Clear[y, a, k, l, c, mpl, mpk, lsupply]

y[a_, k_, l_, c_] := a k^c  l^(1 - c)

lsupply[b_, m_, l_] := b + m  l

mpl[a_, k_, l_, c_] := Evaluate @ D[y[a, k, l, c], l]

mpk[a_, k_, l_, c_] := Evaluate @ D[y[a, k, l, c], k]


and two functions to inject the equilibrium l in mpl and to post-process plot output to add dashed lines and labels for the equilibrium point:

ClearAll[lE, annotate]

lE = Cases[#, Point[x_] :> x[[1]], All] &;

annotate = ReplaceAll[p : Point[x_] :>
{p, Dashed,
{Text["E", #, {-1, -1.5}],
Text[Superscript[w, "*"], Offset[{5, 0}, {0, #[[2]]}], {-1, -1}],
Text[Superscript["N", "*"], Offset[{5, 5}, {#[[1]], 0}], {-1, -1}],
Line[{{0, #[[2]]}, #, {#[[1]], 0}}]} & @ x}];


Options for the two plots:

options1 = Sequence[PlotRange -> {25, 1000},
AxesLabel -> {"N", ToString[Subscript["MP", N], StandardForm] <> ", w"},
PlotLabel -> "Left Diagram", LabelStyle -> Black,
ImageSize -> {400, 250},
MeshStyle -> Directive[Red, PointSize[Large]]];

options2 = Sequence[PlotRange -> {5, 125},
AxesLabel -> {"Capital, K", ToString[Subscript["MP", K], StandardForm]},
PlotLabel -> "Right Diagram", LabelStyle -> Black,
MeshFunctions -> {# &},
MeshStyle -> Directive[Red, PointSize[Large]],
ImageSize -> {400, 250}];


... and Manipulate:

Manipulate[Row[{
annotate @ (plt1 = Normal @ Plot[{mpl[a, k, l, c], lsupply[b, m, l]}, {l, 0, 100},
Evaluate @ options1,
MeshFunctions -> {mpl[a, k, #, c] - lsupply[b, m, #] &},
Mesh -> {{0}}]) ,
Plot[mpk[a, kk, lE @ plt1, c], {kk, 0, 500},
Evaluate @ options2, Mesh -> {{k}}, GridLines -> {{{k, Red}}, None}]}],
{{a, 150, "TFP, A"}, 1, 400, 1, Appearance -> "Labeled"},
{{k, 350, "Capital," <> ToString[Superscript[K, "s"], StandardForm]},
15, 1000, 5, Appearance -> "Labeled"},
{{c, 1/3}, 0.01, 0.99, 0.01, Appearance -> "Labeled"},
{{b, 150, "Shifter " <> ToString[Superscript[L, "s"], StandardForm]},
400, 0.002, 5},
{{m, 5, "Slope " <> ToString[Superscript[L, "s"], StandardForm] },
0.1, 200, 1, Appearance -> "Labeled"},
{plt1, None},
TrackedSymbols :> {a, b, c, k, m},
ContentSize -> {900, 300}]
`

• Thank you! All of them are great options.
– Tom
Mar 24, 2021 at 18:09
• How would you add the "E" with labels in the right diagram for the updated version?
– Tom
Mar 24, 2021 at 18:50
• Got it! It's labeled now... Just trying to find a way to label the vertical red line now.
– Tom
Mar 24, 2021 at 20:43