# How to plot the movement of points as I change the slider

I have this code that generates an Edgeworth both with two optimum points. The optimal points change as I move the slider. I would like to plot/trace the change in the optimal so that at the end I can see in a graph how the optimum moved with the change in slider's value. Anyone can help please? Here is my code:

sigma = 1.5;
a11 = 0.4;
a21 = 0.6;
a12 = 0.4;
a22 = 0.6;
t12 = 1;
t21 = 1;
u1 = Function[{xa1,
xa2}, (a11^(1/sigma)*xa1^((sigma - 1)/sigma) +
a21^(1/sigma)*xa2^((sigma - 1)/sigma))^(sigma/(sigma - 1))];
u2 = Function[{xb1,
xb2}, (a12^(1/sigma)*xb1^((sigma - 1)/sigma) +
a22^(1/sigma)*xb2^((sigma - 1)/sigma))^(sigma/(sigma - 1))];
SetOptions[ContourPlot,
ContourShading -> None]; SetOptions[RegionPlot, PlotStyle -> None,
Mesh -> Full, BoundaryStyle -> Directive[Black, Thick]];
ICmap = Show[
ContourPlot[{u1[xa1, xa2]}, {xa1, 0, 1}, {xa2, 0, 1},
ContourStyle -> Table[Directive[Red, Opacity[i/10]], {i, 10}]],
ContourPlot[{u2[1 - xa1, 1 - xa2]}, {xa1, 0, 1}, {xa2, 0, 1},
ContourStyle -> Table[Directive[Blue, Opacity[i/10]], {i, 10}]],
Graphics[{Dashed, Opacity[.2], Line[{{0, 0}, {1, 1}}]}]];
InvTicks = Table[{.2 (i - 1), 1 - .2 (i - 1)}, {i, 6}];

Manipulate[
uMax = {ArgMax[{u1[xa1, xa2],
And[xa1 + \[Rho]*t21*xa2 == e[[1]] + \[Rho]*e[[2]],
0 <= xa1 <= 1, 0 <= xa2 <= 1]}, {xa1, xa2}],
ArgMax[{u2[1 - xa1, 1 - xa2],
And[t12 (1 - xa1) + \[Rho]*t12*(1 - xa2) ==
1 - e[[1]] + \[Rho]*(1 - e[[2]]), 0 <= xa1 <= 1,
0 <= xa2 <= 1]}, {xa1, xa2}]};

BudgetSets1 = {RegionPlot[
xa1 + \[Rho]*t21*xa2 <= e[[1]] + \[Rho]*e[[2]], {xa1, 0, 1}, {xa2,
0, 1}, MeshStyle -> Directive[Opacity[.07], Red]],
RegionPlot[
xa1 + \[Rho]*t21*xa2 > e[[1]] + \[Rho]*e[[2]], {xa1, 0, 1}, {xa2,
0, 1}, MeshStyle -> Directive[Opacity[.05], Blue]]};

BudgetSets2 = {RegionPlot[
t12 (1 - xa1) + \[Rho]*t12*(1 - xa2) <=
1 - e[[1]] + \[Rho]*(1 - e[[2]]), {xa1, 0, 1}, {xa2, 0, 1},
MeshStyle -> Directive[Opacity[.07], Green]],
RegionPlot[
t12 (1 - xa1) + \[Rho]*t12*(1 - xa2) >
1 - e[[1]] + \[Rho]*(1 - e[[2]]), {xa1, 0, 1}, {xa2, 0, 1},
MeshStyle -> Directive[Opacity[.05], Yellow]]};

tangentICs =
ContourPlot[{u1[xa1, xa2] == u1 @@ uMax[[1]],
u2[1 - xa1, 1 - xa2] == u2 @@ (1 - uMax[[2]])}, {xa1, 0, 1}, {xa2,
0, 1}, ContourStyle -> {Directive[Red, Thickness[.01],
Opacity[.7]], Directive[Blue, Thickness[.01], Opacity[.6]]}];

optPoints =
Graphics[{PointSize[.025], {Red, (Point[uMax[[1]]])}, {Blue, (Point[
uMax[[2]]])}}];
Show @@ {BudgetSets1, BudgetSets2, tangentICs, optPoints,
FrameTicks -> {{Automatic, InvTicks}, {Automatic,
InvTicks}}, \[CapitalDelta] = uMax[[2, 1]] - uMax[[1, 1]];
FrameLabel ->
Which[\[CapitalDelta] <
0, {{None, "excess supply of y"}, {"excess demand for x",
None}}, \[CapitalDelta] >
0, {{None, "excess demand for y"}, {"excess supply of x",
None}}, \[CapitalDelta] ==
0, {{None, "market clears"}, {"market clears",
None}}]}, {{\[Rho], 1}, 1/2, 2}, {{e, {3/4, 1/4}}, Locator},
ContinuousAction -> False, ControlType -> VerticalSlider,
ControlPlacement -> Left]

