5
$\begingroup$

I need some help with code optimization and compactness.

I have a set of two-dimensional points and I can use the Mathematica function FindClusters to find 4 clusters. I'd like to plot the points together with 4 circles centered at the cluster centroids and with radii equal to the average distance between the points of the cluster and its centroid.

Up to now I've come up with the following code:

data = {{-1.1, 2.6}, {3.9, -0.8}, {4.2, -3.7}, {3.3, 3.5}, {3.9, 
    5.2}, {4.1, -4.8}, {3.8, 3.7}, {5.6, 0.1}, {3.1, -5.2}, {-0.9, 
    2.3}, {2.9, 4.1}, {-2.3, 3.9}, {-2.5, 3.}, {2.6, -5.5}, {5.2, 
    1.9}, {-0.7, 1.3}, {0.9, 2.8}, {-1.5, 3.3}, {3.8, 
    1.2}, {2.6, -5.1}, {-0.8, 3.2}, {4.7, 0.7}, {3., 3.}, {3.9, 
    3.6}, {4.5, 1.4}, {4.2, 1.3}, {-1.1, 2.6}, {4.8, 
    2.4}, {3.3, -3.5}, {3.2, -4.6}, {3.3, -4.9}, {3., 3.5}, {0.7, 
    2.1}, {3.2, -4.3}, {-2., 0.5}, {-1.2, 2.}, {-1.6, 1.8}, {-3.5, 
    3.7}, {4.8, 0.2}, {3.3, 2.4}, {-0.1, 2.1}, {-1.3, 2.5}, {4.4, 
    3.9}, {3.5, 0.2}, {0.1, 2.9}, {-1., 1.6}, {-1.4, 4.5}, {3.2, 
    2.5}, {-1.6, 
    2.4}, {2.6, -5.1}, {-3.4, -2.5}, {-3.6, -2.4}, {-3.7, -3.0}, \
{-3.26, -3.8}, {-3.8, -2.8}, {-3.5, -3.3}};
clusterdata = 
  FindClusters[data, 4, 
   Method -> {"Agglomerate", "Linkage" -> "Complete"}];
centroids = Mean /@ clusterdata;
radii = Table[
   Mean[Map[Norm, 
     clusterdata[[j]] - 
      Table[Map[Mean, clusterdata][[j]], {Length[
         clusterdata[[j]]]}]]], {j, 1, Length[clusterdata]}];
ListPlot[clusterdata, PlotRange -> {{-6, 6}, {-6, 6}}, 
 AspectRatio -> 1, PlotStyle -> PointSize[0.03], 
 Epilog -> 
  Table[Circle[#1, #2] &[centroids[[k]], radii[[k]]], {k, 1, Length[clusterdata]}]]

enter image description here

It works, but I'm positive that the same output (starting from, say, the clusterdata list) could be gotten with a much simpler, compact and elegant code and with the wise use of the Map and Apply functions, that are not very easy to control and manage for an occasional Mathematica user like me.

My question is not only about "elegance" but it's also motivated by the fact that this snippet of code must be very much optimized since, in the project I'm working on, the plot must be dynamically updated with around 100 fast moving points.

$\endgroup$
6
$\begingroup$
rF1 = Mean[Norm /@ Standardize[#, Mean, 1 &]] &;
rF2 = Function[{x}, Mean[Norm[# - Mean[x]] & /@ x]];

radii1 =rF1 /@ clusterdata;
radii2 = rF2 /@ clusterdata;
radii == radii1 == radii2
(* True *)

circles = Circle @@@ Thread[{centroids, radii}];

ListPlot[clusterdata, AspectRatio -> 1, PlotRange -> {{-6, 6}, {-6, 6}}, 
         PlotStyle -> PointSize[0.03],  Epilog -> circles]

enter image description here

You can also use Graphics:

points = {#, Point@#2} & @@@ MapIndexed[{ColorData[1, "ColorList"][[#2[[1]]]], #} &, clusterdata];
pr = Round@Through@{Min, Max}@clusterdata;

Graphics[{PointSize[.03], circles, points}, PlotRange -> {pr, pr}, Axes -> True]

enter image description here

$\endgroup$
5
$\begingroup$
clusterdata = FindClusters[data, 4, Method -> {"Agglomerate", "Linkage" -> "Complete"}];
ListPlot[clusterdata, AspectRatio -> 1, PlotRange -> {{-6, 6}, {-6, 6}}, PlotStyle -> PointSize[0.03], 
 Epilog -> MapThread[Circle, {Mean /@ clusterdata, 1/Sqrt[2] Norm /@ Variance /@ clusterdata}]]
$\endgroup$
2
  • 3
    $\begingroup$ Even simpler: Epilog -> MapThread[Circle, {centroids, radii}] $\endgroup$ – Mr.Wizard Jan 15 '15 at 17:29
  • $\begingroup$ Actually "1/Sqrt[2] Norm /@ Variance /@ clusterdata" doesn't give the mean distance to the cluster centroid as I intended, whilst kguler's function Function[{x}, Mean[Norm[# - Mean[x]] & /@ x]]; produces exactly what I intended... $\endgroup$ – Luca M Jan 21 '15 at 13:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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