1
$\begingroup$

I am trying to produce a grid of color plots, where only the outer frame borders have labels, labeled ticks, and color bars. So the outer dimensions of all plots in the grid are different, because some have ticks and labels and some have not. Nevertheless, the frames of all the plots should have the same size and they should be aligned. Here is an example, produced by the lengthy code below:

no spacing

With Grid, I have been able to achieve the above task. However, there is now considerable white space between the plots. My idea was to remove this using negative spacing, which yields:

negative spacing

Unfortunately, the plots seem to have a finite white (non-transparent) background around them that overlaps with the adjacent plots and sometimes is on top. So the question is: Why is this white background there and how can I remove it?

Code to produce these figures:

(* Function to generate the color bar legend *)

customBarLegend[zmin_, zmax_, label_, colorFunction_: Automatic, 
  colorFunctionScaling_: True] := Module[{},
  Show[ArrayPlot[
    Table[{zmax + zmin - y}, {y, zmin, zmax, (zmax - zmin)/100}],
    ColorFunction -> colorFunction,
    ColorFunctionScaling -> colorFunctionScaling,
    DataRange -> {{0, 1}, {zmin, zmax}},
    Frame -> True,
    FrameLabel -> {{None, None}, {None, label}},
    FrameTicks -> {{None, All}, {None, None}},
    PlotRangePadding -> 0,
    AspectRatio -> 20,
    Axes -> False],
   PlotRange -> {{0, 1}, {zmin, zmax}}]]

(* Function to convert a regular (ugly) BarLegend into a custom bar \
legend that has the same height as the plot. *)

convertBarLegend[plot_, imPad_, barPad_, size_] := 
 Module[{zmin, zmax, zlabel, colorFunction, colorFunctionScaling, bar},
  {zmin, zmax} = (List @@ (List @@ plot)[[2]][[1]])[[1]][[2]];
  zlabel = LegendLabel /. (List @@ (List @@ plot)[[2]][[1]])[[3]];
  colorFunction = (List @@ (List @@ plot)[[2]][[1]])[[1]][[1]];
  colorFunctionScaling = 
   ColorFunctionScaling /. (List @@ (List @@ uglyplot)[[2]][[1]])[[6]];
  bar = customBarLegend[zmin, zmax, zlabel, colorFunction, 
    colorFunctionScaling];
  Row[{Show[(List @@ plot)[[1]], ImageSize -> {Automatic, size}, 
     ImagePadding -> imPad], 
    Show[bar, ImageSize -> {Automatic, size}, ImagePadding -> barPad]}]
  ]

(* Functions to remove inner ticks and labels *)

