Plot Many Points with ListPointPlot3D[]

Questions
, ,
1

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];
2

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]

points.png
points.png360×286 20 KB

3

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]
4

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]
 ]

Listpointplot3d.png
Listpointplot3d.png576×460 40.8 KB

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

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

Listpointplot3d-2.png
Listpointplot3d-2.png360×402 31.8 KB

5

Well done, sir.