Return to Revisions

Here is my attempt to solve it as a post-processing way.

I will use two tools as bridges

1. convert legend to graphics from Kuba
2. 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.