Message Boards Message Boards

Plot Many Points with ListPointPlot3D[]

Posted 9 years ago

Hello,

I have a data set with 3264 rows, with {x,y,z} coordinates and a 4th column having a number from 0 to 1. The 4th column is determining the Opacity[] of each point in ListPointPlot3D[]. My goal for this plot is to visualize where this data has clusters of points with (4th column) closer to 1. Mathematica has been failing with 3264 rows, and so I resorted to taking a random sample of 300 points from the list. That will plot, but isn't the full picture that I was going for.

So my question would be, Is there a way to force Mathematica to plot 3264 data points using ListPointPlot3D[] (even if it takes 5 minutes to do so)? If not, is there another way to accomplish the same goal?

I've included a picture of the plot that I have currently for context and the code that generates it,

plotPointsNum = 300;
samplePositions = 
  RandomSample[Range[Length[nonZeroTable]], plotPointsNum];
sampleData = nonZeroTable[[Part[samplePositions, All], All]];
Length[sampleData];

data4Cols = sampleData;
pointsOpacity = {Opacity[#]} & /@ data4Cols[[;; , 4]];
plot = Show[
   ListPointPlot3D[{data4Cols[[All, 1 ;; 3]]}, 
      PlotStyle -> {PointSize[0.05], Black, 
        Evaluate[pointsOpacity[[#]]]}, 
      AxesLabel -> {"t", "v", "p"}] & /@ Range[Length[pointsOpacity]],
    ImageSize -> Large];
Attachments:
POSTED BY: Greg
4 Replies
Posted 9 years ago

Well done, sir.

POSTED BY: Greg
Posted 9 years ago

Hi Greg,

A few issues. You got 4 points above because the data was 4 x 4000 - it needed to be transposed. The other issue is how the plot routines like ListPointPlot3D apply PlotStyles. They are all set to accept a list of lists for plotting multiple plots in the same graphic. So a PlotStyle list is applied one item per plot, not each point. You can apply a list of styles to a list of points by making each point into a 1-element list. So for 1000 points we are really plotting 1000 plots, each with its own style. Each plot has exactly one point.

You can also get around this by simply constructing your own graphics from primitives. Note especially the convenient use of pattern-base rules for transforming the data. It is often much easier and more readable that pure functions.

In[1]:= (* this data needs to be transposed *)
data = {Table[RandomReal[], {i, 1, 4000, 1}], 
    Table[RandomReal[], {i, 1, 4000, 1}], 
    Table[RandomReal[], {i, 1, 4000, 1}], 
    Table[RandomReal[], {i, 1, 4000, 1}]} // Transpose;

In[2]:= data // Dimensions

Out[2]= {4000, 4}

In[3]:= (* Using ListPointPlot3D *)

In[4]:= (* include point size and color in each sublist *)
pointsOpacity = {PointSize[0.05], Black, Opacity[#]} & /@ 
   data[[;; , 4]];

In[5]:= pointsOpacity[[1]]

Out[5]= {PointSize[0.05], GrayLevel[0], Opacity[0.610006]}

In[6]:= (* another way to transorm data -- each point in its own \
sublist *)
data1 = data /. {x_, y_, z_, o_} -> {{x, y, z}};

In[7]:= Timing[
 Show[ListPointPlot3D[data1, PlotStyle -> pointsOpacity, 
   AxesLabel -> {"x", "y", "z"}], ImageSize -> Large]
 ]

enter image description here

(* from primitives *)
points = data /. {x_, y_, z_, op_} -> {PointSize[0.05], Opacity[op], 
     Point[{x, y, z}]};

Show[Graphics3D[points], Axes -> True]

enter image description here

Attachments:
POSTED BY: David Keith
Posted 9 years ago

The code you posted is incomplete, so doesn't execute. But I can't imagine ListPointPlot3D having problems with a few thousand points.

In[1]:= points = Table[RandomReal[{-1, 1}, 3], {3264}];

In[2]:= points // Dimensions

Out[2]= {3264, 3}

In[3]:= ListPointPlot3D[points]

enter image description here

POSTED BY: David Keith
Posted 9 years ago

Thanks for looking at it David. Maybe the Opacity[] function is slowing it down? Likely there is a problem with it then, since the computer it's running on has 32GB of RAM, etc.

I cleaned it up some and have this code, it now only plots a few points, but I haven't spotted the issue,

data = {
   Table[RandomReal[], {i, 1, 4000, 1}]
   , Table[RandomReal[], {i, 1, 4000, 1}]
   , Table[RandomReal[], {i, 1, 4000, 1}]
   , Table[RandomReal[], {i, 1, 4000, 1}]};

pointsOpacity =
  {Opacity[#]} & /@ data[[;; , 4]];

Show[
 ListPointPlot3D[{data[[All, 1 ;; 3]]}, 
    PlotStyle -> {PointSize[0.05], Black, 
      Evaluate[pointsOpacity[[#]]]}, AxesLabel -> {"x", "y", "z"}] & /@
   Range[4000], ImageSize -> Large]
Attachments:
POSTED BY: Greg
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract