6
$\begingroup$

I'm making this demonstration that draws a parametric plot of the unit circle, while at the same time has two plots off to the side that draw the sine and cosine curves. I have this made up as an animation:

Animate[
    Row@{
        ParametricPlot[
            {{Cos[t], Sin[t]}, {-Sin[t], Cos[t]}},
            {t, 0, n},
            PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}},
            ImageSize -> 300,
            AspectRatio -> 1,
            PlotStyle -> {
                {Blue, Thickness[0.025]},
                {Green, Thickness[0.0125]}
                },
            Prolog -> {Opacity[0.5], Circle[]},
            Epilog -> {
                {Dotted, Line[{{Cos[n], 0}, {Cos[n], Sin[n]}}]},
                {Dotted, Line[{{-Sin[n], 0}, {-Sin[n], Cos[n]}}]},
                {Opacity[0.5], Line[{{0, 0}, {-Sin[n], Cos[n]}}]},
                {Red, PointSize[0.025], Point[{-Sin[n], Cos[n]}]},
                {Opacity[0.5], Line[{{0, 0}, {Cos[n], Sin[n]}}]},
                {Red, PointSize[0.025], Point[{Cos[n], Sin[n]}]}
                },
            PlotLabel -> "Point on the unit circle"
            ],
        Plot[
            Sin[x],
            {x, 0, n},
            PlotRange -> {{0, 2 Pi}, {-1.5, 1.5}},
            ImageSize -> 300,
            AspectRatio -> 1,
            PlotStyle -> Red,
            Epilog -> {
                {Blue, Thickness[0.0125], Line[{{0, 0}, {n, 0}}]},
                {Dotted, Line[{{n, 0}, {n, Sin[n]}}]},
                {Red, PointSize[0.025], Point[{n, Sin[n]}]}
                },
            PlotLabel -> "Vertical position of point"
            ],
        Plot[
            Cos[x],
            {x, 0, n},
            PlotRange -> {{0, 2 Pi}, {-1.5, 1.5}},
            ImageSize -> 300,
            AspectRatio -> 1,
            PlotStyle -> Red,
            Epilog -> {
                {Green, Thickness[0.0125], Line[{{0, 0}, {n, 0}}]},
                {Dotted, Line[{{n, 0}, {n, Cos[n]}}]},
                {Red, PointSize[0.025], Point[{n, Cos[n]}]}
            },
            PlotLabel -> "Horizontal position of point"
            ]
        },
    {n, .0001, 2 Pi},
    AnimationRunning -> False]

I want to be able to draw dotted lines between the corresponding red points on the circle and their periodic curves.

The only way I know to display several plots as one graphic is with Show, but that would use the same origin for all three plots. Is there a way to have two of the plots retain their coordinate axes, but have their images translated to the right of the first plot?

Improve this question
$\endgroup$
4
  • 1
    $\begingroup$ It is also possible to use a GraphicsRow[{plot1, plot2, ... , plotN}] or a GraphicsGrid[{{plot1,plot2},{plot3,plot4}}] to plot side by side or in a grid. $\endgroup$
    – Histograms
    Commented May 13, 2015 at 16:27
  • $\begingroup$ You can also use show on the graphics grid to draw annotations: Show[ GraphicsGrid[{{ Plot[x, {x, 0, 1}], Plot[x^2, {x, 0, 2}]}}] , Graphics[{Red, Line[ImageScaled /@ {{0.0, 0.0}, {1, 1}}]}] ] $\endgroup$
    – N.J.Evans
    Commented May 13, 2015 at 16:27
  • 1
    $\begingroup$ ... or just Row: i.e. Animate[Row@{ParametricPlot[...], Plot[...],...,...},...] $\endgroup$
    – kglr
    Commented May 13, 2015 at 16:47
  • 1
    $\begingroup$ The Row@ suggestion seems to be the best option at the moment. The others make the animation very choppy. Now the only problem is figuring out how to properly place the line I want. I'm trying to make the endpoints of the line be the red points on the circle and sine curve, but Show is giving me an error. $\endgroup$
    – user170231
    Commented May 13, 2015 at 16:53

2 Answers 2

Reset to default
7
$\begingroup$

to draw dotted lines between the corresponding red points on the circle and their periodic curves

First, create graphics objects showing only the axes for the three plots, and translate and scale the second and third ones by appropriate amounts:

ax1 = FullGraphics[ParametricPlot[{{Cos[t], Sin[t]}, {-Sin[t], Cos[t]}}, {t, 0, 2 Pi},
 PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}, ImageSize -> 300, 
 AspectRatio -> 1, PlotStyle -> None, PlotLabel -> Style["Point on the unit circle", 15]]];

ax2 = FullGraphics[Plot[Sin[x], {x, 0, 2 Pi}, PlotRange -> {{0, 2 Pi}, {-1.5, 1.5}}, 
 ImageSize -> 300, AspectRatio -> 1, PlotStyle -> None, 
 PlotLabel -> Style["Vertical position of point", 15]]];

ax3 = FullGraphics[Plot[Sin[x], {x, 0, 2 Pi}, PlotRange -> {{0, 2 Pi}, {-1.5, 1.5}}, 
 ImageSize -> 300, AspectRatio -> 1, PlotStyle -> None, 
 PlotLabel -> Style["Horizontal position of point", 15]]];

axes = {ax1[[1]], Scale[Translate[ax2[[1]], {.5, 0}], {1/2, 1}], 
   Scale[Translate[ax3[[1]], {4, 0}], {1/2, 1}]};

