46

I need to align the y-axes in the plots below. I think I'm going to have to do some rasterizing and searching for vertical lines, then vary x and w. Is there a better way?

a = ListPlot[{{0, 0}, {16, 20}},
   PlotRange -> {{0, 16}, {0, 20}}, Frame -> True];
b = ListPlot[{{0, 0}, {160000, 200000}}, 
   PlotRange -> {{0, 160000}, {0, 200000}}, Frame -> True];
x = 3.1; w = 5;
Graphics[{LightYellow, Rectangle[{0, 0}, {7, 8}], 
  Inset[a, {x, 5.5}, Center, {w, Automatic}], 
  Inset[b, {3.1, 2.2}, Center, {5, Automatic}]}, 
 PlotRange -> {{0, 7}, {0, 8}}, ImageSize -> 300]

enter image description here

Chris Degnen
  • 30,927
  • 2
  • 54
  • 108

2 Answers2

35

This is a common (and very big) annoyance when creating graphics with subfigures. The most general (but somewhat tedious) solution is setting an explicit ImagePadding:

GraphicsColumn[
 {Show[a, ImagePadding -> {{40, 10}, {Automatic, Automatic}}], 
  Show[b, ImagePadding -> {{40, 10}, {Automatic, Automatic}}]}]

Mathematica graphics

This is tedious because you need to come up with values manually. There are hacks to retrieve the ImagePadding that is used by the Automatic setting. I asked a question about this before. Using Heike's solution from there, we can try to automate the process:

padding[g_Graphics] := 
 With[{im = Image[Show[g, LabelStyle -> White, Background -> White]]},
   BorderDimensions[im]]

ip = 1 + Max /@ Transpose[{First@padding[a], First@padding[b]}]

GraphicsColumn[
 Show[#, ImagePadding -> {ip, {Automatic, Automatic}}] & /@ {a, b}]

The padding detection that's based on rasterizing might be off by a pixel, so I added 1 for safety.

Warning: the automatic padding depends on the image size! The tick marks or labels might "hang out" a bit. You might need to use padding@Show[a, ImageSize -> 100] to get something that'll work for smaller sizes too.

I have used this method myself several times, and while it's a bit tedious at times, it works well (much better than figuring out the image padding manually).

Community
  • 1
Szabolcs
  • 234,956
  • 30
  • 623
  • 1,263
20

While Szabolcs's method works beautifully for standard plots, anything more complicated with nonuniform AspectRatios fails. Let's generate some plots with varying image padding, sizes and ratios:

a = Plot[2 Sin[x] + x, {x, 0, 16}, Filling -> Bottom, 
   PlotRange -> {{0, 16}, {0, 20}}, Frame -> True, ImageSize -> 400];
b = ArrayPlot[RandomReal[{0, 1}, {20, 20}], 
   PlotRange -> {{0, 160000}, {0, 200000}}, Frame -> True, 
   FrameTicks -> {
     {MapIndexed[{First@#2, #1} &, Range[0, 160000, 8000]], None},
     {MapIndexed[{First@#2, Rotate[#1, -\[Pi]/2]} &, Range[0, 200000, 10000]], None}},
   ImageSize -> 300, AspectRatio -> 1, ColorFunction -> (Hue[#1, .7, 1] &)];
c = BarChart[{1, 2}, Frame -> True, ImageSize -> 200, AspectRatio -> 2];

Row@{a, b, c}

enter image description here

The default layout is far from visually appealing. Here I provide the package-ready plotRow function that builds on Szabolcs's (and Heike's) approach when estimating padding and also accounts for AspectRatios by querying them directly from plots. One only has to specify the desired vertical size (200) to easily align frames.

padding[g_Graphics] := With[{im = 
   Image[Show[g, LabelStyle -> White, Background -> White]]}, BorderDimensions@im] + 1;
plotRow[g : {__Graphics}, y_] := Module[{ip = padding /@ g, ar},
   ip = ReplacePart[ip, {_, 2} :> Max /@ Transpose[Last /@ ip]];
   ar = (AspectRatio /. Options@# /. Automatic -> 1./GoldenRatio) & /@ g // N;
   MapThread[Show[#1, ImagePadding -> #2, AspectRatio -> #3, 
      ImageSize -> ({y/#3, y} + Plus @@@ #2)] &, {g, ip, ar}]
 ];

Row@plotRow[{a, b, c}, 200]

enter image description here

The same can be easily done for a vertical layout by modifying the appropriate parts of plotRow.

István Zachar
  • 47,032
  • 20
  • 143
  • 291
  • 3
    This is a nice idea, but it is not yet robust. Consider the case of Plot[Sinc[x], {x, 0, 10}, PlotLabel -> Style["Title", Opacity[1], Red, 22]] -- the explicit style overrules your LabelStyle -> White. Though not as clean you might use something like: With[{rec = Rectangle[{0, 0}, {1, 1}]}, Show[#, PlotRangeClipping -> None, Epilog -> {Black, ImageScaled /@ rec, Red, Scaled /@ rec}] ] & – Mr.Wizard Apr 10 '13 at 12:38