Skip to main content

plotting - How can I make a grid of plots with no spacing, and have the plots line up perfectly?


I am making a bunch of two dimensional plots and I would like to have them arranged in a grid with no space in between them. That is, I want their frames touching each other.


My problem is twofold. First I don't know how to get the plots to have a consistent size. When I try to give the plots the same size via ImageSize, it applies the size to the overall image, including the tick marks and labels. But when I have two different plots, one with tick labels and one without, giving the same value to ImageSize doesn't give the result I'm looking for.


Secondly, I want to get rid of any white space around the images such that when I give Grid the option Spacings ->{0,0} there really is no visible space between the plots.



In the example code I use the CustomTicks package.


(*an example of what I might plot, simple sum of two dimensional \
Lorentzians*)
lzn[x_, w_, g_] := (x - w + I g)^-1;
exampledata2D = 
  Table[Re[lzn[w1, .2, .1] lzn[w2, .3, .2] + 
     lzn[w1, .4, .1] lzn[w2, .8, .1] + 
     lzn[w1, .8, .2] lzn[w2, .4, .2]], {w1, 0, 1, .01}, {w2, 0, 
    1, .01}];
<< "CustomTicks`";  

standardticks = LinTicks[0, 1, .2, 4];
(*I don't want the last tick label for one plot overlapping with the \
first tick label of the plot right next to it.*)
ticks2 = LinTicks[0, 1, .2, 4, ShowLast -> False];
(*Custom plotting function so I don't have to reprint the same \
options over and over *)
plottingfunction[list_, plotopts : OptionsPattern[]] := 
  ListContourPlot[list, 
   Evaluate[FilterRules[{plotopts}, Options[ListContourPlot]]], 
   Contours -> 30, PlotRange -> All, DataRange -> {{0, 1}, {0, 1}}, 

   BaseStyle -> 18, 
   ColorFunction -> (Blend[{Red, Orange, Yellow, Green, Blue, 
        Darker[Blue]}, #] &)];

bottomleft = 
  plottingfunction[exampledata2D, 
   FrameTicks -> {{ticks2, StripTickLabels[standardticks]}, {ticks2, 
      StripTickLabels[standardticks]}}];
bottomright = 
  plottingfunction[exampledata2D, 

   FrameTicks -> {{StripTickLabels[standardticks], 
      StripTickLabels[standardticks]}, {standardticks, 
      StripTickLabels[standardticks]}}];
topleft = 
  plottingfunction[exampledata2D, 
   FrameTicks -> {{ticks2, 
      StripTickLabels[standardticks]}, {StripTickLabels[
       standardticks], StripTickLabels[standardticks]}}];
topright = 
  plottingfunction[exampledata2D, 

   FrameTicks -> {{StripTickLabels[standardticks], 
      StripTickLabels[standardticks]}, {StripTickLabels[
       standardticks], StripTickLabels[standardticks]}}];

Grid[{{topleft, topright}, {bottomleft, bottomright}}, 
 BaseStyle -> ImageSizeMultipliers -> 1, Spacings -> {0, 0}]

enter image description here



Answer



Thanks to Kuba and Szabolcs for pointing out many related posts. I recognize that LevelScheme is probably the best way to go here, but at the moment I don't have the time to learn everything I need in order to use it.



I am going to use Jens's solution from this page, but I have to remove the certain tick labels so that they don't overlap each other.


(*an example of what I might plot, simple sum of two dimensional \
Lorentzians*)
lzn[x_, w_, g_] := (x - w + I g)^-1;
exampledata2D = 
  Table[Re[lzn[w1, .2, .1] lzn[w2, .3, .2] + 
     lzn[w1, .4, .1] lzn[w2, .8, .1] + 
     lzn[w1, .8, .2] lzn[w2, .4, .2]], {w1, 0, 1, .01}, {w2, 0, 
    1, .01}];
<< "CustomTicks`";  

tickbottom = LinTicks[-1, 1, .5, 5, ShowLast -> False];
ticktop = LinTicks[-1, 1, .5, 5, ShowFirst -> False];
tickmiddle = 
  LinTicks[-1, 1, .5, 5, ShowFirst -> False, ShowLast -> False];
standardticks = LinTicks[-1, 1, .5, 5];
plottingfunction[list_, horizontalposition_, verticalposition_, 
   plotopts : OptionsPattern[]] := 
  ListContourPlot[list, 
   Evaluate[FilterRules[{plotopts}, Options[ListContourPlot]]], 
   Contours -> 30, DataRange -> {{-1, 1}, {-1, 1}}, BaseStyle -> 18, 

   ColorFunction -> (Blend[{Red, Orange, Yellow, Green, Blue, 
        Darker[Blue]}, #] &), PlotRangePadding -> None, 
   PlotRange -> All, 
   FrameTicks -> {{Which[verticalposition == "Top", ticktop, 
       verticalposition == "Middle", tickmiddle, 
       verticalposition == "Bottom", tickbottom], 
      StripTickLabels[standardticks]}, {If[
       verticalposition == "Bottom", 
       Which[horizontalposition == "Right", ticktop, 
        horizontalposition == "Middle", tickmiddle, 

        horizontalposition == "Left", tickbottom], 
       StripTickLabels[standardticks]], 
      StripTickLabels[standardticks]}}];

Options[plotGrid] = {ImagePadding -> 40};
plotGrid[l_List, w_, h_, opts : OptionsPattern[]] := 
 Module[{nx, ny, sidePadding = OptionValue[plotGrid, ImagePadding], 
   topPadding = 0, widths, heights, dimensions, positions, 
   frameOptions = 
    FilterRules[{opts}, 

     FilterRules[Options[Graphics], 
      Except[{ImagePadding, Frame, FrameTicks}]]]}, {ny, nx} = 
   Dimensions[l];
  widths = (w - 2 sidePadding)/nx Table[1, {nx}];
  widths[[1]] = widths[[1]] + sidePadding;
  widths[[-1]] = widths[[-1]] + sidePadding;
  heights = (h - 2 sidePadding)/ny Table[1, {ny}];
  heights[[1]] = heights[[1]] + sidePadding;
  heights[[-1]] = heights[[-1]] + sidePadding;
  positions = 

   Transpose@
    Partition[
     Tuples[Prepend[Accumulate[Most[#]], 0] & /@ {widths, heights}], 
     ny];
  Graphics[
   Table[Inset[
     Show[l[[ny - j + 1, i]], 
      ImagePadding -> {{If[i == 1, sidePadding, 0], 
         If[i == nx, sidePadding, 0]}, {If[j == 1, sidePadding, 0], 
         If[j == ny, sidePadding, topPadding]}}, AspectRatio -> Full],

      positions[[j, i]], {Left, Bottom}, {widths[[i]], 
      heights[[j]]}], {i, 1, nx}, {j, 1, ny}], 
   PlotRange -> {{0, w}, {0, h}}, ImageSize -> {w, h}, 
   Evaluate@Apply[Sequence, frameOptions]]]

plotGrid[Table[
  plottingfunction[exampledata2D, h, 
   v], {v, {"Top", "Middle", "Bottom"}}, {h, {"Left", "Middle", 
    "Right"}}], 1000, 1000]


enter image description here


I'm not 100% happy with the way it looks, with the missing tick labels, but it is better than having the labels overlap or get cut off.


Comments

Post a Comment

Popular posts from this blog

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...
Post a Comment
Read more

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...
Post a Comment
Read more