14

When doing presentation with Mathematica, I often want a 3D plot to rotate automatically, so the 3D feeling is stronger. I don't want to drag the mouse every time.

So, I want a general function like

autoRotate["3D graphics here"]

The out put is a rotating version, and I can stop/start the rotation by click a control.

Question: How can I implement this function efficiently so the rotation is as smooth as possible?

Here is my first try: Get viewpoint and compute the rotation matrix;

g = Plot3D[Sin[x y], {x, 0, 3}, {y, 0, 3}];
vc = AbsoluteOptions[g, ViewCenter][[1, 2]];
vp = AbsoluteOptions[g, ViewPoint][[1, 2]];
m = RotationMatrix[3 Degree, {0., 0., 1.}];
newvp = m.(vp - vc);

then manipulate:

Manipulate[If[start, newvp = m.newvp]; 
 Show[g, ViewPoint -> Dynamic[newvp + vc], 
  SphericalRegion -> True ], {start, {False, True }}]

This seems slow and I lose the ability to zoom/rotate the plot manually.

Second try:

DynamicModule[{}, 
   Show[g, ViewPoint -> 
   Dynamic[newvp = m.newvp; newvp + vc, UpdateInterval -> 1.], 
  SphericalRegion -> True ]]

This seems faster, but I can't control the refreshrate. UpdateInterval ->1 seems to lose effect and I also can't zoom/rotate the plot manually.

Update: Based on Rojo's idea and Silvia's comment, here is what I currently use:

autoRotate[gr_Graphics3D, rate_: 7] := 
 DynamicModule[{vp, va, vv, vc }, {vp, va, vv, vc} = 
   gr~AbsoluteOptions~#~OptionValue~# &@{ViewPoint, ViewAngle, 
     ViewVertical, ViewCenter};
  Overlay[{Show[Graphics3D[], ViewPoint -> Dynamic[vp],
     ViewAngle -> Dynamic[va], SphericalRegion -> True], 
    Show[gr, SphericalRegion -> True, 
     ViewPoint -> Dynamic[RotationMatrix[Clock[2 \[Pi], rate], vv].vp],
     ViewAngle -> Dynamic[va], Boxed -> False , Axes -> False]}, All, 
   1]]
J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
kptnw
  • 1,406
  • 8
  • 15
  • Boxed -> False, Axes -> False will make things smoother, presuming you don't need to display the axes. It won't allow you to manually control the rotation, however. – DavidC Dec 25 '13 at 15:19
  • I think this is a dupe... searching... – Yves Klett Dec 25 '13 at 15:32
  • 1
    Ahhh... possible duplicate of http://mathematica.stackexchange.com/questions/3759/autorotating-3d-plots – Yves Klett Dec 25 '13 at 16:40
  • @YvesKlett I think it's not an exact dupe, as OP here ask for being able to manipulate the graphics manually while it's rotating automatically. – Silvia Dec 25 '13 at 17:03
  • @Silvia you are right. I did not vote to close because of that... Only got my smartphone to browse right now which is ineffective (and too much cake does not help, too) (^_-) – Yves Klett Dec 25 '13 at 18:50
  • @YvesKlett I would like to have some helpless cakes too, maybe a month later when the Chinese new year :) – Silvia Dec 25 '13 at 18:55
  • autoRotate works very well for me. I do not know how to modify it to produce an animated gif from it. Can you please help? – wdacda Apr 28 '17 at 00:30
  • I figured it out; it is not difficult. I just needed to understand that Clock[2 Pi, rate] rotates the graph. This is very nice code. Thank you very much for asking and posting the final code. – wdacda Apr 28 '17 at 02:25

3 Answers3

18

In case this is not a dupe, perhaps this is a starting point.

autoRotate[gr_Graphics3D, rate_: 5] := 
 gr~AbsoluteOptions~#~OptionValue~# &[
   {ViewPoint, ViewVertical}] /. {vp_, vv_} :>
   Show[gr, SphericalRegion -> True, 
    ViewPoint -> Dynamic[RotationMatrix[Clock[2 \[Pi], rate], vv].vp]
    ]

EDIT

Given what I am reading, that manual and automatic interaction are required, perhaps a less hopeless starting point is the following

autoRotate[gr_Graphics3D, rate_: 5] := DynamicModule[{vp, va, vv, vc},
  {vp, va, vv, vc} = gr~AbsoluteOptions~#~OptionValue~# &@
    {ViewPoint, ViewAngle, ViewVertical, ViewCenter};
  Overlay[{
    Show[gr, SphericalRegion -> True,
     ViewPoint -> Dynamic[vp],
     ViewAngle -> Dynamic[va],
     ViewVertical -> Dynamic[vv],
     ViewCenter -> Dynamic[vc]
     ],
    Show[gr, SphericalRegion -> True,
     ViewPoint -> Dynamic[RotationMatrix[Clock[2 \[Pi], rate], vv].vp],
     ViewAngle -> Dynamic[va],
     ViewVertical -> Dynamic[vv],
     ViewCenter -> Dynamic[vc]
     ]
    }, All, 1]
  ]
