Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
    
It seems to be closely related to make specific cluster. –  Kuba Sep 20 '13 at 22:32
    
@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
add comment

1 Answer

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

Image01

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

Image02

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

share|improve this answer
    
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
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.