# data clustering

I have some data set which i would like to partition into 3 groups a:set 1 b: set 2 c: background. I use FindClusters[] function but as you can see (after evaluating the commands) the result is not what I am looking for.
Can someone help?

data1 = RandomReal[{-0.1, 0.1}, {10^2, 2}];
data2 = RandomReal[{-1, 1}, {2*10^2, 2}];
data3 = RandomReal[{-0.3, -0.2}, {2*10^2, 2}];
data5 = Join[data1, data2, data3];
ListPlot[FindClusters[data5, 3]]


-
No, I can't see that. How am I to know what you expect? It does create a plot, doesn't it? – stevenvh Sep 24 '12 at 13:12
Sorry, I tried to copy and paste the plot into the message but could not do it... So how do i Put plots into the message? – Doron Sep 24 '12 at 13:36
No, you can't paste images. When you're editing you have a toolbar above the edit box, there's an icon for uploading images. You can select an image from your PC or one from the 'Net. – stevenvh Sep 24 '12 at 13:37

The problem is that your "Background" is not a cluster with the usual distance function. You can tweak it (to some extent) with something like:

data1 = RandomReal[{-0.1, 0.1}, {10^2, 2}];
data2 = RandomReal[{-1, 1}, {2*10^2, 2}];
data3 = RandomReal[{-0.3, -0.2}, {2*10^2, 2}];
data5 = Join[data1, data2, data3];
ListPlot[FindClusters[data5,
DistanceFunction -> (If[# < .2, #, 1000] &@ EuclideanDistance[##] &)]]


But I'll not bet on it working everytime.

Edit

We may sophisticate the analysis somewhat (my statistics is rusty, sorry)

(*Define a Distribution and fit*)
d = HistogramDistribution[data5, {.2}];
(*Define what is noise and what is signal*)
(*I used *1* as threshold, but some statistics could be of use here*)

noNoise = Reduce[Evaluate@PDF[d, {x, y}] > 1, {x, y}];

filtered = If[noNoise /. {x -> #[[1]], y -> #[[2]]}, #, Sequence[] ] & /@ (data5);
Framed@ListPlot[filtered]


Check that our 300 data points are there

Length@filtered
(*307*)


And now clusterize:

Framed@ListPlot@FindClusters@filtered


Much better! :)

Note

I chose HistogramDistribution just because it works with Reduce

-
Thanks. But this is exactly my problem... I don't really know how does the real data is distributed. this is what i would like to find out. "Do i have clusters hidden in the data i got?" so i cannot really set criteria to distinguish between the noise and the cluster – Doron Sep 24 '12 at 13:31
May I suggest ## instead of Sequence @@ {#1,#2} :-) – Simon Woods Sep 24 '12 at 13:38
@Doron Ok. So write down what you DO know. Perhaps you need a filtering previous to clustering – Dr. belisarius Sep 24 '12 at 13:38
@SimonWoods I got more than one knock on my head for that here. And I keep forgetting it. Damn – Dr. belisarius Sep 24 '12 at 13:40

One possible approach is to look for a larger number of clusters, so that the background is split into multiple clusters.

c = FindClusters[data5, 8];
ListPlot[c]


The data clusters will be those with a larger number of members and smaller size (not necessarily true - see update)

ListPlot[
Transpose[{{Length /@ c, Sqrt[Total[Variance[#]]] & /@ c}}, {2, 3, 1}],
PlotStyle -> PointSize[0.03], Frame -> True, Axes -> False,
FrameLabel -> {"Cluster Members", "Cluster Size"},
BaseStyle -> {FontFamily -> "Calibri", 16}]


Update: @belisarius has pointed out that the algorithm could select a small portion of the background as a cluster, and so "small size" is not a good indicator of a data cluster. Perhaps better is to measure the approximate point density within each cluster, the expectation being that data clusters will be high density and the background low density:

BarChart[0.001 (Length[#]/Total[Variance[#]]) & /@ c, Frame -> True,
FrameTicks -> {None, Automatic},
ChartStyle -> (ColorData[1][#] & /@ Range[8]),
ChartLabels -> Range[8],
FrameLabel -> {"\nCluster No.", "Clustering Score"},
BaseStyle -> {FontFamily -> "Calibri", 16}]


-
I think "with the smaller size" can be misleading. The algorithm may select a small portion of the background as a cluster ... – Dr. belisarius Sep 24 '12 at 14:40
@belisarius, good point, thanks. – Simon Woods Sep 24 '12 at 15:04

Here is an attempt at a solution that is slightly more robust and automatic than the previous answers. Providing a discontinuous DistanceFunction to FindClusters can be unpredictable (sometimes it is better to use Method->"Agglomerate" in those situations and sometimes not), so making a graph from the data containing only short edges and then finding the connected components is closer to what you want. If you do FindClusters on the distances of each point to its nearest neighbor, then take the average of those clusters, and then take the average of the largest two, you can automatically find a cutoff length to separate the background. So then the only parameter you are providing is how many clusters you want.

nf = Nearest[data];
maxDistance =
Mean@Sort[
Mean /@ FindClusters[
EuclideanDistance @@ nf[#, 2] & /@ data]][[-2 ;;]];
ListPlot@
ConnectedComponents[
Graph[UndirectedEdge @@@
Select[Subsets[data, {2}],
EuclideanDistance @@ # < maxDistance &]]][[;; 2]]


This technique also works with density situations that are difficult to do with FindClusters. Here is the wraparound example from the Wikipedia article on cluster analysis.

-

As there is no analytic solution to the clustering problem, the final result will depend upon some arbitrary decision on what represents a viable cluster in your context.

One approach to investigating the spatial arrangement of your data is to derive a probability distribution from it, using SmoothKernelDistribution, KernelMixtureDistribution or a similar function.

I've reduced the density of the clusters to make the plots more illustrative.

data1 = RandomReal[{-0.1, 0.1}, {30, 2}];
data2 = RandomReal[{-1, 1}, {2*10^2, 2}];
data3 = RandomReal[{-0.3, -0.2}, {40, 2}];
data5 = Join[data1, data2, data3];


A contour plot will give you some idea of where the highest regions of data density exist:

ContourPlot[
Evaluate@PDF[SmoothKernelDistribution[data5], {x, y}], {x, -2, 2}, {y, -2, 2},
PlotRange -> All, PlotPoints -> 10]


You can interactively investigate how this varies with threshold by using manipulate:

Manipulate[
ContourPlot[
Evaluate@PDF[SmoothKernelDistribution[data5], {x, y}], {x, -2, 2}, {y, -2, 2},
PlotRange -> {{-2, 2}, {-2, 2}}, PlotPoints -> 15,
RegionFunction -> Function[{x, y, z}, z > t]],
{t, 0, 1}]


A 3D plot gives a different view:

Plot3D[Evaluate@PDF[KernelMixtureDistribution[data5], {x, y}], {x, -2,2}, {y, -2, 2},
PlotRange -> All, PlotPoints -> 30]


-