7
$\begingroup$

When I create plots, I usually make a legend box which I then manually have to place within the plot using the Placed[] option. However, since it is manual, it means that I always need to adjust it or I will risk covering a part of the plot, something that often happens when I batch produce plots. I would therefore like to have an Automatic option, similar to the "best" placement type in Python matplotlib, that puts the legend within the plot, but not covering anything. If I simply use "Automatic", Mathematica will place the legend outside of the plot to the right, but this is often a waste of space.

Example:

ListPlot[{
  Table[{i, Sin[i]}, {i, 0, 10}],
  Table[{i, Cos[i]}, {i, 0, 10}]
  }
 , ImageSize -> 1000,
 Joined -> True, PlotMarkers -> Automatic,
 PlotLegends -> 
  Placed[LineLegend[
    Map[Style[#, FontSize -> 24, 
       FontFamily -> "TimesNewRoman"] &, {"sin", "cos"}], 
    Spacings -> {0.15, -0.2}, 
    LegendFunction -> (Framed[#, RoundingRadius -> 5, 
        FrameStyle -> Gray, Background -> White] &)]
   , Scaled[{0.87, 0.75}]]
 ]

plotExample

I guess that one option would be to make a custom function that, from the input data, determines the plot range, finds the biggest empty space in the plot, and then uses these coordinates for the Placed[] option. However, I think that this will require a lot of tweaking, to accomodate for 1) a varying number of entries in the legend and 2) the feature in Mathematica where the shape of the legend box can vary depending on placement and number of entries.

It would also not be very "pretty" to simply use the biggest white space -- often the upper right corner is large enough even though it might not be the biggest white space, and when it is large enough, it should take precedence.

$\endgroup$
1
  • 1
    $\begingroup$ This post addresses very similar problem, however, the accepted solution does not work out of the box. Some adjustments are needed. $\endgroup$
    – yarchik
    Nov 11 '21 at 7:45
9
+100
$\begingroup$
legend = LineLegend[ColorData[97] /@ Range[5], 
   Map[Style[#, FontSize -> 24, Magenta, FontFamily -> "TimesNewRoman"] &, 
      {"sin", "cos", "blah", "blah", "blah"}], 
   Spacings -> {0.15, 1}, LegendMarkers -> Automatic, 
   LegendFunction -> 
       (Framed[#, RoundingRadius -> 5, FrameStyle -> Cyan, Background -> None] &)];

lp = ListPlot[{Table[{i, Sin[i]}, {i, 0, 10}], 
    Table[{i, Cos[i]}, {i, 0, 10}]}, ImageSize -> 1000, 
   Joined -> True, PlotMarkers -> Automatic, Frame -> True, 
   FrameTicks -> None, Axes -> False];

Legended[Show[lp, FrameTicks -> Automatic], 
 Placed[legend, Scaled[{0.87, 0.75}]]]

enter image description here

legenddims = Rasterize[legend, "RasterSize"];

Binarize and dilate lp with a kernel that depends on legenddims:

dilatedimage = ColorNegate @
    Dilation[ColorNegate@Binarize[lp], ConstantArray[1, Reverse@legenddims]];

Overlay[{dilatedimage, lp}]

enter image description here

If the legend is centered in any of the white pixels it will not touch the plot lines.

Centroids of the polygons as candidate positions for the legend:

centroids = RegionCentroid /@ MeshPrimitives[ImageMesh[dilatedimage], 2];

preferredposition = ImageDimensions @ lp (* top-right corner *)

The scaled position closest to preferredposition:

legendposition = First @ 
   Nearest[centroids, preferredposition, 1] / ImageDimensions[lp]
{0.942151, 0.804216}
Legended[Show[lp, FrameTicks -> Automatic], Placed[legend, legendposition]]

enter image description here

preferredposition = {0, 0};  (* bottom-left corner *)  

legendposition = First @ 
   Nearest[centroids, preferredposition, 1] / ImageDimensions[lp]
{0.0989771, 0.265792}
Legended[Show[lp, FrameTicks -> Automatic], Placed[legend, legendposition]]

enter image description here

Pick a random point in ImageMesh[dilatedimage] to place the legend:

SeedRandom[7777]

Legended[Show[lp, FrameTicks -> Automatic], 
 Placed[legend,RandomPoint[ImageMesh[dilatedimage]] / ImageDimensions[lp]]]

enter image description here

Dilated/binarized image and legend positions:

DynamicModule[{loc = {0, 0}}, 
 LocatorPane[Dynamic @ loc, 
  Overlay[{dilatedimage, lp}], 
  Appearance -> legend]]

enter image description here

$\endgroup$
3
  • $\begingroup$ Wow, this is really cool and works even better than I imagined. Thank you so much! I need to wait 12 hours to award you the bounty. $\endgroup$
    – a20
    Nov 11 '21 at 7:48
  • 3
    $\begingroup$ Very nice. Some other ideas to find centers: PixelValuePositions[Pruning[MaxDetect[DistanceTransform[DeleteSmallComponents[dilatedimage]]]], 1] or ComponentMeasurements[DeleteSmallComponents[dilatedimage], "Medoid"]. $\endgroup$
    – Greg Hurst
    Nov 11 '21 at 13:16
  • 3
    $\begingroup$ Also it might make more sense to use ConnectedMeshComponents instead of MeshPrimitives. Compare: reg = DiscretizeRegion[RegionUnion[Disk[], Disk[{3, 0}]]]; Length /@ {MeshPrimitives[reg, 2], ConnectedMeshComponents[reg]} $\endgroup$
    – Greg Hurst
    Nov 11 '21 at 13:20

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.