How can we stick multi-plots to each other horizontally?

I would approach this by putting everything in one ListPlot and one Plot.

list = {{1.*10^-6, 0.49759}, {0.000011, 0.491893}, {0.000021, 0.488727}, 
   {0.000031, 0.486235}, {0.000041, 0.484104}, {0.000051, 0.482205},
   {0.000061, 0.480474}, {0.000071, 0.47887}, {0.000081, 0.477367},
   {0.0001, 0.474729}, {0.0002, 0.463541}, {0.0003, 0.454677},
   {0.0004, 0.447017}, {0.0005, 0.440129}};

list2 = {{0., 0.48}, {0.00001, 0.475}, {0.00002, 0.473},
   {0.00003, 0.471}, {0.00006, 0.466}, {0.00009, 0.462},
   {0.00014, 0.457}, {0.00017, 0.455}, {0.00024, 0.449},
   {0.00028, 0.446}, {0.00036, 0.441}, {0.00045, 0.435}};

list3 = {{0., 0.5}, {0.00001, 0.496}, {0.00002, 0.495},
   {0.00003, 0.493}, {0.00006, 0.489}, {0.00009, 0.487},
   {0.00014, 0.482}, {0.00017, 0.48}, {0.00024, 0.476},
   {0.00028, 0.473}, {0.00036, 0.469}, {0.00045, 0.465}};

max = 6.0;
num = 3;

list2 = {max/10000 + #1, #2} & @@@ list2;
list3 = {2 max/10000 + #1, #2} & @@@ list3;

table = Table[{g, 0.4994 - 3.59821 g^0.54032}, {g, 0, 0.00055, 0.00001}];
table2 = Table[{max/10000 + g, 0.48 - 3.9 g^0.58}, {g, 0, 0.00055, 0.00001}];
table3 = Table[{2 max/10000 + g, 0.5 - 3.6 g^0.6}, {g, 0, 0.00055, 0.00001}];

Show[ListLinePlot[List[table, table2, table3], Frame -> True,
  FrameTicks -> {Transpose[
     {Flatten[max # + Range[0, 5] & /@ Range[0, num - 1]]/10000, 
      Flatten[ConstantArray[Range[0, 5], num]]}], Automatic},
  Epilog -> {Darker[Gray], Line[{{max #/10000 - 0.00003, 0},
        {max #/10000 - 0.00003, 1}}] & /@ Range[num - 1]},
  AspectRatio -> 1/(3 GoldenRatio), ImageSize -> 900,
  PlotStyle -> ColorData[97, 1]],
 ListPlot[Join[list, list2, list3], PlotStyle -> PointSize[0.005]]]

enter image description here


Using TranslationTransform on graphics primitives and frame ticks based on PlotRange option settings of the input plots:

ClearAll[rowLayout]
rowLayout[pad_: 0.05][opts : OptionsPattern[]] := Module[{trFs, gridlines, xticks,
   plts = Show[#, PlotRangePadding -> {Scaled[pad], Scaled[pad]}] & /@ # ,
   paddings = pad {-1, 1}. # & /@ (First /@ PlotRange /@ #), 
   shifts = {1., -1}. # & /@ Partition[Rest @ Flatten[First /@ PlotRange /@ #], 2]},
  trFs = TranslationTransform[{#, 0}] & /@ Accumulate[2 paddings + Prepend[shifts, 0]];
  gridlines = Most @ MapThread[#[{#2 + #3, 0}] &, 
   {trFs, PlotRange[#][[1, 2]] & /@ plts, paddings}][[All, 1]];
  xticks = Join @@ Table[MapAt[trFs[[i]][{#, 0}][[1]] &, 
   (FrameTicks /. Options[plts[[i]], FrameTicks])[[2, 1]], {All, 1}], {i, Length@plts}];
  Graphics[MapThread[GeometricTransformation[#[[1]], #2] &, {plts, trFs}], 
   FrameTicks -> {{Automatic, All}, {xticks, xticks}}, 
   GridLines -> {gridlines, None}, opts, Frame -> True, 
   AspectRatio -> 1/3/GoldenRatio, ImageSize -> 800]] &;

Examples:

Using plot and listplot in OP:

rowLayout[][] @ {plot, listplot, plot,listplot}

enter image description here

rowLayout[.2][AspectRatio -> 1 / 5 / GoldenRatio] @ {plot, listplot, plot, listplot}

enter image description here

plots = {Plot[2 Pi Sin[x], {x, -2 Pi, 2 Pi}, Filling -> Axis, Frame -> True, 
    FrameTicks -> {{Automatic, Automatic}, 
       {{#, #} & /@ Range[-2 Pi, 2 Pi, 4 Pi/8], Automatic}}], 
   Plot[5 Cos[x^2], {x, -Pi, 3 Pi}, Filling -> Axis, Frame -> True, 
     FrameTicks -> {{Automatic, Automatic}, 
       {{#, #} & /@ Range[-Pi, 3 Pi, 4 Pi/4], Automatic}}], 
   Plot[x Cos[x], {x, Pi, 4 Pi}, Filling -> Axis, Frame -> True, 
     FrameTicks -> {{Automatic, Automatic}, 
       {Select[Charting`FindTicks[{0, 1}, {0, 1}][Pi, 4 Pi], Pi <= #[[1]] <= 4 Pi &],
       Automatic}}]};

rowLayout[.1][] @ plots

enter image description here

Caveat: It is required that the input plots have explicit settings for FrameTicks (as in the examples in OP) to avoid the pain of processing Automatic FrameTicks.

Tags:

Plotting

Recent Posts