21
$\begingroup$

Motivation

I'm trying to do a nice animation of the rotation of a ParametricPlot3D . My problem is that the Ticks numbers and AxesLabel text wiggle with an undesirable noisy component as the ViewPoint changes.

Rotating ParametricPlot3D

Questions

How can I figure out why it wiggles?

How do I avoid it?

I'm guessing that there is some "round up to nice values" going on somewhere, but the output of TracePrint its not too revealing to me.

Code

examplePlot = ParametricPlot3D[
  Evaluate@Table[
    {
     k
     , s
     , Sin[k s] + k s/50
     }
    , {k, 7}
    ]
  , {s, 0, 4 Pi}
  , PlotRange -> {{-2, 4 Pi}, {0, 4 Pi}, {-2, 4}}
  , BoxRatios -> {1, 3, 1}
  , PlotStyle -> Array[Hue, 7, {0, 0.75}]
  , PlotPoints -> 150
  , MaxRecursion -> 5
  , BaseStyle -> {FontSize -> 14, FontFamily -> "Helvetica", 
    FontTracking -> "Plain", TextJustification -> 0, 
    PrivateFontOptions -> {"OperatorSubstitution" -> False}}
  , ImageSize -> {700, 300}
  , ViewAngle -> 0.19
  , Ticks -> {Range[7], Automatic, Automatic}
  ]

animExample = Table[
   Show[
    examplePlot
    , ViewPoint -> {3, 0.4 + 0.5 Sin[j], 0.5 + 0.2 Cos[j]}
    , RotationAction -> "Clip"
    , ViewVertical -> {0, 0, 1}
    , ViewAngle -> 0.22
    , AxesEdge -> {{1, -1}, Automatic, {1, -1}}
    , AxesLabel -> {"Axis 1", "Axis 2", "Axis 3"}
    ]
   , {j, 0, 2 π, π/25}];

Export["animExample.GIF", animExample, "DisplayDurations" -> 0.15, 
 "AnimationRepetitions" -> Infinity]
$\endgroup$
  • 2
    $\begingroup$ I believe you should seriously consider buying a six-pack spelunking award if someone finds the way to circumvent it $\endgroup$ – Dr. belisarius Sep 11 '15 at 15:54
  • 1
    $\begingroup$ And now I am seasick! Just a thought: since functions appears to be plotted right, why don't you try to recreate the box, the ticks and the labels as... functions? Ok, the box and ticks are just lines and should be easy. For the text... if you can tolerate it to remain in a fixed position you could try points, or splines... Perhaps a procedure to convert text into an interpolation exists somewhere. Just a thought. (You'll need the box because otherwise you won't be able to place labels outside of it). $\endgroup$ – Peltio Sep 11 '15 at 16:08
  • 1
    $\begingroup$ The movement of the labels is not random. It caused by change in the projection parameters that are taking the labels from 3D space into 2D space as the view point changes in your animation. $\endgroup$ – m_goldberg Sep 11 '15 at 18:09
  • $\begingroup$ @m_goldberg Shouldn't that projection change smoothly as the ViewPoint changes smoothly? I agree that true randomness is out of the question, I should have said that there is an undesirable noisy component to the position of the text. $\endgroup$ – rhermans Sep 11 '15 at 20:07
  • 1
    $\begingroup$ Not a very elegant suggestion but you could write text and labels in the right 3D planes. Of course this wouldn't work for angles multiples of $\pi/2$: only the thickness of some labels would be seen... $\endgroup$ – anderstood Sep 11 '15 at 20:20
11
$\begingroup$

Not a complete answer, but I think this can get you close to the solution.

If you use images instead of text, there's less (or even no) jumping around. I only worked on the ticks.

To have the ticks numbers rasterized, I made a variation of this, but there's probably a simpler way (I didn't try to put your ticks specification, but it should be easy).

