1
$\begingroup$

I have a system of parametric equations

s0 = {t0, 0. +2. Sin[θ] Sin[ϕ]-1. (0.5 t0+0.5 Sin[θ] Sin[ϕ]), 
4. (0. +0.25 Cos[θ] Sin[ϕ]), 1. Cos[ϕ]}

If I plot them thus, with a set value of t0, e.g. t0=0

ParametricPlot3D[{ s0[[2]], s0[[3]], s0[[4]]}, {θ, 0, 
  2 Pi}, {ϕ, -1 Pi, Pi}, Axes -> True, 
 AxesLabel -> {"x", "y", "z"}, LabelStyle -> Directive[Large] , 
 TicksStyle -> Directive[Medium], AxesOrigin -> Automatic, 
 PlotStyle -> Directive[Opacity[0.6]], 
 AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
 ViewVertical -> {0, 0, 1}, ViewPoint -> Front]

everything is fine.

If I then wrap the plot with Manipulate, where mint and maxt provide calculated limits and t0 is the manipulated variable

Manipulate[
 ParametricPlot3D[{ s0[[2]], s0[[3]], s0[[4]]}, {θ, 0, 
   2 Pi}, {ϕ, -1 Pi, Pi}, Axes -> True, 
  AxesLabel -> {"x", "y", "z"}, LabelStyle -> Directive[Large] , 
  TicksStyle -> Directive[Medium], AxesOrigin -> Automatic, 
  PlotStyle -> Directive[Opacity[0.6]], 
  AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
  ViewVertical -> {0, 0, 1}, ViewPoint -> Front], {t0, 1.1*mint, 
  1.1*maxt}]

I receive part spec "longer than depth of object" for each of S0[2]...s0[[4]].

Main question: since it doesn't work, what am I doing wrong, and what should I have done? (why?)

Bonus: if I also use PlotStyle -> Directive[Opacity[0.5]] in the plot

simple shere with uneven shading due to opacity

then the shading clearly shows uneveness and the lines are a bit jaggy too: how can the quality of the rendering be improved. Hope this is nice and easy for someone to answer...

PS I am amazed by the knowledge and willingness to help of the contributors here, unfortunately don't have enough rep yet to be able to upvote some of the other answers I have made use of, e.g. Mr Wizard's reorder function, but I am really glad & grateful for all this.

Update

@Chenminqi's solution works in isolation, but not in the context of my own code which is: (notes at end. NB I'm sure you will find this ugly and/or clumsy but I've only been using Mma for a few days)

