Here is my attempt to solve it as a post-processing way.
I will use two tools as bridges
- convert legend to graphics from Kuba
- get absolute padding from Heike
The basic idea is stated quite clearly in Szabolcs's answer for frame plots.
So first is define convertLegendToGraphics
, it converts legend to Graphics object.
ClearAll[convertLegendToGraphics];
convertLegendToGraphics[legend_] :=
First@Cases[ToBoxes@legend,
gr_GraphicsBox :> ToExpression[gr], \[Infinity]]
Then define getPadding
ClearAll[getPadding];
getPadding[g_] := Module[{im},
labelStyleOpt = Options[g, LabelStyle][[1, 2]];
im = Image[
Show[g /. _?ColorQ -> White,
LabelStyle -> Directive[labelStyleOpt, White],
Background -> White]];
BorderDimensions[im] + {{0, 1}, {1, 0}}];
Note that I do a little tweak here which I found is necessary if your plot has specified custom LabelStyle
or Styled PlotLabel
. The _?ColorQ -> White
has the ability to turn any explicit colored things into white including explicitly colored PlotLabel
. However, it will have an disadvantage, it make getPadding
only works for black frame or axis, so do not set fancy colored frame or axis.
then, finally the main part
ClearAll[sameHeightLegends];
sameHeightLegends[plot_] := Module[{},
plotPart = plot[[1]];
plotLabelOpt = Options[plotPart, PlotLabel][[1, 2]];
imageSize = ImageDimensions[plotPart];
verticalImageSize = imageSize[[2]];
legendPart =
Show[convertLegendToGraphics@plot[[2, 1]],
ImageSize -> {Automatic, verticalImageSize}];
{ph, pv} = getPadding[plotPart];
{phNoLabel, pvNoLabel} =
getPadding[Show[plotPart, PlotLabel -> None]];
{lh, lv} = getPadding[legendPart /. _?ColorQ -> White];
verticalPadding = pv;
If[plotLabelOpt === None,
Row[{Show[plotPart, ImageSize -> imageSize,
ImagePadding -> {ph, verticalPadding}],
Show[legendPart, ImagePadding -> {lh, verticalPadding}]}],
Row[{Show[plotPart, ImageSize -> imageSize,
ImagePadding -> {phNoLabel, pvNoLabel}],
Show[legendPart, ImagePadding -> {lh, verticalPadding}]}]]]
note that I treat labeled case separately.
Ok, here is an example which I found probably no other solutions can done it right.
plot = DensityPlot[x, {x, 0, 1}, {y, 0, 1},
PlotLabel -> Style[Column[{"line1", "line2"}], 30, Red],
BaseStyle -> Directive[Bold, 24],
FrameLabel -> {"x", "y"}, LabelStyle -> Green,
PlotLegends -> Automatic]
it will give
and
sameHeightLegends[plot]
gives
ps
This method doesn't need to set ImageSize
explictly and no special treatment to
PlotLegends
, so is full automatic.
Currently, this post-processing method has one drawback. To retrieve absolute dimension of Plot or absolute ImagePadding, we need rasterization, and every rasterization takes about 0.3 seconds on my computer, so it has some efficiency problem. Nevertheless, for most case, it is bearable. Hope there is some faster way to get absolute imagesize and imagepadding.