Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Clustering 2D plot in Mathematica

laListe={{{{10, 17}, 1}, {{33, 12}, 1}, {{32, 17}, 1}, {{9, 10},1}, 
         {{22, 24}, 1},{{27, 6}, 2}, {{25, 13}, 2}, {{30, 9}, 2}}, 
         {{{14, 12}, 1},{{19, 17}, 1}, {{7, 21}, 1}, {{7, 24},1}, 
         {{27, 19}, 1}, {{12, 16}, 2}, {{13, 20}, 2}, {{20, 22}, 2}}}

FrameXYs = {{4.32, 3.23}, {35.68, 26.75}}


Row[Function[compNo, 
             Graphics[{White, EdgeForm[Thick], 
             Rectangle @@ FrameXYs, 
             Black, 
             Disk[Sequence @@ laListe[[compNo, #]]] & /@ 
             Range[Length@laListe[[compNo]]]}, ImageSize -> 300]] /@ 
             {1, 2}]

enter image description here

I would like to find a way to cluster those disk given their proximity to each other. Does Mathematica have built in feature to do such thing ?

EDIT

As I tried FindClusters I yet encounter several inconvenience :

With :

list1={{{24.413, 6.5978}, {7.68887, 7.2147}, {29.357, 13.2822}, 
       {6.22436, 9.7145}, {22.7162, 17.7198}, {13.6851, 5.7635}, 
       {18.8062, 12.9946}, {8.04889, 16.7414}}}

Does FindClusters dislkike Decimals :

FindClusters[Flatten[list1,1]]

Out :

  {{{{24.413, 6.5978}, {7.68887, 7.2147}, {29.357, 13.2822}, 
     {6.22436,9.7145}, {22.7162, 17.7198}, {13.6851, 5.7635}, 
     {18.8062,12.9946}, {8.04889, 16.7414}}}}

Whereas :

  FindClusters[Flatten[Round[list1], 1]]

Out :

   {{{24, 7}, {29, 13}, {23, 18}, {14, 6}, {19, 13}}, 
    {{8, 7}, {6, 10}, {8, 17}}}

Then, to do this I had to get rid of the Disks Diameter which is important to me as visual cluster. Then I would like to capture alignment. When 5 disks are not grouped but aligned. And as I tested it on a few composition it does not find those as such.

On thing I am trying is tho "Pointize" the disks using the following :

pointize[{{x_,y_},r_},size_:12] :=
                                  Table[{x+r Cos[i ((2\[Pi])/size)],
                                  y+r Sin[i ((2\[Pi])/size)]},{i,0,size}]

I used that initially to compute ConvexHullArea of those disks. I feel it could help my need of taking into accound the radius, but the implementation is tricky and I am not even sure if it is relevant

Also, I hope it was only the decimals issue, but I could not use FindClusters[list] as such but had to give it the number of cluster I want FindClusters[list,3], whereas what I want is to have the same algorithm that can find different cluster number on different composition.

Would you think of particular settings &/or distance function to do so with FindClusters?

EDIT

I found something interesting thanks to previous tricks learned thanks to experts here. Just an idea, I need to fin a way quantify that and put the new image in a matrix form or so to use .

comp1 = Graphics[{White, Rectangle @@ FrameXYs, Black, 
     Disk[Sequence @@ laListe[[1, #]]] & /@ Range[Length@laListe[[1]]]},
     ImageSize -> 300]

enter image description here

     Binarize[ImageCorrelate[comp1, GaussianMatrix[40]], .95]

enter image description here

like image 506
500 Avatar asked Aug 02 '26 14:08

500


2 Answers

Yes, FindClusters should do what you want. There is a tutorial. You might have to flatten the data to be an n times 3 matrix.

like image 69
Verbeia Avatar answered Aug 04 '26 12:08

Verbeia


Alternatively, you could use something like:

Table[Colorize[
  MorphologicalComponents[Blur[ColorNegate@comp1, i], .05]], {i, 1, 60, 10}]

enter image description here

You may also use Dilation, depending upon what kind of regions you want as a result

Table[Colorize@
  MorphologicalComponents@Dilation[ColorNegate@comp1, DiskMatrix@i], {i,1,60,10}]

enter image description here

BTW, here you have a way to use FindClusters, not very efficient and probably with non-intuitive results:

ImageRotate[Rasterize[
  Show[
    ListPlot@
    FindClusters[Position[ImageData@Binarize@ColorNegate@comp1, 1, {2}], 3],
  Axes -> False, AspectRatio -> Automatic]], 3 Pi/2]

enter image description here

Edit

Probably you can manage the FindClusters options to get better results. For example:

ImageRotate[Rasterize[Show[
   ListPlot@
    FindClusters[
     Position[ImageData@Binarize@Rasterize[ColorNegate@comp1, RasterSize -> 200], 
     1, {2}], 
    3, Method -> {"Agglomerate", "Linkage" -> "Complete"}], 
   Axes -> False, AspectRatio -> Automatic]], 3 Pi/2]

enter image description here

And from here, you may also go to the Convex Hull:

<< ComputationalGeometry`
fc = FindClusters[
       Position[
         ImageData@Binarize@
            Rasterize[ColorNegate@comp1, RasterSize -> 200], 
       1, {2}], 
     3, Method -> {"Agglomerate", "Linkage" -> "Complete"}];
ImageRotate[Graphics[Polygon@(#[[ConvexHull[#]]]) & /@ fc, Frame->True], 3 Pi/2]

enter image description here

like image 37
Dr. belisarius Avatar answered Aug 04 '26 12:08

Dr. belisarius