Block[{setMagV, setVx, setVy, setVz, magv, v, vx, vy, vz, t, t1, t0, s0, s1, 
θ, ϕ, γ, originPrimeFrame, 
  rearrangement, solns, mint, maxt, temp, spacetimePlot, pic},
 setMagV = 0.5; setVx = setMagV; setVy = setVz = 0;
  v = {vx, vy, vz};
 originPrimeFrame = {t1, 0, 0, 0};
 s0 = Simplify[
   LorentzF[v].spatialShell[
     originPrimeFrame, θ, ϕ]]; (* sphere in primed frame, \
xformed to unprimed *)
 γ = 1/Sqrt[v.v]; (* replace gamma with vx, vy, vz *)
 (* Print["Raw transformed sphere"]; \
Print[Reorder[MatrixForm@s0,srOrder]]; Print["s0[[1]] = ", s0[[1]]];*)
vx = setVx; vy = setVy; vz = setVz; 
 t1 = 0; (* assign values so  we can determine min and max t in \
unprimed frame*)
 mint = Minimize[{s0[[1]], 
     0 <= θ < 2 Pi, -Pi <= ϕ < Pi}, {θ, ϕ}, 
    Reals][[1]]; 
 maxt = Maximize[{s0[[1]], 
     0 <= θ < 2 Pi, -Pi <= ϕ < Pi}, {θ, ϕ}, 
    Reals][[1]];
 (*Print["t0 minimum = ", mint,"t0 maximum = ", maxt];*)
 (* clear assigned values so we can go back to symbolic processing *)
 vx =.; vy =.; vz =.; 
 t1 =.; (* clear the values to recover the symbols for manipulation *)
 rearrangement = 
  Solve[t0 == s0[[1]], 
   t1]; (*Print["rearrangement = ", rearrangement]*); 
 (* Whilst a test case elsewhere seemed to show {{actual \
substitution}} could be used directly, when used here *)
 (* like that it flattens my list unless I first flatten \
rearrangement so it is only {} and not {{}} *)
 s0 = ReplaceAll[s0, Flatten@rearrangement]; Simplify[s0];
 (*Print["s0 after rearrangement = ", Reorder[MatrixForm@s0,srOrder], \
s0[[2]], s0[[3]], s0[[4]]];*)
 (* We are now ready to plot x, y, z at specified times t *)
 vx = setVx; vy = setVy; vz = setVz;
 Print[s0[[1]], ", ", s0[[2]], ", ", s0[[3]], ", ", s0[[4]]];
 pic = ParametricPlot3D[
     Evaluate[Rest[s0] /. {t0 -> #}], {θ, 0, 
      2 Pi}, {ϕ, -1 Pi, Pi}, Axes -> True, 
     AxesLabel -> {"x", "y", "z"}, LabelStyle -> Directive[Large], 
     TicksStyle -> Directive[Medium], AxesOrigin -> Automatic, 
     PlotStyle -> Directive[Opacity[0.6]], 
     AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
     ViewVertical -> {0, 0, 1}, ViewPoint -> Front, 
     PlotRange -> {{-4, 2}, Automatic, Automatic}] & /@ 
   Range[0, 5, 0.5];
 Manipulate[pic[[i]], {i, 1, Length[pic], 1}]
 ]

Notes: outline of the method... LorentzF[v] produces the 4D Lorentz transformation matrix, which is applied to spatialShell, which is a parametric specification of a sphere in polar coordinates centered on a particular point. {t, x, y,, z} = {t', x'+ sin(theta)sin(phi), y' = cost(theta)sin(phi), z'+ cos(phi).

The velocity vector is given component values so that the min & max of t can be determined numerically for use as the limits in manipulate.

In order to view the sphere at times t, t' is re-expressed in terms of t (using Solve, having unset the values to return to symbolic working) and substituted back into the equations, which are now becoming rather complex. [Note the ReplaceAll oddity in the comment]. The reorder function is that created by Mr Wizard elsewhere and has a standard set of symbols for consistent equations.

At this point in s0 we have four equations, but are only interested in parts 2-4 for the spatial part we wish to plot for variable t (t0 in the code). I will also want to add sliders for v in the x, y, z directions later.

Hope that helps

PS The need for Chenminqi's code is obscure to me because I can't see why Manipulate doesn't work directly - it picks up all the other variable values OK, so why not t0?

Update2

Removing pic form the local variable list in Block allows the suggested code to work. I'd really appreciate some insight into the way Manipulate and Block are working such that the problems arose in the first place; I have something that works, but as a completely new user I am struggling to understand so that I can use the knowledge on another occasion.

Update 3 Code for LorentzF and spatialShell (Chenminqi request)

Note Lorentz handles v = 0 and v>=c separately; if v=0 Mma objects to 0/0, invalid if v>=c so returns zeroes.

LorentzF[v_] := Module[{l, i, j, dim},
   dim = Length[v] + 1;
   If[NumericQ[Norm[v]] == True  && (Norm[v] == 0  || Norm[v] >= 1),
    If[Norm[v] == 0,
     l = Table[KroneckerDelta[i, j], {i, 1, dim}, {j, 1, dim}],
     l = Table[0, {i, 1, dim}, {j, 1, dim}]],
    If[dim < 2, l = {},
     l = Table[0, {i, 1, dim}, {j, 1, dim}];
     l[[1, 1]] = γ;
     For[i = 2, i <= dim, i++, 
      l[[1, i]] = l[[i, 1]] = -γ v[[i - 1]]
      ];
     For[i = 2, i <= dim, i++, 
      For[j = 2, j <= dim, j++, 
       l[[i, j]] = 
        l[[j, i]] = (γ - 1) v[[i - 1]] v[[j - 1]]/v.v + 
          KroneckerDelta[i, j]
       ]
      ]; 
     ]
    ];
   l
   ];

spatialShell[origin4D_, θ_, ϕ_] := {origin4D[[1]], 
   Sin[θ] Sin[ϕ] + origin4D[[2]], 
   Cos[θ] Sin[ϕ] + origin4D[[3]], 
   Cos[ϕ] + origin4D[[4]]};
$\endgroup$

2 Answers 2

1
$\begingroup$
Clear["Global`*"]
LorentzF[v_] := 
  Module[{l, i, j, dim, γ = (Total[v^2])^(-1/2)}, 
   dim = Length[v] + 1;
   If[NumericQ[Norm[v]] == True && (Norm[v] == 0 || Norm[v] >= 1), 
    If[Norm[v] == 0, 
     l = Table[KroneckerDelta[i, j], {i, 1, dim}, {j, 1, dim}], 
     l = Table[0, {i, 1, dim}, {j, 1, dim}]], 
    If[dim < 2, l = {}, l = Table[0, {i, 1, dim}, {j, 1, dim}];
     l[[1, 1]] = γ;
     For[i = 2, i <= dim, i++, 
      l[[1, i]] = l[[i, 1]] = -γ v[[i - 1]]];
     For[i = 2, i <= dim, i++, 
      For[j = 2, j <= dim, j++, 
       l[[i, j]] = 
        l[[j, i]] = (γ - 1) v[[i - 1]] v[[j - 1]]/v.v + 
          KroneckerDelta[i, j]]];]];
   l];
spatialShell[origin4D_, θ_, ϕ_] := {origin4D[[1]], 
   Sin[θ] Sin[ϕ] + origin4D[[2]], Cos[θ] Sin[ϕ] + origin4D[[3]], 
   Cos[ϕ] + origin4D[[4]]};
Module[{setMagV, setVx, setVy, setVz, s0, vx, vy, vz, t1, θ, ϕ, 
    mint, maxt, t0, f},setMagV = 0.5; setVx = setMagV; setVy = setVz = 0;
    s0 = Simplify[LorentzF[{vx, vy, vz}].spatialShell[{t1, 0, 0, 0}, θ, ϕ]];
    vx = setVx; vy = setVy; vz = setVz; t1 = 0;
    mint = Minimize[{s0[[1]],0<=θ<2Pi,-Pi<=ϕ<Pi}, {θ, ϕ}][[1]];
    maxt = Maximize[{s0[[1]],0<=θ<2Pi,-Pi<=ϕ<Pi}, {θ, ϕ}][[1]];
    vx =.; vy =.; vz =.; t1 =.;
    s0 = Simplify[s0 /. Solve[t0 == s0[[1]], t1][[1]]];
    f[t_, x_, y_, z_] := Evaluate[Rest[s0] /. {t0 -> t, vx -> x, vy -> y, vz -> z}];
    Manipulate[ParametricPlot3D[f[t, x, y, z], {θ, 0, 2 Pi}, {ϕ, -1 Pi, Pi}, 
      Axes -> True, AxesLabel -> {"x", "y", "z"}, LabelStyle -> Directive[Large],            
      TicksStyle -> Directive[Medium],AxesOrigin -> Automatic, PlotStyle -> 
      Directive[Opacity[0.6]],AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
      ViewVertical -> {0, 0, 1}, ViewPoint -> Front,PlotRange ->2],
   {t, 1.1 mint, 1.1 maxt}, {{x, 0.5, "vx"}, 0, 1}, {{y, 0, "vy"}, 0, 1},
   {{z, 0, "vz"}, 0, 1}, SaveDefinitions -> True]
]
$\endgroup$
4
  • $\begingroup$ I don't like Block,so i change it to Module.Please use Simple English... $\endgroup$
    – Apple
    Mar 14, 2014 at 12:43
  • $\begingroup$ that works very nicely and it is "cleaner", thank you. May I ask a couple of questions about how it works? I read the definitions of Block & Module but don't see why you like Module more. I also read SaveDefinitions but don't understand its effect here - can you explain? $\endgroup$ Mar 15, 2014 at 10:08
  • $\begingroup$ Usually Block is used to system parameters(like $RecursionLimit) or some global variables temporary.But Module create some local variables. SaveDefinitions is no use for this,you can delete it. $\endgroup$
    – Apple
    Mar 16, 2014 at 5:28
  • $\begingroup$ ok, thanks - that's clearer now. Much appreciated. $\endgroup$ Mar 16, 2014 at 11:38
1
$\begingroup$
Clear["Global`*"]
s0 = {t0, 0. + 2. Sin[θ] Sin[ϕ] - 1. (0.5 t0 + 
      0.5 Sin[θ] Sin[ϕ]), 4. (0. + 0.25 Cos[θ] Sin[ϕ]),
      1. Cos[ϕ]}
pic = ParametricPlot3D[
        Evaluate[Rest[s0] /. {t0 -> #}], {θ, 0, 2 Pi}, {ϕ, -1 Pi, Pi},
        Axes -> True, AxesLabel -> {"x", "y", "z"}, LabelStyle -> Directive[Large], 
        TicksStyle -> Directive[Medium], AxesOrigin -> Automatic, 
        PlotStyle -> Directive[Opacity[0.6]], AxesEdge -> {{-1, -1}, {1, -1}, {-1, -1}}, 
        ViewVertical -> {0, 0, 1}, ViewPoint -> Front, 
        PlotRange -> {{-4, 2}, Automatic, Automatic}] & /@ 
      Range[0, 5, 0.5];
Manipulate[pic[[i]], {i, 1, Length[pic], 1}]
$\endgroup$
9
  • $\begingroup$ Thanks @Chenminqi, I tried it but (direct copy/paste and run) it gave me "...pic[[1]] is longer than depth of object" Is there something missing/extra in the text here? I can't see how your idea works (I'm too new with Mma) so all I can say (apart from thx) is: can you clarify? $\endgroup$ Mar 13, 2014 at 16:27
  • $\begingroup$ @JulianMoore What Mma version are you using? The above code works Ok in v9. Also, try restarting your Mma session. $\endgroup$ Mar 13, 2014 at 16:56
  • $\begingroup$ @belisarius - Thanks. I also have V9; quit & restarted. Same issue in the original notebook, but pasted into a new notebook it does indeed work as adertised. I will update the question to show the whole of my routine in case there is a problem that the more knowledgeable can see. $\endgroup$ Mar 13, 2014 at 17:11
  • $\begingroup$ See update2 - now works in my code IF "pic" is not declared in Block... but that only confuses me further. $\endgroup$ Mar 13, 2014 at 17:50
  • $\begingroup$ For some complex images,it is bad idea that put plot in manipulate,for example Manipulate[Plot3D[Sin[k x + y], {x, 0, Pi}, {y, 0, 2 Pi}], {k, 1, 3}].when change k,it will replot the image.So it will better if we plot some images in advance,and then display difference image by manipulate. pic = Table[ Plot3D[Sin[k x + y], {x, 0, Pi}, {y, 0, 2 Pi}], {k, 1, 3, 0.1}]; Manipulate[pic[[i]], {i, 1, Length[pic], 1}] $\endgroup$
    – Apple
    Mar 14, 2014 at 4:09

Your Answer

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

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