Then, I played with the sizes and resolutions, and my end result still needs a lot of tuning: line thickness / darkness are a little lost in rasterings and resizings, numbers are flickering (but I do believe that they are not jumping; you tell me...)

enter image description here

I hope this helps as a start:

tickF[div1_, div2_: - 1] := (If[div2 == -1, 
    Thread[{#, #, {.02, 0}}, List, 2] &@FindDivisions[{#1, #2}, div1],
     Join @@ 
     MapAt[Join @@ # &, {Function[{p}, {p, 
            Magnify[Rasterize[p, RasterSize -> 150], 3], {.02, 
             0}}] /@ #[[1]], 
         Thread[{#, "", {.01, 0}}, List, 2] & /@ #[[2]]} &@
       FindDivisions[{#1, #2}, {div1, div2}], {2}]]) &


examplePlot[j_] := 
 ParametricPlot3D[
  Evaluate@Table[{k, s, Sin[k s] + k s/50}, {k, 7}], {s, 0, 4 Pi}, 
  PlotRange -> {{-2, 4 Pi}, {0, 4 Pi}, {-2, 4}}, 
  BoxRatios -> {1, 3, 1}, PlotStyle -> Array[Hue, 7, {0, 0.75}], 
  PlotPoints -> 150, MaxRecursion -> 5, 
  BaseStyle -> {FontSize -> 14, FontFamily -> "Helvetica", 
    FontTracking -> "Plain",
    TextJustification -> 0, 
    PrivateFontOptions -> {"OperatorSubstitution" -> False}}, 
  ImageSize -> {3*700, 3*300},
  Ticks -> 
   Evaluate@({(t1 = {##}; tickF[8, 5][##]) &, (t2 = {##}; 
        tickF[8, 5][##]) &, (t3 = {##}; N /@ tickF[8, 5][##]) &}),
  ViewPoint -> {3, 0.4 + 0.5 Sin[j], 0.5 + 0.2 Cos[j]},
  RotationAction -> "Clip",
  ViewVertical -> {0, 0, 1},
  ViewAngle -> 0.22,
  AxesEdge -> {{1, -1}, Automatic, {1, -1}},
  AxesLabel -> {"Axis 1", "Axis 2", "Axis 3"}];

animExample = 
 Table[ImageResize[Rasterize[examplePlot[j], "Image"], 700], {j, 0, 2 \[Pi], \[Pi]/25}];

EDIT

Still based on rasterization, but better looking:

enter image description here

tickF[div1_, 
  div2_: - 1] := (If[div2 == -1, 
    Thread[{#, #, {.02, 0}}, List, 2] &@FindDivisions[{#1, #2}, div1],
     Join @@ 
     MapAt[Join @@ # &, {Function[{p}, {p, p, {.02, 0}}] /@ #[[1]], 
         Thread[{#, "", {.01, 0}}, List, 2] & /@ #[[2]]} &@
       FindDivisions[{#1, #2}, {div1, div2}], {2}]]) &

examplePlot[j_, factor_] := 
 ImageResize[
  Rasterize[
   ParametricPlot3D[
    Evaluate@Table[{k, s, Sin[k s] + k s/50}, {k, 7}], {s, 0, 4 Pi}, 
    PlotRange -> {{-2, 4 Pi}, {0, 4 Pi}, {-2, 4}}, 
    BoxRatios -> {1, 3, 1}, 
    PlotStyle -> Array[{Hue[#], Thickness[0.006]} &, 7, {0, 0.75}], 
    PlotPoints -> 150, MaxRecursion -> 5, 
    BaseStyle -> {FontSize -> factor*14, FontFamily -> "Helvetica", 
      FontTracking -> "Plain",
      TextJustification -> 0, 
      PrivateFontOptions -> {"OperatorSubstitution" -> False}}, 
    ImageSize -> {factor*700, factor*300},
    ViewPoint -> {3, 0.4 + 0.5 Sin[j], 0.5 + 0.2 Cos[j]},
    RotationAction -> "Clip",
    ViewVertical -> {0, 0, 1},
    ViewAngle -> 0.22,
    AxesEdge -> {{1, -1}, Automatic, {1, -1}},
    AxesLabel -> {"Axis 1", "Axis 2", "Axis 3"},
    Ticks -> 
     Evaluate@({(t1 = {##}; tickF[8, 5][##]) &, (t2 = {##}; 
          tickF[8, 5][##]) &, (t3 = {##}; N /@ tickF[8, 5][##]) &}),
    BoxStyle -> Directive[Thickness[0.003]]
    ], "Image", RasterSize -> 4000], 700, Resampling -> "Linear"]


animExample6 = Table[examplePlot[j, 6], {j, 0, 2 \[Pi], \[Pi]/25}];
Export["animExample.GIF", animExample6, 
 "DisplayDurations" -> 0.15, "AnimationRepetitions" -> Infinity]

(not sure if factor is doing that much... but at least it is better looking, simpler and faster)

$\endgroup$
  • 1
    $\begingroup$ One note on your ImageResize-based approach: I strongly recommend to use Rasterize[..., "Image"] instead of simple Rasterize for better performance and quality. $\endgroup$ – Alexey Popkov Sep 12 '15 at 16:02
  • $\begingroup$ @AlexeyPopkov thank you! I'll update the post with your sugested "Image" as soon as I'm in front of a pc. $\endgroup$ – P. Fonseca Sep 14 '15 at 19:26
8
$\begingroup$

It seems that the reason for the text wiggling is that on rendering the textual elements are aligned to the pixel grid. To avoid wiggling we should avoid using of font glyphs. P. Fonseca has showed the rasterization approach. I will show the outlining approach using the core of his tickF function:

baseStyle = {FontSize -> 18, FontFamily -> "Helvetica", FontTracking -> "Plain", 
   TextJustification -> 0, PrivateFontOptions -> {"OperatorSubstitution" -> False}};
outl = First@ImportString[ExportString[Style[#, baseStyle], "PDF"], "PDF"] &;
lbls = outl /@ {"Axis 1", "Axis 2", "Axis 3"};

tickF[div1_, div2_: - 1] := 
  If[div2 == -1, Thread[{#, #, {.02, 0}}, List, 2] &@FindDivisions[{#1, #2}, div1], 
    Join @@ MapAt[
      Join @@ # &, {Function[{p}, {p, outl[p], {.02, 0}}] /@ #[[1]], 
         Thread[{#, "", {.01, 0}}, List, 2] & /@ #[[2]]} &@
       FindDivisions[{#1, #2}, {div1, div2}], {2}]] &;

examplePlot = 
 ParametricPlot3D[Evaluate@Table[{k, s, Sin[k s] + k s/50}, {k, 7}], {s, 0, 4 Pi}, 
  PlotRange -> {{-2, 4 Pi}, {0, 4 Pi}, {-2, 4}}, BoxRatios -> {1, 3, 1}, 
  PlotStyle -> Array[Hue, 7, {0, 0.75}], PlotPoints -> 150, MaxRecursion -> 5, 
  ImageSize -> {700, 300}, ViewAngle -> 0.19, 
  Ticks -> {tickF[8, 5], tickF[8, 5], tickF[8, 5]}];

animExample = 
  Table[Show[examplePlot, ViewPoint -> {3, 0.4 + 0.5 Sin[j], 0.5 + 0.2 Cos[j]}, 
    RotationAction -> "Clip", ViewVertical -> {0, 0, 1}, ViewAngle -> 0.22, 
    AxesEdge -> {{1, -1}, Automatic, {1, -1}}, AxesLabel -> lbls], {j, 0, 
    2 \[Pi], \[Pi]/25}];

Export["animExample.GIF", animExample, "DisplayDurations" -> 0.15, 
 "AnimationRepetitions" -> Infinity]

animation

$\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.