14
$\begingroup$

I'm new here and have never interacted with the community so excuse me if this has been asked before or if I format incorrectly or anything like that.

Anyway, I'm trying to make an animation for a pulsed NMR lab experiment and have never made a Mathematica animation before. My end goal is to have an arrow graphic initially in the z-direction with a button that simulates the effect of a π/2 pulse, tipping the arrow into the xy-plane and then allowing the arrow to spiral its way back to its initial +z orientation, qualitatively showing the Spin-Lattice relaxation in NMR. I have the path I would like the arrow to follow in a static graphic but would like to add the interactive animation and Im lost as to where to even begin. In the end I would like to make animations on my own so any sources or advice on how to make them would be greatly appreciated.

Here is what I'm working with right now.

Show[
  ParametricPlot3D[
    {Sin[u] Sin[v], Cos[u] Sin[v], Cos[v]}, {u, -π, π}, {v, -π, π},
    MaxRecursion -> 4,
    PlotPoints -> 80,
    PlotStyle -> {Specularity[1, 20], Opacity[0.1]},
    Axes -> None,
    Boxed -> False,
    Mesh -> 3],
  ParametricPlot3D[
    {Cos[2 π ω]/Cosh[Cot[π/4] ω], Sin[2 π ω]/Cosh[Cot[π/4] ω], Tanh[Cot[π/4] ω]}, 
    {ω, 0, 2 Pi},
    PlotStyle -> {Red, Thick}], 
  Graphics3D[{Red, Arrowheads[0.05], Arrow[Tube[{{0, 0, 0}, {0, 0, 1}}, 0.01]]}]]

Edit: Taking from other sources I have got to this point:

curve[t_] := 
  {Cos[2 π t]/Cosh[Cot[π/4] t], Sin[2 π t]/Cosh[Cot[π/4] t], Tanh[Cot[π/4] t]};
sphere = 
  Show[
    {Graphics3D[{Opacity[0.3], Sphere[{0, 0, 0}, 1]}],
    ParametricPlot3D[curve[t], {t, 0, 1.5*Pi}, 
      PlotRange -> {-1, 1}, PlotStyle -> {Thick, Red}]}];
imglist = 
  Table[
    Show[
      {sphere, 
       Graphics3D@{Red, PointSize[Large], 
       Sphere[curve[tt], 0.1]}}], 
    {tt, 0, 1.5*Pi, 0.1}];
ListAnimate[imglist]

I would still like the arrow with arrowhead following the ball path and an button to initiate the tipping of the arrow from +z into the xy-plane and beginning the animation I have so far, thanks!

$\endgroup$
  • $\begingroup$ Closely related: this answer $\endgroup$ – Jens May 22 '16 at 2:05
  • $\begingroup$ In my modification of your code, I've just used the play button to do the initialization. That means I simply added an initial frame in which the vector points up. $\endgroup$ – Jens May 22 '16 at 2:35
20
$\begingroup$

Here is a simple modification of the original code in the question that seems to do what's desired:

curve[t_] := {Cos[2 Pi*t]/Cosh[Cot[Pi/4]*t], 
   Sin[2 Pi*t]/Cosh[Cot[Pi/4]*t], Tanh[Cot[Pi/4]*t]};
lineSegment[t_] := 
  ParametricPlot3D[curve[t1], {t1, -0.001, t}, PlotRange -> {-1, 1}, 
   PlotStyle -> {Thick, Red}];
sphere = With[{w = 1.2},
   Show[{Graphics3D[{Opacity[0.3], Sphere[{0, 0, 0}, 1]}]}, 
    PlotRange -> {{-w, w}, {-w, w}, {-w, w}}]];
initialFrame = 
  Show[{sphere, 
    Graphics3D@{Blue, Arrow@Tube[{{0, 0, 0}, {0, 0, 1}}], Red, 
      Sphere[{0, 0, 1}, 0.1]}}];
scene[tt_] := 
  Show[{sphere, lineSegment[tt], 
    Graphics3D@{Blue, Arrow@Tube[{{0, 0, 0}, curve[tt]}], Red, 
      Sphere[curve[tt], 0.1]}}];
imglist = 
  Rasterize[#, "Image", ImageResolution -> 72] & /@ 
   Prepend[Table[scene[tt], {tt, 0, 1.5*Pi, 0.1}], initialFrame];

ListAnimate[imglist, AnimationRunning -> False, 
 AnimationRepetitions -> 1, DefaultDuration -> 2]

sphere

I added an initial frame with the vector pointing up, and let the play button serve as the "start" of the sequence. The animation is sped up by rasterizing the frames before displaying them as frames.

$\endgroup$
18
$\begingroup$

Below is an animation that tips a proton precessing in the presence of a static B0 magnetic field from the z direction into the x-y plane with a 90 degree B1 pulse and attempts to explain the rotating frame.

Unfortunately it is way too long to put into an answer but I have uploaded the notebook using Halirutan's SE Uploader tool.

The notebook was built for Mathematica 10.

Import["http://goo.gl/NaH6rM"]["http://i.stack.imgur.com/ASuBv.png"]

Open up a fresh notebook and copy and paste the above command. It should fill the blank notebook with the code to produce the Manipulate below.

Mathematica graphics

In the notebook there are many user defined functions and static data defined that are used in the Manipulate.

In the notebook all of the functions and data are in initialization cells before the Manipulate is invoked.

Try using the checkboxes to put yourself in the rotating frame, having B1 turned on or off and having an observer on a merry-go-round that rotates at the same angular frequency as the precessing proton.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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