1
$\begingroup$

This is a bit of a two part question about optimizing some 3D plotting - it's pretty straightforward but after a while struggling with it I haven't made much headway. Assume some list of 3D points, i.e. pts = {{1,1,0},{1,1,0.1},{1,1,0.2}, ... ,{1,1,1}}. I want to

a) plot those points in 3D space with a color gradient such as ColorData["SunsetColors"] where the gradient is based on the index of the point in the list, rather than the value of the point. I have figured out a hacky way to do this, but I think it is probably far from optimal: 

Graphics3D[{Thickness[0.005], 
  Line[pts, 
   VertexColors -> (ColorData["SunsetColors"][#/Length[pts]] & /@ 
      Range[Length[pts]])]}, Background -> White]

I have tried working with ListPointPlot3D but could not get the color gradient to work out. While this implementation technically works, its clunkiness makes it slow, which causes problems for part b), which is

b) Ideally I want to animate the trajectory of these points. The natural thing to do, building off the hacky solution to part a) is: 

Animate[Graphics3D[{Thickness[0.005], 
   Line[pts[[1 ;; t]], 
    VertexColors -> (ColorData["SunsetColors"][#/Length[pts]] & /@ 
       Range[Length[pts]])]}], {t, 1, Length[pts], 1}]

However, I find in practice that the animation does not look very smooth at all, even though the step size is 1, and can get very slow with a large number of points (typical trajectories can be multi-thousands). I'm basically wondering if there is cleaner solution to these problems, both the plotting with a color gradient, and the subsequent animation - ideally while still keeping the points connected like with Line[]. Any help would be appreciated.

Improve this question
$\endgroup$

2 Answers 2

Reset to default
1
$\begingroup$

You can use construct a BSplineFunction using input data:

SeedRandom[1]
pts = RandomReal[1, {10, 3}];

bsf = BSplineFunction[pts, "SplineDegree" -> 1];

You can use bsf with ParametricPlot3D in several ways:

(1) Use a piecewise ColorFunction:

Animate[ParametricPlot3D[bsf[t], {t, 0, 1}, 
   PlotStyle -> Thick, 
   ColorFunction -> (If[#4 <= m, ColorData["SunsetColors"]@#4, White] &), 
   BoxRatios -> 1, 
   PlotRange -> {{0, 1}, {0, 1}, {0, 1}}], 
 {m, 10^-5, 1}]

enter image description here

(2) Use a combination of MeshFunctions,Mesh and MeshShading:

Animate[ParametricPlot3D[bsf[t], {t, 0, 1}, 
    PlotStyle -> Thick, 
    MeshFunctions -> {#4 &}, Mesh -> {{m}}, 
    MeshShading -> {Automatic, None}, 
    ColorFunction -> (ColorData["SunsetColors"]@#4 &), 
    ColorFunctionScaling -> False, 
    BoxRatios -> 1, 
    PlotRange -> {{0, 1}, {0, 1}, {0, 1}}],
  {m, 10^-5, 1}]

enter image description here

(3) Use the upper limit in the second argument of ParametricPlot3D as the animation parameter:

Animate[ParametricPlot3D[bsf[t], {t, 0, tmax}, PlotStyle -> Thick, 
  ColorFunction -> (ColorData["SunsetColors"]@#4 &), 
  ColorFunctionScaling -> False, BoxRatios -> 1, 
  PlotRange -> {{0, 1}, {0, 1}, {0, 1}}], {tmax, 10^-5, 1}]

enter image description here

Update: A (probably faster) alternative is to use a combination of Graphics3D, GraphicsComplex and VertexColors:

Animate[Graphics3D[GraphicsComplex[bsf /@ Range[0, 1, .001], 
    {{Thickness[Large], Line[Range[1001], VertexColors -> Automatic]}}, 
    VertexColors -> (If[# <= m, ColorData["SunsetColors"]@#, White] & /@
      Range[0, 1, .001])] ,
   BoxRatios -> 1, PlotRange -> {{0, 1}, {0, 1}, {0, 1}}], 
 {m, 0, 1}]

enter image description here

Improve this answer
$\endgroup$
0
$\begingroup$

Let's generate some points:

pts = {1, 1, #} & /@ Range[0, 1, 0.01];

Now we can utilize MapIndexed:

Graphics3D[MapIndexed[{ColorData["SunsetColors"][First@#2/Length[pts]], 
Point@#1} &, pts], Axes -> True]

enter image description here

And Animation:

Animate[Graphics3D[MapIndexed[{ColorData["SunsetColors"][First@#2/Length[pts]], 
Point@#1} &, pts[[1 ;; t]]], 
PlotRange -> MinMax /@ Transpose[pts], Axes -> True], {t, 1, 
Length[pts], 1}]

For me it is smooth enough.

To have points connected we can add Line primitive:

Animate[Graphics3D[{Line[pts[[1 ;; t]]], 
MapIndexed[{ColorData["SunsetColors"][First@#2/Length[pts]], 
Point@#1} &, pts[[1 ;; t]]]}, 
PlotRange -> MinMax /@ Transpose[pts], Axes -> True], {t, 1, 
Length[pts], 1}]
Improve this answer
$\endgroup$
3
  • $\begingroup$ This seems like a good solution, and indeed it runs a bit smoother on my computer - but I should've clarified (and I've now updated the main question), that ideally I would have these points connected, like the Line[] construct. Is that something which is easily achievable with this framework? $\endgroup$
    – KHAAAAAAAAN
    Oct 31, 2019 at 8:13
  • $\begingroup$ I edited answer, probably it is enough to add Line. $\endgroup$
    – Alx
    Oct 31, 2019 at 8:22
  • $\begingroup$ Yes, but the line here is monochrome rather than following the gradient. That could be fixed using the VertexColors as in the original question, but it would start getting pretty clunky again - is there any simpler way to have the gradient reflected in the line as well? $\endgroup$
    – KHAAAAAAAAN
    Oct 31, 2019 at 8:40

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.