# How to visualize point movements across multiple plots using Manipulate or something similar?

I have the following three plots:

fx = Table[{t, Sin[t]}, {t, 0, 2 Pi, 0.1}];
fy = Table[{t, Sin[2 t]}, {t, 0, 2 Pi, 0.1}];
plot1 = ListPlot[fx, Joined -> True, AxesLabel -> {"t", "fx"}];
plot2 = ListPlot[fy, Joined -> True, AxesLabel -> {"t", "fy"}];
plot3 = ListPlot[Transpose[{fx[[;; , 2]], fy[[;; , 2]]}],
Joined -> True, AxesLabel -> {"fx", "fy"}];


On plot1 and plot2, each pair of points {t, fx} and {t, fy} corresponds to a point {fx, fy} on plot3. I would like to find a way to visualize the movement of these three points on the three plots. Specifically, when I move a point on plot3, I want the corresponding points on plot1 and plot2 to move accordingly. I believe this task could be accomplished using Manipulate or a similar approach, but I am unsure of how to begin.

fx = Table[{t, Sin[t]}, {t, 0, 2 Pi, 2 Pi/64}];
fy = Table[{t, Sin[2 t]}, {t, 0, 2 Pi, 2 Pi/64}];
fxy = Transpose[#[[All, 2]] & /@ {fx, fy}];


Transform the coordinates in fx and fy:

translateScale[offset_ : 2, s_ : 1] := # Threaded[{s/2, 1}] +

cx = translateScale[] @ fx;
cy = Map[Reverse] @ translateScale[] @ fy;


Using AxisObject construct custom axes to be used with rotated/translated graphics primitives for fx and fy:

axes[offset_ : 2, s_ : 1] :=
{AxisObject[Line[# /@ {{offset, 0}, {offset + s Pi, 0}}], {0, 2 Pi},
TickLengths -> {.05, .025},
TickLabels -> {Prepend[""]@Rest@Range[0, 2 Pi, Pi/2]},
TickPositions -> {{Range[0, 2 Pi, Pi/2]}, {Pi/4}},
AxisLabel -> Style[" θ", 14]],
AxisObject[Line[# /@ {{offset, -1}, {offset, 1}}], {-1, 1},
TickLengths -> {.05, .025}, TickLabels -> {Range[-1, 1, 1/2]},
TickPositions -> {{1/2}, {1/4}},
AxisLabel -> Placed[Style[
# /. {Identity -> HoldForm[Sin[θ]], _ ->  HoldForm[Sin[2 θ]]}, 14],
# /. {Identity -> {.5, -1}, _ -> Center}],
RotateLabel -> "Parallel"]} & /@ {Identity, Reverse}


Construct graphics primitives using the transformed coordinates:

plots[i_Integer] := ListLinePlot[{fxy, cx, cy},
PlotStyle -> Directive[Gray, Thin],
Axes -> False, ImageSize -> Large, ImagePadding -> 10,
AspectRatio -> 1,
Epilog -> {axes[],
First @ ListLinePlot[{fxy[[;; i]], cx[[;; i]], cy[[;; i]]},
PlotStyle -> Thick],
Text[Style["θ : " <> ToString[fx[[i, 1]], StandardForm], 16],
Scaled[{2/3, 2/3}], Center],
AbsolutePointSize@10,
MapIndexed[{ColorData[97] @ #2[[1]], Point @ #} &]@
{fxy[[i]], cx[[i]], cy[[i]]},
EdgeForm[Dashed], Opacity[.1, Yellow],
Polygon[{fxy[[i]], cx[[i]], cy[[i]]}]}]


Use plots with Manipulate:

Manipulate[plots @ i,
{{i, 5, "index"}, 1, Length @ fx, 1, Appearance -> "Labeled"}]


The animation above is produced using:

frames = Table[plots @ i, {i, 1, Length@fx}];;

Export["frames1.gif", frames]

\$Version

(* "13.2.1 for Mac OS X ARM (64-bit) (January 27, 2023)" *)

Clear["Global*"]

Manipulate[
SetOptions[ParametricPlot,
ColorFunction -> Function[{x, y, t}, ColorData["Rainbow"][t]]];
Legended[
Column[{
ParametricPlot[{t, Sin[t]}, {t, 0, 2 Pi},
AxesLabel -> (Style[#, 14] & /@ {"t", "fx"}),
AspectRatio -> 1/GoldenRatio,
Epilog -> {AbsolutePointSize[8],
ColorData["Rainbow"][tv/(2 Pi)],
Point[{tv, Sin[tv]}]}],
ParametricPlot[{t, Sin[2 t]}, {t, 0, 2 Pi},
AxesLabel -> (Style[#, 14] & /@ {"t", "fy"}),
AspectRatio -> 1/GoldenRatio,
Epilog -> {Red, AbsolutePointSize[8],
ColorData["Rainbow"][tv/(2 Pi)],
Point[{tv, Sin[2 tv]}]}],
ParametricPlot[{Sin[t], Sin[2 t]}, {t, 0, 2 Pi},
AxesLabel -> (Style[#, 14] & /@ {"fx", "fy"}),
AspectRatio -> 1/GoldenRatio,
Epilog -> {Red, AbsolutePointSize[8],
ColorData["Rainbow"][tv/(2 Pi)],
Point[{Sin[tv], Sin[2 tv]}]}]}],
Framed[
BarLegend[{"Rainbow", {0, 2 Pi}},
LegendLabel -> Style["t", 14]],
{{tv, 0, "t"}, 0, 2 Pi, 0.01, Appearance -> "Labeled"}]


Something like:

Manipulate[
{ListPlot[fx, Joined -> True, AxesLabel -> {"t", "fx"},
Epilog -> {PointSize[0.05], Point[{x, Sin[x]}]}],
ListPlot[fy, Joined -> True, AxesLabel -> {"t", "fy"},
Epilog -> {PointSize[0.05], Point[{x, Sin[2 x]}]}],
ListPlot[Transpose[{fx[[;; , 2]], fy[[;; , 2]]}], Joined -> True,
AxesLabel -> {"fx", "fy"},
Epilog -> {PointSize[0.05], Point[{Sin[x], Sin[2 x]}]}]}
, {x, .0, 2 Pi}]


• Here we only use the discrete data, does not depend on the function Sin[t] and Sin[2t].
Manipulate[
GraphicsRow@{Show[plot1,
Graphics[{AbsolutePointSize[10], Orange, Point@fx[[i]]}]],
Show[plot2,
Graphics[{AbsolutePointSize[10], Orange, Point@fy[[i]]}]],
Show[plot3,
Graphics[{AbsolutePointSize[10], Orange,
Point@Transpose[{fx[[;; , 2]], fy[[;; , 2]]}][[i]]}]]}, {i, 1,
Length@fx, 1}]


• We rotate -90 Degree of the graph fx to illustrate the co-relationship between fx,fy and fxy.
Clear["Global*"];
fx = Table[{t, Sin[t]}, {t, 0, 2 Pi, 0.1}];
fy = Table[{t, Sin[2 t]}, {t, 0, 2 Pi, 0.1}];

plotx = ListPlot[Reverse[fx, 2], Joined -> True,
AxesLabel -> Reverse@{"t", "fx"}];
ploty = ListPlot[fy, Joined -> True, AxesLabel -> {"t", "fy"}];
plotxy =
ListPlot[Transpose[{fx[[;; , 2]], fy[[;; , 2]]}], Joined -> True,
AxesLabel -> {"fx", "fy"}];
Manipulate[
Grid@{{Show[plotxy,
Graphics[{AbsolutePointSize[10], Red,
Point@Transpose[{fx[[;; , 2]], fy[[;; , 2]]}][[i]]}]],
Show[ploty,
Graphics[{AbsolutePointSize[10], Magenta,
Point@fy[[i]]}]]}, {Show[plotx,
Graphics[{AbsolutePointSize[10], Magenta,
Point@Reverse@fx[[i]]}]]}}, {i, 1, Length@fx, 1}]