3
$\begingroup$

I am working on some code that allows me to auto-rotate graphics (including ParmetricPlot3D and Plot3D graphics) objects while preserving mouse dragging in a smooth fashion. It works great.

enter image description here

The code below includes three different types of graphics objects (Graphics3D, ParametricPlot3D, and Plot3D), but I have more types to implement. I should be able to Map the single geometric transformation over the list but can't figure it out. Independently it works fine and the code is repetitive. Seems like I should be able to condense but I'm not able.

You can see the repetition three times in the code below.

Manipulate[Show[
  
  Map[(GeometricTransformation[#, 
      RotationTransform[Dynamic[\[Theta]], {0, 0, 1}, center]] &), 
   Graphics3D[{Arrow[Tube[{{-3.75, 0, 0}, {3.75, 0, 0}}, .01]], 
     Arrow[Tube[{{0, -3.75, 0}, {0, 3.75, 0}}, .01]], 
     Arrow[Tube[{{0, 0, -3.75}, {0, 0, 3.75}}, .01]]}]],
  
  Map[GeometricTransformation[#, 
     RotationTransform[Dynamic[\[Theta]], {0, 0, 1}, center]] &, 
   ParametricPlot3D[{u, v, v^2}, {u, -4, 4}, {v, -4, 4}]],
  
  Map[GeometricTransformation[#, 
     RotationTransform[Dynamic[\[Theta]], {0, 0, 1}, center]] &, 
   Plot3D[x^2 + y^2, {x, -4, 4}, {y, -4, 4}]],
  
  PlotRange -> 4, SphericalRegion -> True], {\[Theta], 0, 2 Pi, 
  ControlType -> Animator, AnimationRate -> .03}, 
 Initialization :> {center = 
    Mean /@ (PlotRange /. 
       AbsoluteOptions[
        Graphics3D[{Arrow[Tube[{{-3.75, 0, 0}, {3.75, 0, 0}}, .01]], 
          Arrow[Tube[{{0, -3.75, 0}, {0, 3.75, 0}}, .01]], 
          Arrow[Tube[{{0, 0, -3.75}, {0, 0, 3.75}}, .01]]}], 
        PlotRange])}]

As you can see I have mapped the GeometricTransformation over Graphics3D and ParametricPlot3D and Plot3D independently which I believe is overkill. I have more types to plot as well. I would like to call the Map function only once for all graphics objects.

I tried using Map to push through the list of graphics objects it doesn't seem to work. I've also tried, MapThread, MapApply, Apply, etc.

It's probably a very simple solution, but it escapes me. Any ideas?

Improve this question
$\endgroup$
0

1 Answer 1

Reset to default
3
$\begingroup$ 
gr = {Graphics3D[{Arrow[Tube[{{-3.75, 0, 0}, {3.75, 0, 0}}, .01]], 
     Arrow[Tube[{{0, -3.75, 0}, {0, 3.75, 0}}, .01]], 
     Arrow[Tube[{{0, 0, -3.75}, {0, 0, 3.75}}, .01]]}], 
   Graphics3D[{Cube[{1, 0, 0}, 1]}], 
   Plot3D[x^2 + y^2, {x, -4, 4}, {y, -4, 4}], 
   ParametricPlot3D[{u, v, v^2}, {u, -4, 4}, {v, -4, 4}]};

Manipulate[
 Show[(g |-> 
     Map[(GeometricTransformation[#, 
         RotationTransform[Dynamic[\[Theta]], {0, 0, 1}, center]] &), 
      g]) /@ gr, PlotRange -> 4, SphericalRegion -> True], {\[Theta], 
  0, 2 Pi, ControlType -> Animator, AnimationRate -> .03}, 
 Initialization :> {center = 
     Mean /@ (PlotRange /. 
        AbsoluteOptions[
         Graphics3D[{Arrow[Tube[{{-3.75, 0, 0}, {3.75, 0, 0}}, .01]], 
           Arrow[Tube[{{0, -3.75, 0}, {0, 3.75, 0}}, .01]], 
           Arrow[Tube[{{0, 0, -3.75}, {0, 0, 3.75}}, .01]]}], 
         PlotRange]);}]
Improve this answer
$\endgroup$
5
  • $\begingroup$ Thank you. I'm sorry I should have been more clear. My issue is that I have a number of different graphics objects, like Plot3D, and ParametricPlot3D (not all Graphics3D) I can't figure out how to combine them into your gr variable. I'll update the question to pinpoint my issue. $\endgroup$
    – B flat
    Commented Nov 30, 2022 at 23:09
  • $\begingroup$ I updated my answer. $\endgroup$
    – azerbajdzan
    Commented Nov 30, 2022 at 23:23
  • $\begingroup$ hmmmm. I am missing something. : ( Where can include a Plot3D, ParmetricPlot3D, RevolutionPlot3D, etc? I see how you are combining Graphics3D objects. But not sure how to incorporate the 3D graphics functions mentioned. Show[] doesn't work. I've only been able to map the transformations of these functions on an individual basis, yet the code is the same for all of them. Seems like I should be able to condense the code. You can see the repetition in my updated post. $\endgroup$
    – B flat
    Commented Nov 30, 2022 at 23:33
  • 1
    $\begingroup$ Did you test my last update? $\endgroup$
    – azerbajdzan
    Commented Nov 30, 2022 at 23:35
  • $\begingroup$ I did not know you can do that. Enlightening! TY $\endgroup$
    – B flat
    Commented Nov 30, 2022 at 23:39

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.