Rojo
  • 42,601
  • 7
  • 96
  • 188
  • 2
    This is as great as the last one! May I call you a true Overlay-master! – Silvia Dec 25 '13 at 18:36
  • 2
    @Silvia That would not be overlay exaggerated. – Yves Klett Dec 25 '13 at 18:57
  • And I suggest changing the Show[gr, ...] on the first overlay to Show[Graphics3D[], ...], which might give a smoother performance. – Silvia Dec 25 '13 at 19:03
  • Your autoRotate function works out of the box for a lingering question of mine from a while back. +1 – bobthechemist Dec 27 '13 at 12:41
  • @bobthechemist I'm glad it helped you too. This can be greatly improved, it is meant as a start. Anyone feel free to build up, edit, or do as you please – Rojo Dec 27 '13 at 12:43
  • Just for anyone wondering, I receive errors for the first definition reported that are cleared up in using the second definition in the "Edit." Thanks, Rojo! – Ghersic Jul 25 '15 at 21:20
  • When using GraphicsRow with autoRotate/@{Show[graphic1], Show[graphic2]} this overlays the rotating image a copy of the image not rotating. It's unclear to me why this would happen only when GraphicsRow or GraphicsGrid is used. Any idea on how to eliminate the excess, non-rotating copy when within those functions? (This is in Mathematica 10.1.0.) – Ghersic Jul 25 '15 at 22:00
  • You can fix this by removing the former Show[~] and then the enclosing Overlay[~, All, 1], but then the "Tag Dot in {{...}} is Protected" errors referred to earlier return. They occur in the Messages window, not the notebook itself. Any ideas on how to rectify the issue without those errors? – Ghersic Jul 26 '15 at 00:12
  • Ah, said errors only occur upon interaction with the mouse, it seems. – Ghersic Jul 26 '15 at 00:27
  • This is amazing. Is it possible to have a view saved as AVI or animated GIF? – quantum May 30 '18 at 08:04
6

Another way by GeometricTransformation:

g = Plot3D[Sin[x y], {x, 0, 3}, {y, 0, 3},
           PlotRange -> {{-1, 4}, {-1, 4}, Automatic},
           SphericalRegion -> True]

center = Mean /@ (PlotRange /. AbsoluteOptions[g, PlotRange])

DynamicModule[{θ},
              DynamicWrapper[
                             MapAt[
                                   GeometricTransformation[#,
                                     RotationTransform[Dynamic[θ], {0, 0, 1}, center ]
                                     ] &,
                                   g, 1],
                             θ = Clock[{0, 2 π, .01}, 10]
                            ]]
Silvia
  • 27,556
  • 3
  • 84
  • 164
4

I'll join the fun. Here is one with Manipulate. Just a proof of concept ofcourse.

enter image description here

Manipulate[
 tick;
 theta = Mod[theta + step, 360 Degree];
 If[state == "running", tick += del];

 Grid[{
   {Row[{AccountingForm[theta*180/Pi, {5, 2}, 
       NumberPadding -> {"0", "0"}, NumberSigns -> {"", ""}], 
      Degree}]},
   {Graphics3D[
     Rotate[g[[1]], theta, {0, 1, 0}, {0, 0 , 1}],
     SphericalRegion -> True, Axes -> False, Boxed -> False, 
     ViewVertical -> {0, 0, 1}, ViewAngle -> zoom, 
     ViewPoint -> {.5, .5, .7}, 
     PlotRange -> {{-8, 8}, {-3, 3}, {-4, 4 }}, 
     AxesLabel -> {"x", "y", "z"}, ImageSize -> {400}, 
     ImageMargins -> 1, ImagePadding -> 1]
    }
   }],
 Grid[{
   {Grid[{
      {Button[Text[Style["run", 12]], state = "running"; tick += del, 
        ImageSize -> {80, 35}], 
       Button[Text[Style["step", 12]], state = "step"; tick += del, 
        ImageSize -> {80, 35}]}
      }
     ]
    ,
    Grid[{
      {"slow", 
       Manipulator[
        Dynamic[step, {step = #; tick += del} &], {0.001, 1, 0.001}, 
        ImageSize -> Medium, ContinuousAction -> True], "fast", 
       SpanFromLeft},
      {"zoom", 
       Manipulator[
        Dynamic[zoom, {zoom = #; tick += del} &], {0.001, 1, 0.001}, 
        ImageSize -> Medium, ContinuousAction -> True], "out", 
       SpanFromLeft}
      }, Alignment -> Left]}
   }]
 ,
 {{tick, 0}, None},
 {{del, $MachineEpsilon}, None},
 {{step, 0.04}, None},
 {{zoom, 0.01}, None},
 {{state, "reset"}, None},
 {{t, 0}, None},
 {{phi, 0}, None},
 {{theta, 0}, None},
 ContinuousAction -> True,
 Alignment -> Center,
 ImageMargins -> 5,
 FrameMargins -> 5,
 Paneled -> True,
 Frame -> False,
 ControlPlacement -> Top,
 TrackedSymbols :> {tick},
 Initialization :> 
  (
   g = Plot3D[Sin[x y], {x, 0, 3}, {y, 0, 3}]
   )
 ]
Nasser
  • 143,286
  • 11
  • 154
  • 359