Graphics[axes, ImageSize -> 700]

Mathematica graphics

Then combine all three plots in a single ParametricPlot, add the needed embellishments using Epilog, and use Show to overlay with the previously constructed axes:

Animate[Show[ParametricPlot[{{Cos[t], Sin[t]}, {-Sin[t], Cos[t]}, 
   {3 t/2/Pi + 2, Sin[t]}, {3 t/2/Pi + 5.5, Cos[t]}}, {t, 0, n}, 
   PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}, 
   PlotStyle -> {{Blue, AbsoluteThickness[6]}, {Green, AbsoluteThickness[3]}, Red, Red}, 
   Prolog -> {Opacity[3], Circle[]}, Axes -> False, 
   Epilog -> {{Dotted, Line[{{Cos[n], 0}, {Cos[n], Sin[n]}}]}, 
     {Dotted, Line[{{-Sin[n], 0}, {-Sin[n], Cos[n]}}]}, 
     {Opacity[0.5], Line[{{0, 0}, {-Sin[n], Cos[n]}}]}, 
     {Red, AbsolutePointSize[5], Point[{-Sin[n], Cos[n]}]}, 
     {Opacity[0.5], Line[{{0, 0}, {Cos[n], Sin[n]}}]}, 
     {Red, AbsolutePointSize[5], Point[{Cos[n], Sin[n]}]},
     {Cyan, Thin, Dashed, Arrowheads[Medium], 
       Arrow[{{Cos[n], Sin[n]}, {3 n/2/Pi + 2, Sin[n]}}]},
     {Purple, Thin, Dashed, Arrowheads[Medium], 
       Arrow[{{-Sin[n], Cos[n]}, {3 n/2/Pi + 5.5, Cos[n]}}]},
     {Blue, AbsoluteThickness[3], Line[{{2, 0}, {3 n/2/Pi + 2, 0}}]},
     {Red, AbsolutePointSize[5], Point[{3 n/2/Pi + 2, Sin[n]}]},
     {Dotted, Line[{{3 n/2/Pi + 2, 0}, {3 n/2/Pi + 2, Sin[n]}}]}, 
     {Green, AbsoluteThickness[3], Line[{{5.5, 0}, {3 n/2/Pi + 5.5, 0}}]},
     {Red, AbsolutePointSize[5], Point[{3 n/2/Pi + 5.5, Cos[n]}]},
     {Dotted, Line[{{3 n/2/Pi + 5.5, 0}, {3 n/2/Pi + 5.5, Cos[n]}}]}}], 
  Graphics[axes], PlotRange -> All, AspectRatio -> Automatic, 
  ImageSize -> 900], {n, .0001, 2 Pi}, AnimationRunning -> False]

enter image description here

Note: All this works without error messages in Version 9.0.1.0 on Windows 8 (64 bit). For version 10, you can suppress the error messages using Quiet@FullGraphics[...] in the first code block above.

Improve this answer
$\endgroup$
5
  • $\begingroup$ I must be doing something silly here. Did you assign a value to n before evaluating your axes definitions? Cause nothing seems to work on my end otherwise. $\endgroup$
    – MarcoB
    Commented May 14, 2015 at 0:20
  • $\begingroup$ @MarcoB, thank you!! I will fix it in a moment. Btw, any value for n would do to create the fake axes. $\endgroup$
    – kglr
    Commented May 14, 2015 at 0:26
  • $\begingroup$ No problem. I realized that I could just give n any old value before evaluation, then Animate would take care of reassigning it anyway. Glad I wasn't going crazy there though ;-) And very cool solution! (+1) $\endgroup$
    – MarcoB
    Commented May 14, 2015 at 0:27
  • $\begingroup$ Hmm, for whatever reason, I'm getting a slew of errors involving tick and axis specifications. I suspect this has to do with the use of FullGraphics, but perhaps you are using a newer/older version of Mathematica? I'm currently in 10.0. In any case, the animation itself works perfectly! $\endgroup$
    – user170231
    Commented May 14, 2015 at 2:55
  • $\begingroup$ @user170231, I am using version 9.01.10 on Windows 8 (64-bit). I don't have Version 10; and the free Cloud version that I am using does not allow animations. Changing Animate to Manipulate and suppressing the messages using Quiet@FullGraphics[...] seems to work. Thank you for the accept. $\endgroup$
    – kglr
    Commented May 14, 2015 at 8:54
6
$\begingroup$

Just for fun. This could made much more concise but I am time poor:

Manipulate[
 ParametricPlot[{{Cos[t], Sin[t]}, {1, 0} + {t, Sin[t]}, {Cos[t], 
    t}}, {t, 0, 2 Pi}, PlotRange -> {{-1.5, 2 Pi + 1}, {-1.5, 2 Pi}}, 
  Epilog -> {EdgeForm[Black], Yellow, Disk[{Cos[p], Sin[p]}, 0.1], 
    Disk[{p, Sin[p]} + {1, 0}, 0.1], Disk[{Cos[p], p}, 0.1], Black, 
    Line[{{Cos[p], Sin[p]}, {1, 0} + {p, Sin[p]}}], 
    Line[{{Cos[p], Sin[p]}, {Cos[p], p}}]}, 
  PlotStyle -> {Red, Darker[Green], Blue}, Frame -> True], {p, 0.01, 
  2 Pi}]

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.