Here's a quick implementation; not terribly elegant but gets the job done. I've added two checkboxes which allow the user to add a point to a trace line and then clear that line if desired. The revised code:

sigma = 1.5;
a11 = 0.4;
a21 = 0.6;
a12 = 0.4;
a22 = 0.6;
t12 = 1;
t21 = 1;
u1 = Function[{xa1,
xa2}, (a11^(1/sigma)*xa1^((sigma - 1)/sigma) +
a21^(1/sigma)*xa2^((sigma - 1)/sigma))^(sigma/(sigma - 1))];
u2 = Function[{xb1,
xb2}, (a12^(1/sigma)*xb1^((sigma - 1)/sigma) +
a22^(1/sigma)*xb2^((sigma - 1)/sigma))^(sigma/(sigma - 1))];
SetOptions[ContourPlot,
ContourShading -> None]; SetOptions[RegionPlot, PlotStyle -> None,
Mesh -> Full, BoundaryStyle -> Directive[Black, Thick]];
ICmap = Show[
ContourPlot[{u1[xa1, xa2]}, {xa1, 0, 1}, {xa2, 0, 1},
ContourStyle -> Table[Directive[Red, Opacity[i/10]], {i, 10}]],
ContourPlot[{u2[1 - xa1, 1 - xa2]}, {xa1, 0, 1}, {xa2, 0, 1},
ContourStyle -> Table[Directive[Blue, Opacity[i/10]], {i, 10}]],
Graphics[{Dashed, Opacity[.2], Line[{{0, 0}, {1, 1}}]}]];
InvTicks = Table[{.2 (i - 1), 1 - .2 (i - 1)}, {i, 6}];

