Color Plot by order of points in list - Mathematic

2019-06-22 16:01发布

问题:

I've got a list of three dimensional points, ordered by time. Is there a way to plot the points so that I can get a visual representation that also includes information on where in the list the point occurred? My initial thought is to find a way to color the points by the order in which they were plotted.

ListPlot3D drapes a sheet over the points, with no regard to the order which they were plotted.

ListPointPlot just shows the points, but gives no indication as to the order in which they were plotted. It's here that I am thinking of coloring the points according to the order in which they appear in the list.

ListLinePlot doesn't seem to have a 3D cousin, unlike a lot of the other plotting functions.

回答1:

You could also do something like

lst = RandomReal[{0, 3}, {20, 3}];
Graphics3D[{Thickness[0.005], 
  Line[lst, 
   VertexColors -> 
    Table[ColorData["BlueGreenYellow"][i], {i, 
      Rescale[Range[Length[lst]]]}]]}]



回答2:

As you did not provide examples, I made up some by creating a 3d self-avoiding random walk:

Clear[saRW3d]
saRW3d[steps_]:=
    Module[{visited},
        visited[_]=False;
        NestList[
            (Function[{randMove},
                If[
                    visited[#+randMove]==False,
                    visited[#+randMove]=True;
                    #+randMove,
                    #
                ]
            ][RandomChoice[{{1,0,0},{-1,0,0},{0,1,0},{0,-1,0},{0,0,1},{0,0,-1}}]])&,
            {0,0,0},
            steps
        ]//DeleteDuplicates
]

(this is sort of buggy but does the job; it produces a random walk in 3d which avoids itself, ie, avoids revisiting the same place in subsequent steps).

Then we produce 100000 steps like this

dat = saRW3d[100000];

this is like I understood your data points to be. We then make these change color depepnding on which step it is:

datpairs = Partition[dat, 2, 1];
len = Length@datpairs;
dressPoints[pts_, lspec_] := {RGBColor[(N@First@lspec)/len, 0, 0], 
   Line@pts};
datplt = MapIndexed[dressPoints, datpairs];

This can also be done all at once like the other answers

datplt=MapIndexed[
    {RGBColor[(N@First@#2)/Length@dat, 0, 0], Line@#1} &,
    Partition[dat, 2, 1]
]

but I tend to avoid this sort of constructions because I find them harder to read and modify.

Finally plot the result:

Graphics3D[datplt]

The path gets redder as time advances.

If this is the sort of thing you're after, I can elaborate.

EDIT: There might well be easier ways to do this...

EDIT2: Show a large set of points to demonstrate that this is very useful to see the qualitative trend in time in cases where arrows won't scale easily.

EDIT3: Added the one-liner version.



回答3:

I think Heike's method is best, but she made it overly complex, IMHO. I would use:

Graphics3D[{
  Thickness[0.005], 
  Line[lst, 
   VertexColors -> 
    ColorData["SolarColors"] /@ Rescale@Range@Length@lst ]
}]

(acl's data)



回答4:

Graphics3D@(Arrow /@ Partition[RandomInteger[{0, 10}, {10, 3}], 2, 1])



回答5:

As to your last question: If you want to have a kind of ListLinePlot3D instead of a ListPointPlot you could simply do the following:

pointList = 
  Table[{t, Sin[t] + 5 Sin[t/10], Cos[t] + 5 Cos[t/10], 
    t + Cos[t/10]}, {t, 0, 100, .5}];

ListPointPlot3D[pointList[[All, {2, 3, 4}]]] /. Point -> Line

Of course, in this way you can't set line properties so you have to change the rule a bit if you want that:

ListPointPlot3D[pointList[[All, {2, 3, 4}]]] /. 
       Point[a___] :> {Red, Thickness[0.02], Line[a]}

or with

ListPointPlot3D[pointList[[All, {2, 3, 4}]]] /. 
 Point[a___] :> {Red, Thickness[0.002], Line[a], Black, Point[a]}

But then, why don't you use just Graphics3D and a few graphics primitives?