MathGroup Archive 2005

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Mathematical Experiments

  • To: mathgroup at smc.vnet.net
  • Subject: [mg54802] Re: [mg54777] Mathematical Experiments
  • From: "David Park" <djmp at earthlink.net>
  • Date: Wed, 2 Mar 2005 01:26:48 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

Daniel,

Very interesting but what is it?

In any case, you could improve on the plots. First, you don't have to keep
reading in the packages. Next, in order to obtain a smooth animation you
should have the same PlotRange for all frames of the animation. This means
you must specify PlotRange in the plot statement. Otherwise Mathematica
picks the PlotRange it thinks is best for each frame.

Below I have redone your plots. I added a colored background and code at the
end of each animation that automatically selects the frame cells, closes
them and starts the animation. I also put a colored background, got rid of
the axes and subdued the bounding box.

The last animation appeared to have overlapping surfaces. This greatly slows
the rendering of the plots. I changed the u range to stop the overlapping
but that may not be what you want.


<< Graphics`Animation`
<< Graphics`ParametricPlot3D`
<< Graphics`Colors`

Animate[ParametricPlot3D[{(Log[Tan[v/2]] + t)*Cos[u]*Sin[v],
    (Log[Tan[v/2]] + t)*Sin[u]*Sin[v], (Log[Tan[v/2]] + t)*Cos[v]},
   {u, -Pi, Pi, Pi/30}, {v, Pi/6, Pi/3, Pi/30},
   PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}}*0.1, Axes -> False,
   BoxStyle -> Gray, Background -> Linen, ImageSize -> 500], {t, -(Pi/8),
Pi/2},
  Frames -> 42]
SelectionMove[EvaluationNotebook[], All, GeneratedCell]
FrontEndTokenExecute["OpenCloseGroup"]; Pause[0.5];
FrontEndExecute[{FrontEnd`SelectionAnimate[200, AnimationDisplayTime -> 0.1,
    AnimationDirection -> ForwardBackward]}]

Animate[ParametricPlot3D[{(u + t)*Cos[u]*Sin[v], (u + t + 1)*Sin[u]*Sin[v],
    (u + t)*Cos[v]}, {u, -Pi, Pi, Pi/30}, {v, Pi/6, Pi/3, Pi/30},
   PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}}*0.8, Axes -> False,
   BoxStyle -> Gray, Background -> Linen, ImageSize -> 500], {t, -Pi,
(4*Pi)/2}]
SelectionMove[EvaluationNotebook[], All, GeneratedCell]
FrontEndTokenExecute["OpenCloseGroup"]; Pause[0.5];
FrontEndExecute[{FrontEnd`SelectionAnimate[200, AnimationDisplayTime -> 0.1,
    AnimationDirection -> ForwardBackward]}]

Animate[ParametricPlot3D[{(2*u*Log[Tan[v/2]] + t)*Cos[u]*Sin[v],
    (2*u*Log[Tan[v/2]] + t)*Sin[u]*Sin[v], (2*u*Log[Tan[v/2]] + t)*Cos[v]},
   {u, -Pi, Pi, Pi/20}, {v, Pi/3, Pi/2, Pi/20},
   PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}}*1.5, Axes -> False,
   BoxStyle -> Gray, Background -> Linen, ImageSize -> 500], {t, -4*Pi,
(4*Pi)/2},
  Frames -> 41]
SelectionMove[EvaluationNotebook[], All, GeneratedCell]
FrontEndTokenExecute["OpenCloseGroup"]; Pause[0.5];
FrontEndExecute[{FrontEnd`SelectionAnimate[200, AnimationDisplayTime -> 0.1,
    AnimationDirection -> ForwardBackward]}]

Animate[ParametricPlot3D[{(u^2 - Log[2*Tan[v/2]] + t)*Cos[u]*Sin[v],
    (u^2 - Log[2*Tan[v/2]] + t)*Sin[u]*Sin[v], (u^2 - Log[2*Tan[v/2]] +
t)*Cos[v]},
   {u, -Pi, Pi, Pi/30}, {v, Pi/4, Pi/2, Pi/30},
   PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}}*1.5, Axes -> False,
   BoxStyle -> Gray, Background -> Linen, ImageSize -> 500], {t, -4*Pi,
4*Pi}]
SelectionMove[EvaluationNotebook[], All, GeneratedCell]
FrontEndTokenExecute["OpenCloseGroup"]; Pause[0.5];
FrontEndExecute[{FrontEnd`SelectionAnimate[200, AnimationDisplayTime -> 0.1,
    AnimationDirection -> ForwardBackward]}]


Animate[ParametricPlot3D[{(u^3 - 3*u*Log[2*Tan[v/2]] + t)*Cos[u]*Sin[v],
    (u^3 - 3*u*Log[2*Tan[v/2]] + t)*Sin[u]*Sin[v], (u^3 -
3*u*Log[2*Tan[v/2]] + t)*
     Cos[v]}, {u, -Pi, Pi, Pi/30}, {v, Pi/4, Pi/2, Pi/30},
   PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}}*2, Axes -> False,
