Skip to main content

plotting - Perfect vertical alignment (centering) of PointLegend markers and their labels



I want to produce a stand-alone PointLegend for a bunch of plots which I generated. Unfortunately, the markers are slightly off-axis. I have applied all the options discussed here, which did improve things, but not to perfection. Let me demonstrate the issue:


layout[pairs_] := 
Row[Map[Row[{Pane[#[[1]], BaselinePosition -> Center],
Pane[#[[2]], BaselinePosition -> Center]},
Alignment -> {Center, Center}, Frame -> True] &, pairs, 1]]

p = PointLegend[

"DefaultPlotStyle" /. (Method /.
Charting`ResolvePlotTheme[Automatic, ListPlot]), Range[5],
LegendMarkers -> {Automatic, Large}, LegendLayout -> layout,
LegendFunction -> "Frame",
LabelStyle -> {FontFamily -> "Arial", FontSize -> 20},
Alignment -> Center]

enter image description here


The diamond at item 3 is too low and the square at item 2 is too high. Here a screenshot with a horizontal ruler to prove the shift:


enter image description here



It takes a while to really see what is wrong but one immediately realizes that things are not well aligned. I don't think this can be used in a presentation.


Are there any mode options to force a true centering of the markers?



Answer



Direct answer to the question (rewritten after the comments)


It is well known that the default markers are font glyphs and Mathematica can't position font glyphs precisely. If you need precise positioning, you should use primitive-based LegendMarkers. For this purpose I recommend my package PolygonPlotMarkers`:


Needs["PolygonPlotMarkers`"]

markers1 = {
Graphics[{FaceForm[ColorData[97][1]], EdgeForm[], PolygonMarker["Disk", 1]}],
Graphics[{FaceForm[ColorData[97][2]], EdgeForm[], PolygonMarker["Square", 1]}],

Graphics[{FaceForm[ColorData[97][3]], EdgeForm[], PolygonMarker["Diamond", 1]}],
Graphics[{FaceForm[ColorData[97][4]], EdgeForm[], PolygonMarker["UpTriangle", 1]}],
Graphics[{FaceForm[ColorData[97][5]], EdgeForm[], PolygonMarker["DownTriangle", 1]}]};

PointLegend[ColorData[97] /@ Range[5], Range[5], LegendMarkerSize -> 30,
LegendMarkers -> markers1, LegendLayout -> "Row",
LabelStyle -> {FontFamily -> "Arial", FontSize -> 30}]


legend




Let us add horizontal line and check how it looks at different font sizes:


overlay[legend_] := Module[{w, h}, {w, h} = ImageDimensions@Rasterize[legend, "Image"];
Graphics[{Inset[legend, {0, 0}, {0, 0}, Automatic], Red, Thick, Opacity[.5],
Line[{{-1, 0}, {1, 0}}]}, AspectRatio -> h/w, ImageSize -> w]]

t = Table[PointLegend[ColorData[97] /@ Range[5], Range[5], LegendMarkerSize -> 30,
LegendMarkers -> markers1, LegendLayout -> "Row",
LabelStyle -> {FontFamily -> "Arial", FontSize -> fs}], {fs, {20, 30, 50, 60}}];


overlay /@ t // Column


legends



Note that in the above all the markers are centered relative to their bounding boxes, while on the plot they are placed at their centers of mass. Another problem is that they are inscribed into identical boxes (determined by LegendMarkerSize) and hence have visibly different areas. Both problems can be solved at once by specifying sufficiently large symmetric PlotRange (I also show axes which intersect at the center of mass {0, 0}):


markers2 = Append[#, {PlotRange -> 1, 
Axes -> True, AxesOrigin -> {0, 0}, Ticks -> False}] & /@ markers1;

PointLegend[ColorData[97] /@ Range[5], Range[5], LegendMarkerSize -> 50,

LegendMarkers -> markers2, LegendLayout -> "Row",
LabelStyle -> {FontFamily -> "Arial", FontSize -> 30}] // overlay


legend



If one wish to have markers aligned relative to their bounding boxes and at the same time control their sizes, it is achievable by adding PlotRangePadding option without explicit PlotRange (the larger PlotRangePadding, the smaller will be marker):


markers1sized = 
MapThread[Append[#1, PlotRangePadding -> #2] &, {markers1, {.1, .2, 0, 0, 0}}];


PointLegend[ColorData[97] /@ Range[5], Range[5], LegendMarkerSize -> 30,
LegendMarkers -> markers1sized, LegendLayout -> "Row",
LabelStyle -> {FontFamily -> "Arial", FontSize -> 30}]


legend



PointLegend is fairly complicated function which has its own set of undocumented "features" what make it difficult to obtain exactly what you wish in every situation. In practice when only a standalone legend is needed it is often easier to construct the legend manually:


Grid[{Flatten@Transpose[{Append[#, ImageSize -> 30] & /@ markers1, Range[5]}]}, 
Alignment -> {Center, Center}, Spacings -> {{{0.8, 0.5}}, Automatic},

BaseStyle -> {FontFamily -> "Arial", FontSize -> 30}]


legend



Table[overlay@
Grid[{Flatten@Transpose[{Append[#, ImageSize -> 30] & /@ markers2, Range[5]}]},
Alignment -> {Center, Center}, Spacings -> {{{0.8, 0.5}}, Automatic},
BaseStyle -> {FontFamily -> "Arial", FontSize -> fs}], {fs, {20, 30, 40}}] // Column



column





Offset size, ImageSize and alignment of the markers


When the size of the markers specified in absolute units via Offset (please read "Description of the package" section in the linked post) the alignment of the markers may depend on LegendMarkerSize option of PointLegend (or ImageSize option of Graphics) when explicit PlotRange and/or ImagePadding for the marker isn't specified. This comes from how FrontEnd crops the plot when ImageSize becomes smaller. Here the red point shows the geometric center of the image, and red rectangle show complete plotting range (PlotRange + PlotRagePadding), axes intersect at the center of mass:


opts = {Axes -> True, AxesOrigin -> {0, 0}, Ticks -> False, Background -> LightBlue,
(*ImagePadding -> 0, *)
(*PlotRange -> {{-1, 1}, {-1, 1}},*)
Epilog -> {Red, AbsolutePointSize[5], Point[ImageScaled[{.5, .5}]],

EdgeForm[{Red, Thick, Opacity[1]}], FaceForm[],
Rectangle[Scaled[{0, 0}], Scaled[{1, 1}]]}};

Table[Graphics[{FaceForm[ColorData[97][2]], EdgeForm[],
PolygonMarker["UpTriangle", Offset[40]]}, opts, ImageSize -> {size, size},
BaselinePosition -> Axis], {size, {75, 60, 55, 50, 40, 30}}] //
Row[#, Spacer[5], Alignment -> {Center, Axis}] &


row




As one can see, when ImageSize is large, the center of the image coincides with the center of the plotting range almost exactly. But when ImageSize becomes smaller, relative plotting range is reduced and some ImagePadding is added around it non-symmetrically. Hence the center of the image doesn't coincide with the center of the plotting range anymore. We can fix it by disabling ImagePadding (uncomment ImagePadding -> 0 in opts above):



row



Uncommenting also PlotRange -> {{-1, 1}, {-1, 1}} doesn't affects the result because it is the default PlotRange when the plot doesn't contain "tangible" primitives:



row



But the straighforward (and correct) approach to align markers with Offset sizes at their centers of mass is to specify BaselinePosition -> Axis:



opts = {};
markers3 := {
Graphics[{FaceForm[ColorData[97][1]], EdgeForm[],
PolygonMarker["Diamond", Offset[20]]}, opts],
Graphics[{FaceForm[ColorData[97][2]], EdgeForm[],
PolygonMarker["UpTriangle", Offset[20]]}, opts],
Graphics[{FaceForm[ColorData[97][3]], EdgeForm[],
PolygonMarker["DownTriangle", Offset[20]]}, opts]};

opts = {BaselinePosition -> Axis, Axes -> True, Ticks -> False};

l = PointLegend[ColorData[97] /@ Range[3], Range[3], LegendMarkerSize -> 35,
LegendMarkers -> markers3, LegendLayout -> "Row",
LabelStyle -> {FontFamily -> "Arial", FontSize -> 30}]


legend



Aligning such markers relative to bounding boxes is more difficult and can be achieved manually by adding ImageMargins option (which is defined outside of ImageSize):


markers4 = MapThread[
Append[#1, ImageMargins -> {{0, 0}, #2}] &, {markers3, {{0, 0}, {0, 7}, {7, 0}}}];

PointLegend[ColorData[97] /@ Range[3], Range[3], LegendMarkerSize -> 35,
LegendMarkers -> markers4, LegendLayout -> "Row",
LabelStyle -> {FontFamily -> "Arial", FontSize -> 30}]


legend





Internal structure of generated legend


By applying ToBoxes to our legend we can see its internal structure on the box level. It is TemplateBox with first argument being the list of labels. The option DisplayFunction contains a function which will be dynamically applied to the first argument in order to generate a static box structure for on-screen display. We see that this function returns GridBox where the pairs consisted of GraphicsBox (containing InsetBox with our marker) and a placeholder for the corresponding label reside. Each GraphicsBox already contains options including BaselinePosition, rows are set to be aligned to Baseline:



Cases[ToBoxes@l, 
gb_GridBox :> (gb /.
g_GraphicsBox :>
"GraphicsBox"[Skeleton[…], Options[g, BaselinePosition]]), -1, 1]


{GridBox[{{
"GraphicsBox"[<<…>>, {BaselinePosition -> Scaled[0.157143] -> Baseline}], #1,
"GraphicsBox"[<<…>>, {BaselinePosition -> Scaled[0.157143] -> Baseline}], #2,
"GraphicsBox"[<<…>>, {BaselinePosition -> Scaled[0.157143] -> Baseline}], #3}},

GridBoxAlignment -> {"Columns" -> {Center, Left}, "Rows" -> {{Baseline}}},
AutoDelete -> False, GridBoxDividers -> {"Columns" -> {{False}}, "Rows" -> {{False}}},
GridBoxItemSize -> {"Columns" -> {{All}}, "Rows" -> {{All}}},
GridBoxSpacings -> {"Columns" -> {{0.8, 0.5}}}]}

We see that BaselinePosition of GraphicsBox aligns to Baseline not its bottom, but the fraction 1/6 (= 0.157143) of its height (this number isn't constant). Fortunately when BaselinePosition is specified in the marker, the setting from the parent GraphicsBox is ignored.


These observations suggest a method to cure the legend. Just set up rows to be aligned at the Center:


alingRowLegend[legend_] := 
RawBoxes[ToBoxes@legend /. ("Rows" -> {{Baseline}}) -> ("Rows" -> {{Center}})]

Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...