Manipulate[
If[cleartrace == True, (cleartrace = False; trace = {};)];
uMax = {ArgMax[{u1[xa1, xa2],
And[xa1 + \[Rho]*t21*xa2 == e[[1]] + \[Rho]*e[[2]],
0 <= xa1 <= 1, 0 <= xa2 <= 1]}, {xa1, xa2}],
ArgMax[{u2[1 - xa1, 1 - xa2],
And[t12 (1 - xa1) + \[Rho]*t12*(1 - xa2) ==
1 - e[[1]] + \[Rho]*(1 - e[[2]]), 0 <= xa1 <= 1,
0 <= xa2 <= 1]}, {xa1, xa2}]};
BudgetSets1 = {RegionPlot[
xa1 + \[Rho]*t21*xa2 <= e[[1]] + \[Rho]*e[[2]], {xa1, 0, 1}, {xa2,
0, 1}, MeshStyle -> Directive[Opacity[.07], Red]],
RegionPlot[
xa1 + \[Rho]*t21*xa2 > e[[1]] + \[Rho]*e[[2]], {xa1, 0, 1}, {xa2,
0, 1}, MeshStyle -> Directive[Opacity[.05], Blue]]};
BudgetSets2 = {RegionPlot[
t12 (1 - xa1) + \[Rho]*t12*(1 - xa2) <=
1 - e[[1]] + \[Rho]*(1 - e[[2]]), {xa1, 0, 1}, {xa2, 0, 1},
MeshStyle -> Directive[Opacity[.07], Green]],
RegionPlot[
t12 (1 - xa1) + \[Rho]*t12*(1 - xa2) >
1 - e[[1]] + \[Rho]*(1 - e[[2]]), {xa1, 0, 1}, {xa2, 0, 1},
MeshStyle -> Directive[Opacity[.05], Yellow]]};
tangentICs =
ContourPlot[{u1[xa1, xa2] == u1 @@ uMax[[1]],
u2[1 - xa1, 1 - xa2] == u2 @@ (1 - uMax[[2]])}, {xa1, 0, 1}, {xa2,
0, 1}, ContourStyle -> {Directive[Red, Thickness[.01],
Opacity[.7]], Directive[Blue, Thickness[.01], Opacity[.6]]}];
optPoints =
Graphics[{PointSize[.025], {Red, (Point[uMax[[1]]])}, {Blue, (Point[
uMax[[2]]])},(* Added here *) {Black, Dashed, Line@trace}}];
Show @@ {BudgetSets1, BudgetSets2, tangentICs, optPoints,
FrameTicks -> {{Automatic, InvTicks}, {Automatic,
InvTicks}}, \[CapitalDelta] = uMax[[2, 1]] - uMax[[1, 1]];
FrameLabel ->
Which[\[CapitalDelta] <
0, {{None, "excess supply of y"}, {"excess demand for x",
None}}, \[CapitalDelta] >
0, {{None, "excess demand for y"}, {"excess supply of x",
None}}, \[CapitalDelta] ==
0, {{None, "market clears"}, {"market clears",
None}}]}, {{\[Rho], 1}, 1/2, 2}, {{e, {3/4, 1/4}},
ControlType -> Checkbox}, {{cleartrace, False}, {True, False},
ControlType -> Checkbox}, ContinuousAction -> False,
ControlType -> VerticalSlider, ControlPlacement -> Left,
(* Added here *) Initialization :> (trace = {};)]

...and sample output

Here's my go. I use global variables, which is not quite the best way, but it works. If you change e then I erase the memory. I also took the liberty of taking all your definitions outside of the Manipulate block, because I find it more elegant.

