How can I put common frame ticks on the leftmost of a row of graphics?

Question

I have a function which plots a response behavior of model variables holding a reference value constant (the green dot in the examples below) over a common PlotRange (achieved by plotting the functions and extracting the AbsoluteOptions). As we can see below, the FrameTicks chew up a lot of screen real estate if I have the plots laid out as a row.

What I’d like to do is to have the automatically generated FrameTicks on the leftmost graphic and the others implicitly sharing the tick labels.

I'd prefer to keep the subplots separate to allow users to enable FrameTicks on the x-axis.

Any suggestions?

SOLUTION:

I kept searching Stack Exchange and stumbled upon this post

Exporting an image so that the PlotRange has a fixed size in the output

which offered the magic ju-ju incantation of "ImageSize → Automatic → size" which seems to specify the plot ImageSize rather than the plot plus ticks & labels.

If we continue with kglr's example and define

tickstyles = Join[
{{{Automatic, None}, {None, None}}},
ConstantArray[{None, None}, {3}]
]

as well as tap into Okkes' suggestion of ImagePadding

paddingSet = Join[
{{{Automatic, 3}, {Automatic, 10}}},
ConstantArray[{{3, 3}, {Automatic, 10}}, {3}]
]

Then executing

Grid[{
Plot[
  #, {x, 0, 2 Pi}, 
  Frame -> True, PlotStyle -> #2,FrameLabel -> #3, FrameTicks -> #4,      
  ImageSize -> Automatic -> 75, 
  GridLines -> Automatic, PlotRange -> {-20000, 20000}, 
  ImagePadding -> #5
  ] & @@@ Transpose[{functions, styles, labels, tickstyles, paddingSet}]}, 
Spacings -> {0, 0}]

Results in an acceptable output of:

The downside is that I don't have total control of the aggregated ImageSize since the FrameTicks and FrameLabels are "off-budget"; however, that is not an issue for my application.

In contrast, if we were to specify only ImageSize → 75, we would get the standard-issue ugliness.

In the interests of completeness, my approach is to generate a plotSet of the graphics and extract the PlotRange out of the resulting graphics and use Show to apply the result to the plotSet, e.g.,

If[commonPlotRange && MatchQ[plotRange, All | Automatic], 
  plottedResponseRange = {Min@#3, Max@#4} & @@ Transpose[
    Flatten@AbsoluteOptions[plotSet, PlotRange] /. Rule[
      PlotRange, rng_] :> Flatten[rng]
  ];
plotSet = Show[#, PlotRange -> {All, plottedResponseRange}] & /@ plotSet];

Once the magic incantations have been discovered, life becomes much easier!

Thanks much,

Mark.

Answer 1

How about this. Play with imgPad and ImageSize if it is necessary.

range = Range[0, 15000, 5000];
ticks1 = {range /. a_?NumericQ :> {a, a/1000}, 
   range /. a_?NumericQ :> {a, ""}};
ticks2 = {range /. a_?NumericQ :> {a, ""}, 
   range /. a_?NumericQ :> {a, ""}};
opt = {Frame -> True, ImagePadding -> imgPad, 
   FrameStyle -> Directive[Black, 20]};
imgPad = {{30, 1}, {30, 20}};
p1 = Plot[x, {x, 0, 15000}, FrameTicks -> {ticks1, None}, 
   FrameLabel -> Style["film+Guage+mil", 20, Brown], Evaluate@opt];
p2 = Plot[x, {x, 0, 15000}, FrameTicks -> {ticks2, None}, 
   ImagePadding -> imgPad, 
   FrameLabel -> Style["blow+Up+Ratio", 20, Orange], Evaluate@opt];
p3 = Plot[x, {x, 0, 15000}, FrameTicks -> {ticks2, None}, 
   ImagePadding -> imgPad, 
   FrameLabel -> Style["output+llbjr", 20, Green], Evaluate@opt];
Multicolumn[{Show[p1, 
   Epilog -> 
    Text[Row[{Style["\[Times]", 20], Style[Superscript[10, 3], 17]}], 
     Offset[{0, 10}, Scaled[{0, 1}]], {-1, 0}], 
   PlotRangeClipping -> False], p2, p3}, 3(*# of column*), Spacings -> {0, 0}]

Answer 2

functions = {Sin[x], Sin[2 x], Sin[3 x], Sin[4 x]}  Range[4];
styles = Thread[{Thick, ColorData[97] /@ Range[4]}];
xlabels = List /@ Thread[{"xlabel" <> ToString[#] & /@ Range[4], None}];
ylabels = List /@ Thread[{Prepend[ConstantArray[Style["ylabel", FontOpacity -> 0], 
       Length[functions] - 1], "ylabel"], None}];
labels = Join[ylabels, xlabels, 2];
tickstyles = Prepend[ConstantArray[{{FontOpacity -> 0, Automatic}, {Automatic, 
  Automatic}}, Length[functions] - 1], {{Automatic, Automatic}, {Automatic,  Automatic}}];

Grid[{Plot[ #, {x, 0, 2 Pi}, Frame -> True, PlotStyle -> #2, 
     FrameLabel -> #3, FrameTicksStyle -> #4, ImageSize -> 300, 
     PlotRange -> {-5, 5}] & @@@ Transpose[{functions, styles, labels, tickstyles}]}, 
  Spacings -> {0, 0}]

Use

tickstyles = Prepend[ConstantArray[{{FontOpacity -> 0,  Automatic}, 
     {FontOpacity -> 0, Automatic}}, Length[functions] - 1], 
   {{Automatic, Automatic}, {FontOpacity -> 0, Automatic}}]

to get

Answer 3

You might be interested in the PlotGrid function of the ForScience` package (which is mostly written by me). It arranges a 2D list of plots into a grid with proper alignment, no matter what kind of padding the individual plots have. A potential advantage compared to other, more manual solutions is that the resulting graphics expression can be freely resized without breaking any of the alignment.

Here is how you would use it in your case (the package includes full documentation of the function):

(* load the package *)
<< ForScience`

(* set up the plots *)
functions = {Sin[x], Sin[2 x], Sin[3 x], Sin[4 x]} Range[4];
styles = Thread[{Thick, ColorData[97] /@ Range[4]}];

plots = MapThread[
  Plot[
    #,
    {x, -Pi, Pi},
    PlotStyle -> #2,
    Frame -> True,
    GridLines -> Automatic,
    PlotRange -> {-4, 4},
    FrameTicks -> {None, Automatic}
    ] &,
  {functions, styles}
  ]

(* set up the plot grid *)
PlotGrid[
 {plots},
 Spacings -> 20, (* leave 20 printers points between plots *)
 ]