Clustering 3D Data Points on a Periodic Cubic Grid

Question

I have a set of 3D data points on a cubic grid. The data can be downloaded from here https://skydrive.live.com/redir?resid=F96524B72DCD75FB!14240 and read into a variable lis using

lis = ReadList["filename", {Number, Number, Number}].

How can one cluster the points into groups such that the points in each group are related by the fact that they are only one grid point away from their nearest neighbor in all directions (taking periodic boundaries in all directions into account). By all directions I mean the six faces of a cube. The EuclideanDistance between grid points is 0.055089 .

Here is a plot of the data (well solution, see below). enter image description here

Actually, I was able to solve this problem using object-oriented programming in C#, but I've come up short trying to reproduce it in Mathematica. I've tried a combination of FindClusters and Nearest with no success. Any help will be much appreciated. I have tried to include as much information as I think is needed to solve this problem but if more information is needed I'll gladly provide it.

Note: In the plot above, I've removed groups that has less than 20 points.

@Kuba, I did see that question. Doesn't include periodic boundaries though. And the criteria seems to be just the EuclideanDistance in any direction. — RunnyKine, Sep 20 '13 at 22:39
That's why I havn't said dupicate :) isn't ManhattanDistance and Mod a fix? — Kuba, Sep 20 '13 at 22:59
@Kuba. That sounds like it might do it. Thanks. I'll look into that. — RunnyKine, Sep 20 '13 at 23:03

score 5 · Accepted Answer · edited Apr 13 '17 at 12:56

5

As a first simple way:

data=ReadList["points.txt",{Number,Number,Number}];
dataG=Gather[data,EuclideanDistance[#1,#2]<0.5&]
ListPointPlot3D[dataG,PlotStyle->Directive[PointSize[0.01]] ,BoxRatios->{1,1,1}]

But this do not consider the grid structure. And later I discovered here why this is not a good way.

Another more precise one is:

dataS=SparseArray[Thread[Map[IntegerPart,data/0.055088983050847+1,{-1}]->1]];
img=Image3D[Raster3D[Normal@dataS]];
(img=MorphologicalComponents[img])//Colorize

You can get image clustered points with.

pointsCluster=MapAt[0.055088983050847 # &, ArrayRules@MorphologicalComponents[dataS], {All, 1}]

Ploting again now we have:

ListPointPlot3D[GatherBy[pointsClusters[[;;-2]],Last][[All,All,1]],BoxRatios->{1,1,1}]

enter image description here

edited Apr 13 '17 at 12:56

Community

1

answered Sep 20 '13 at 22:43

Murta

26,275
6
76
166

It's close but not quite. I still see points joined that shouldn't be. And I don't see where you've taken periodic boundary into account. – RunnyKine Sep 20 '13 at 22:57
Now I'm using it in the second answer. – Murta Sep 20 '13 at 23:22

Clustering 3D Data Points on a Periodic Cubic Grid

1 Answers1

Linked