BoxStyle -> Gray,
   Background -> Linen, ImageSize -> 500], {t, -4*Pi, 4*Pi}]
SelectionMove[EvaluationNotebook[], All, GeneratedCell]
FrontEndTokenExecute["OpenCloseGroup"]; Pause[0.5];
FrontEndExecute[{FrontEnd`SelectionAnimate[200, AnimationDisplayTime -> 0.1,
    AnimationDirection -> ForwardBackward]}]

Animate[ParametricPlot3D[{(3*u^2*Log[2*Tan[v/2]] - Log[3*Tan[v/2]] +
t)*Cos[u]*
     Sin[v], (3*u^2*Log[2*Tan[v/2]] - Log[3*Tan[v/2]] + t)*Sin[u]*Sin[v],
    (3*u^2*Log[2*Tan[v/2]] - Log[3*Tan[v/2]] + t)*Cos[v]}, {u, -Pi/2, Pi,
Pi/30},
   {v, Pi/3, Pi/2, Pi/30}, PlotRange -> {{-10, 10}, {-10, 10}, {-10, 10}}*2,
   Axes -> False, BoxStyle -> Gray, Background -> Linen, ImageSize -> 500],
  {t, -4*Pi, 4*Pi}]
SelectionMove[EvaluationNotebook[], All, GeneratedCell]
FrontEndTokenExecute["OpenCloseGroup"]; Pause[0.5];
FrontEndExecute[{FrontEnd`SelectionAnimate[200, AnimationDisplayTime -> 0.1,
    AnimationDirection -> ForwardBackward]}]

David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/



From: Daniel Alayon Solarz [mailto:danieldaniel at gmail.com]
To: mathgroup at smc.vnet.net

I just wanted to share some minor graphical applications that came
along with my research.  Try tweaking parameters and see what happens. Here
are
showed the 6 solutions of order 1,2,3. The other 6 are anti-solutions,
is possible to figure out how to construct them. Enjoy.

<< Graphics`Animation`
<< Graphics`ParametricPlot3D`
Animate[ParametricPlot3D[{(Log[Tan[v/2]] + t)*
       Cos[u] Sin[v], (Log[Tan[v/2]] + t)*Sin[u] Sin[v],
(Log[Tan[v/2]] + t)*
       Cos[v]}, {u, -Pi, Pi, Pi/30}, {v, Pi/6, Pi/3, Pi/30}], {t,
-Pi/8,
   Pi/2}]

<< Graphics`Animation`
<< Graphics`ParametricPlot3D`
Animate[ParametricPlot3D[{(u + t)*Cos[u] Sin[v], (u + t + 1)*
       Sin[u] Sin[v], (u + t)*Cos[v]}, {u, -Pi, Pi, Pi/30}, {v, Pi/6,
Pi/3,
     Pi/30}], {t, -Pi, 4Pi/2}]

<< Graphics`Animation`
Animate[ParametricPlot3D[{(2u*Log[Tan[v/2]] + t)*
       Cos[u] Sin[v], (2u*Log[Tan[v/2]] + t)*
       Sin[u] Sin[v], (2u*Log[Tan[v/2]] + t)*Cos[v]}, {u, -Pi, Pi,
     Pi/20}, {v, Pi/3, Pi/2, Pi/20}], {t, -4Pi, 4Pi/2}]

<< Graphics`Animation`
Animate[ParametricPlot3D[{(u^ 2 - Log[2Tan[v/2]] + t)*
       Cos[u] Sin[v], (u^2 - Log[2Tan[v/2]] + t)*
       Sin[u] Sin[v], (u^2 - Log[2Tan[v/2]] + t)*Cos[v]}, {u, -Pi,
Pi,
     Pi/30}, {v, Pi/4, Pi/2, Pi/30}], {t, -4Pi, 4Pi}]

<< Graphics`Animation`
Animate[ParametricPlot3D[{(u^ 3 - 3u*Log[2Tan[v/2]] + t)*
       Cos[u] Sin[v], (u^ 3 - 3u*Log[2Tan[v/2]] + t)*
       Sin[u] Sin[v], (u^ 3 - 3u*Log[2Tan[v/2]] + t)*Cos[v]}, {u,
-Pi, Pi,
     Pi/30}, {v, Pi/4, Pi/2, Pi/30}], {t, -4Pi, 4Pi}]

<< Graphics`Animation`
Animate[ParametricPlot3D[{(3u^ 2*Log[2Tan[v/2]] - Log[3Tan[v/2]] + t)*
       Cos[u] Sin[v], (3u^ 2*Log[2Tan[v/2]] - Log[3Tan[v/2]] + t)*
       Sin[u] Sin[v], (3u^ 2*Log[2Tan[v/2]] - Log[3Tan[v/2]] + t)*
       Cos[v]}, {u, -Pi, Pi, Pi/30}, {v, Pi/3, Pi/2, Pi/30}], {t,
-4Pi, 4Pi}]

Regards
Daniel




  • Prev by Date: Re: Re: Bug in Import?
  • Next by Date: Re: Yukawa
  • Previous by thread: Re: Mathematical Experiments
  • Next by thread: New in 5.1.1?