sigma = 1.5;
a11 = 0.4;
a21 = 0.6;
a12 = 0.4;
a22 = 0.6;
t12 = 1;
t21 = 1;
u1 = Function[{xa1,
xa2}, (a11^(1/sigma)*xa1^((sigma - 1)/sigma) +
a21^(1/sigma)*xa2^((sigma - 1)/sigma))^(sigma/(sigma - 1))];
u2 = Function[{xb1,
xb2}, (a12^(1/sigma)*xb1^((sigma - 1)/sigma) +
a22^(1/sigma)*xb2^((sigma - 1)/sigma))^(sigma/(sigma - 1))];
SetOptions[ContourPlot,
ContourShading -> None]; SetOptions[RegionPlot, PlotStyle -> None,
Mesh -> Full, BoundaryStyle -> Directive[Black, Thick]];
ICmap = Show[
ContourPlot[{u1[xa1, xa2]}, {xa1, 0, 1}, {xa2, 0, 1},
ContourStyle -> Table[Directive[Red, Opacity[i/10]], {i, 10}]],
ContourPlot[{u2[1 - xa1, 1 - xa2]}, {xa1, 0, 1}, {xa2, 0, 1},
ContourStyle -> Table[Directive[Blue, Opacity[i/10]], {i, 10}]],
Graphics[{Dashed, Opacity[.2], Line[{{0, 0}, {1, 1}}]}]];
InvTicks = Table[{.2 (i - 1), 1 - .2 (i - 1)}, {i, 6}];
\[Rho]List = {};
uList = {};
globale = {3/4, 1/4};
uMax[e_, \[Rho]_] := uMax[e, \[Rho]] = Module[{result},
If[Thread[e != globale], \[Rho]List = {}; uList = {}; globale = e];
result = {ArgMax[{u1[xa1, xa2],
And[xa1 + \[Rho]*t21*xa2 == e[[1]] + \[Rho]*e[[2]],
0 <= xa1 <= 1, 0 <= xa2 <= 1]}, {xa1, xa2}],
ArgMax[{u2[1 - xa1, 1 - xa2],
And[t12 (1 - xa1) + \[Rho]*t12*(1 - xa2) ==
1 - e[[1]] + \[Rho]*(1 - e[[2]]), 0 <= xa1 <= 1,
0 <= xa2 <= 1]}, {xa1, xa2}]};
AppendTo[\[Rho]List, \[Rho]];
AppendTo[uList, result];
result
];
BudgetSets1[
e_, \[Rho]_] := {RegionPlot[
xa1 + \[Rho]*t21*xa2 <= e[[1]] + \[Rho]*e[[2]], {xa1, 0, 1}, {xa2,
0, 1}, MeshStyle -> Directive[Opacity[.07], Red]],
RegionPlot[
xa1 + \[Rho]*t21*xa2 > e[[1]] + \[Rho]*e[[2]], {xa1, 0, 1}, {xa2,
0, 1}, MeshStyle -> Directive[Opacity[.05], Blue]]};
BudgetSets2[
e_, \[Rho]_] := {RegionPlot[
t12 (1 - xa1) + \[Rho]*t12*(1 - xa2) <=
1 - e[[1]] + \[Rho]*(1 - e[[2]]), {xa1, 0, 1}, {xa2, 0, 1},
MeshStyle -> Directive[Opacity[.07], Green]],
RegionPlot[
t12 (1 - xa1) + \[Rho]*t12*(1 - xa2) >
1 - e[[1]] + \[Rho]*(1 - e[[2]]), {xa1, 0, 1}, {xa2, 0, 1},
MeshStyle -> Directive[Opacity[.05], Yellow]]};
tangentICs[e_, \[Rho]_] :=
ContourPlot[{u1[xa1, xa2] == u1 @@ uMax[e, \[Rho]][[1]],
u2[1 - xa1, 1 - xa2] == u2 @@ (1 - uMax[e, \[Rho]][[2]])}, {xa1,
0, 1}, {xa2, 0, 1},
ContourStyle -> {Directive[Red, Thickness[.01], Opacity[.7]],
Directive[Blue, Thickness[.01], Opacity[.6]]}];
optPoints[e_, \[Rho]_] :=
Graphics[{PointSize[.025], {Red, (Point[
uMax[e, \[Rho]][[1]]])}, {Blue, (Point[
uMax[e, \[Rho]][[2]]])}}];
label[e_, \[Rho]_] :=
With[{\[CapitalDelta] =
uMax[e, \[Rho]][[2, 1]] - uMax[e, \[Rho]][[1, 1]]},
Which[\[CapitalDelta] <
0, {{None, "excess supply of y"}, {"excess demand for x",
None}}, \[CapitalDelta] >
0, {{None, "excess demand for y"}, {"excess supply of x",
None}}, \[CapitalDelta] ==
0, {{None, "market clears"}, {"market clears", None}}]
]
line := Module[{perm},
If[Length[\[Rho]List] == 0, Graphics[],
perm = Ordering[\[Rho]List];
Graphics[{Red, Line[uList[[perm, 1]]], Blue,
Line[uList[[perm, 2]]]}]
]
]
Manipulate[
Show[BudgetSets1[e, \[Rho]], BudgetSets2[e, \[Rho]],
tangentICs[e, \[Rho]], optPoints[e, \[Rho]], line,
FrameTicks -> {{Automatic, InvTicks}, {Automatic, InvTicks}},
FrameLabel -> label[e, \[Rho]]],
{{\[Rho], 1}, 1/2, 2}, {{e, {3/4, 1/4}}, Locator},
ContinuousAction -> False, ControlType -> VerticalSlider,
ControlPlacement -> Left]

Result: