11
$\begingroup$

Suppose you have a ListPlot, and there are certain points you wish to emphasize belong to particular group. I would like to make a function that automatically draws an ellipsoid around a select group of points. Below I am including an example image of the end goal. Thoughts? Goal

Update 1

So using @Szabolcs answer, I got the following:

Legended[Graphics[{{{Opacity[0.3], EdgeForm[Black], FaceForm[Red], 
     Scale[BoundingRegion[redPoints, "FastStadium", 
       WorkingPrecision -> 10], 1.1]}, {PointSize[Medium], 
     Point[redPoints]}}, {{Opacity[0.3], EdgeForm[Black], 
     FaceForm[Blue], 
     Scale[BoundingRegion[brainPoints, "FastStadium", 
       WorkingPrecision -> 10], 1.1]}, {PointSize[Medium], 
     Point[bluePoints]}}, {PointSize[Medium], Point[otherPoints]}}, 
  Axes -> True, PlotRange -> {{0, 1.2}, {0, 1.1}}, 
  ImageSize -> Large], 
 SwatchLegend[{Red, Blue, White}, {"Red Region", "Blue Region", 
   "Other"}]]

enter image description here

However, I am unable to add Callouts.... thoughts? Also, how to make the Stadium a bit fatter?

|improve this question
$\endgroup$
12
$\begingroup$

I've never used this function before, but BoundingRegion seems to be able to do the bulk of the work.

For example,

pts = {#1, #1 + #2} & @@@ RandomReal[1, {15, 2}];

Graphics[{
  {EdgeForm[Black], FaceForm[LightBlue], 
   Scale[BoundingRegion[pts, "FastStadium"], 1.1]},
  Point[pts]
  }]

enter image description here

There's also "FastEllipse", but for some reason it gives less useful looking results.

|improve this answer
$\endgroup$
  • $\begingroup$ thanks. this is quite useful. But does it work also on Mathematica 10? I guess not... $\endgroup$ – Luigi Sep 22 '16 at 9:01
  • $\begingroup$ @Szabolcs this is useful as Luigi stated. However, what is the best way to integrate this into ListPlot? The reason is to also integrate Callout and have axes, etc $\endgroup$ – SumNeuron Sep 22 '16 at 9:07
  • $\begingroup$ @Szabolcs ok, so I have started reading the documentation regarding Bounding Regions and what not and will continue doing so. From my understanding ListPlot is just a fancy function that uses a ton of Graphics, but doesn't require the user to do so. So what would be easier: rebuilding ListPlot from the directives with your above code, or adding this BoundingRegions to ListPlot? $\endgroup$ – SumNeuron Sep 22 '16 at 9:16
  • $\begingroup$ @Szabolcs also I am confused as BoundingRegion is not listed as a primitive or directive that can be used in Graphics $\endgroup$ – SumNeuron Sep 22 '16 at 9:21
  • $\begingroup$ @Szabolcs also why do you use Scale? $\endgroup$ – SumNeuron Sep 22 '16 at 9:32
4
$\begingroup$

Following @Szabolc's example, I generalized it for others to use. Does anyone know how to allow one to directly pass ListPlot options into this function? Alternatively, one could redefine the function to just take the ListPlot object. For completeness I am adding this ListPlot accepting form below.

points = {#1, #1 + #2} & @@@ RandomReal[1, {15, 2}];
group1 = points[[1 ;; 5]];
group2 = points[[10 ;; 15]];

Options[ListPlotGroups] = {"FatFactor" -> 1, "Color" -> "Pastel"};
ListPlotGroups[points_, groups_, OptionsPattern[]] := Module[
  {numGroups, fatFactor, stadiums, colorIndexes, colors},
  numGroups = Length@groups;
  fatFactor = OptionValue["FatFactor"];
  stadiums = 
   Table[BoundingRegion[groups[[i]], "FastStadium"], {i, numGroups}];
  (stadiums[[#]][[-1]] = stadiums[[#]][[-1]] fatFactor) & /@ 
   Range[numGroups];

  colorIndexes = 
   Riffle[Range[0, 1, 1/numGroups], 
     Reverse[Range[0, 1, 1/numGroups]]][[1 ;; 
      Length@Range[0, 1, 1/numGroups]]];
  colors = 
   Table[ColorData[OptionValue["Color"]][colorIndexes[[i]]], {i, 
     numGroups}];
  Show[ListPlot[points], 
   Graphics[
    Table[{Opacity[0.3], EdgeForm[Black], FaceForm[colors[[i]]], 
      stadiums[[i]]}, {i, numGroups}]]]
  ]


ListPlotGroups[points, {group1, group2}, "FatFactor" -> 1]

enter image description here

ListPlotGroups[points, {group1, group2}, "FatFactor" -> .5]

enter image description here

This version takes a ListPlot and allows for you specify a "FatFactor" for each group.

  Options[AddStadiums] = {"FatFactor" -> 1, "Color" -> "Pastel"};
  AddStadiums[listPlot_, groups_, OptionsPattern[]] := Module[
  {numGroups, fatFactor, stadiums, colorIndexes, colors},
  numGroups = Length@groups;
  fatFactor = OptionValue["FatFactor"];


  stadiums = 
   Table[BoundingRegion[groups[[i]], "FastStadium"], {i, numGroups}];
  If[Length@OptionValue["FatFactor"] == 0,
   (stadiums[[#]][[-1]] = stadiums[[#]][[-1]] fatFactor) & /@ 
     Range[numGroups];,
   If[Length@OptionValue["FatFactor"] == 1,
     (stadiums[[#]][[-1]] = stadiums[[#]][[-1]] First@fatFactor) & /@ 
       Range[numGroups];,
     (stadiums[[#]][[-1]] = stadiums[[#]][[-1]] fatFactor[[#]]) & /@ 
       Range[numGroups];
     ];
   ];


  colorIndexes = 
   Riffle[Range[0, 1, 1/numGroups], 
     Reverse[Range[0, 1, 1/numGroups]]][[1 ;; 
      Length@Range[0, 1, 1/numGroups]]];
  colors = 
   Table[ColorData[OptionValue["Color"]][colorIndexes[[i]]], {i, 
     numGroups}];
  Show[listPlot, 
   Graphics[
    Table[{Opacity[0.3], EdgeForm[Black], FaceForm[colors[[i]]], 
      stadiums[[i]]}, {i, numGroups}]]]
  ]
|improve this answer
$\endgroup$
  • $\begingroup$ @Szabolcs how would you improve the syntax of this function? $\endgroup$ – SumNeuron Sep 22 '16 at 14:38

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.