leftColumn[plots_] := 
 Block[{mainplots, left, right, bottom, top, innerx, innery},
  (* For the left column we strip the x labels and ticks for all but \
the last plot and the color bar for all plots. *)
  (* 
  strip color bars *)
  mainplots = ((List @@ #)[[1]] &) @@@ plots;
  (* Strip the x label and x ticks from all but the last plot *)

  mainplots = 
   MapAt[(# /. (FrameLabel -> {x_, y_}) -> (FrameLabel -> {None, 
           y})) &, mainplots, {1 ;; -2}];
  mainplots = 
   MapAt[(# /. (FrameTicks -> x_) -> (FrameTicks -> 
          MapAt["" &, 
           FrameTicks /. (List @@ #[[2]]), {{2, 1, All, 2}}])) &, 
    mainplots, {1 ;; -2}];
  (* Adjust image pads *)
  {{left, right}, {bottom, top}, {innerx, 
     innery}} = gridPads;
  Return[mainplots];
  ]
centerColumn[plots_] := 
 Block[{mainplots, xlabel, ylabel, xticks, yticks},
  (* For the center column(s) we strip the xlabels and ticks for all \
but the last plot, the y labels and ticks for all plots, 
  and the color bar for all plots. *)
  (* strip color bars *)

  mainplots = ((List @@ #)[[1]] &) @@@ plots;
  (* Strip the x label and x ticks from all but the last plot *)

  mainplots = 
   MapAt[(# /. (FrameLabel -> {x_, y_}) -> (FrameLabel -> {None, 
           y})) &, mainplots, {1 ;; -2}];
  mainplots = 
   MapAt[(# /. (FrameTicks -> x_) -> (FrameTicks -> 
          MapAt["" &, 
           FrameTicks /. (List @@ #[[2]]), {{2, 1, All, 2}}])) &, 
    mainplots, {1 ;; -2}];
  (* Strip the x label and x ticks from all plot *)

  mainplots = 
   MapAt[(# /. (FrameLabel -> {x_, y_}) -> (FrameLabel -> {x, 
           None})) &, mainplots, {All}];
  mainplots = 
   MapAt[(# /. (FrameTicks -> x_) -> (FrameTicks -> 
          MapAt["" &, 
           FrameTicks /. (List @@ #[[2]]), {{1, 1, All, 2}}])) &, 
    mainplots, {All}];
  Return[mainplots];
  ]
rightColumn[plots_] := 
 Block[{mainplots, xlabel, ylabel, xticks, yticks},
  (* For the right column(s) we strip the xlabels and ticks for all \
but the last plot and the y labels and ticks for all plots. *)
  (* 
  strip color bars *)
  mainplots = ((List @@ #)[[1]] &) @@@ plots;
  (* Strip the x label and x ticks from all but the last plot *)

  mainplots = 
   MapAt[(# /. (FrameLabel -> {x_, y_}) -> (FrameLabel -> {None, 
           y})) &, mainplots, {1 ;; -2}];
  mainplots = 
   MapAt[(# /. (FrameTicks -> x_) -> (FrameTicks -> 
          MapAt["" &, 
           FrameTicks /. (List @@ #[[2]]), {{2, 1, All, 2}}])) &, 
    mainplots, {1 ;; -2}];
  (* Strip the x label and x ticks from all plot *)

  mainplots = 
   MapAt[(# /. (FrameLabel -> {x_, y_}) -> (FrameLabel -> {x, 
           None})) &, mainplots, {All}];
  mainplots = 
   MapAt[(# /. (FrameTicks -> x_) -> (FrameTicks -> 
          MapAt["" &, 
           FrameTicks /. (List @@ #[[2]]), {{1, 1, All, 2}}])) &, 
    mainplots, {All}];
  (* Merge back the color bars *)

  mainplots = 
   Table[Row[{mainplots[[i]], (((List @@ #)[[2]] &) @@@ 
         plots)[[i]]}], {i, 1, Length[plots]}];
  Return[mainplots];
  ]

(* Test data *)

data = Flatten[Table[{x, y, x + y}, {x, 0, 50}, {y, 0, 50}], 1];

 (* Plot the test data as ArrayPlot because ListDensityPlot increases \
the output file size by a factor 20 *)

uglyplot = Block[{data2, xmin, xmax, ymin, ymax, zmin, zmax},
   data2 = 
    Reverse[Transpose[
      Partition[data[[All, 3]], 
       Length[DeleteDuplicates[data[[All, 2]]]]]]];
   xmin = Min[data[[All, 1]]];
   xmax = Max[data[[All, 1]]];
   ymin = Min[data[[All, 2]]];
   ymax = Max[data[[All, 2]]];
   zmin = Min[data[[All, 3]]];
   zmax = Max[data[[All, 3]]];
   ArrayPlot[data2,
    ColorFunction -> 
     ColorData[{"M10DefaultDensityGradient", {0, 1}}],
    ColorFunctionScaling -> True,
    PlotRangePadding -> None,
    FrameTicks -> {{Automatic, None}, {Automatic, None}},
    DataRange -> {{xmin, xmax}, {ymin, ymax}},
    PlotLegends -> BarLegend[Automatic, LegendLabel -> "z"]]];
imPad = {{50, 7}, {60, 
   10}}; (*{{left,right},{bottom,top}}*)
barPad = {{1, 100}, 
  imPad[[2]]};(* bottom and top should be the same as imPad. *)
plot =
  convertBarLegend[uglyplot, imPad, barPad, 300];

(* Arrange the plots in a grid. Ideally, there should be no or little \
white space between the plots. *)

plotgrid = 
  Grid[Transpose[{leftColumn[{plot, plot, plot}], 
     centerColumn[{plot, plot, plot}], 
     rightColumn[{plot, plot, plot}]}], Spacings -> {0, 0}];
Export["plotgrid.png", plotgrid]
plotgridtight = 
  Grid[Transpose[{leftColumn[{plot, plot, plot}], 
     centerColumn[{plot, plot, plot}], 
     rightColumn[{plot, plot, plot}]}], Spacings -> {-5, -5}];
Export["plotgridtight.png", plotgridtight]
$\endgroup$
  • $\begingroup$ I found some related, but not quite the same questions: 43826, 37465, 2011. It seems that the SciDraw package is the right tool for this task. However, I'm still interested if removing the white frame is possible. $\endgroup$ – Felix Dec 11 '16 at 5:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.