4

I remeber that I saw once a similar question, but I can not find it anymore.

I can make a combined plot of the two data set data1 and data2:

data1 = Get @ "https://pastebin.com/raw/RDYqjCeA";
data2 = Get @ "https://pastebin.com/raw/e3qcivH0";

ListPlot[{data1, data2}, 
  PlotStyle -> {Red, Blue}, 
  Frame -> True, 
  FrameLabel -> {{"y", ""}, {"x", ""}}, 
  PlotRange -> {{0, 1600}, {300, 900}} , 
  BaseStyle -> {FontWeight -> "Bold", FontSize -> 15, FontFamily -> "Calibri"}, 
  ImageSize -> Large]

enter image description here

Since data1 and data2 have a large x distance I would like to crop a part of the x range and produce a similar plot like this one:

![![enter image description here

m_goldberg
  • 107,779
  • 16
  • 103
  • 257
mrz
  • 11,686
  • 2
  • 25
  • 81

1 Answers1

6

Use TranslationTransform on data2:

ListPlot[{TranslationTransform[{-1300, 0}]@data1, data2, 
  Thread[{{100, 200}, 300}], Thread[{{100, 200}, 900}]},
 PlotRange -> {Automatic, {300, 900}}, ImageSize -> Large, 
 Joined -> {False, False, True, True},
 PlotStyle -> Join[Directive /@Thread[{PointSize[Large], {Red, Blue}}], 
     {#, #} &@ Directive[Thick, CapForm["Butt"], White]],
 AspectRatio -> Automatic, Frame -> True, FrameLabel -> {{"y", ""}, {"x", ""}},
 FrameTicks -> {Automatic, {#,#}&@(Range[0, 300, 100] /. x : (200 | 300) -> {x, x + 1300})},
 BaseStyle -> {FontWeight -> "Bold", FontSize -> 15, FontFamily -> "Calibri"},
 Epilog -> {Dotted, Line@Thread[{{100, 200}, #}] & /@ {300, 900}},
 Method -> {"FrameInFront" -> False}, PlotRangeClipping -> False]

enter image description here

Alternatively, you can remove Epilog and add two more data sets in the first argument of ListPlot and modify PlotStyle:

pr = Round[PlotRange[ListPlot[#, PlotRange->{Automatic, {300, 900}}]], 50]&/@{data2, data1};
difs = -Subtract @@@ pr[[All, 1]];
gap = 50;
gapcoords = Thread[{{#, gap + #} &@pr[[1, 1, 2]], #}] & /@ pr[[1, 2]];
ticks = {## & @@ #, ## & @@ 
  Thread[{{#[[2]] + gap, #[[2]] + gap + difs[[2]]}, pr[[2, 1]]}]} &@pr[[1, 1]];
trans = {-pr[[2, 1, 1]] + gap + pr[[1, 1, 2]], 0};
ListPlot[{TranslationTransform[trans]@data1, 
  data2, ## & @@ gapcoords, ## & @@ gapcoords}, 
 PlotRange -> {{0, Total[difs] + gap}, pr[[1, 2]]}, 
 ImageSize -> Large, Joined -> {False, False, True, True, True, True},
 PlotStyle -> Join[Directive /@ Thread[{PointSize[Large], {Red, Blue}}], 
  {#, #} & @ Directive[Thick, CapForm["Butt"], White], 
  {#, #} & @ Directive[Thin, Dotted, Black]], AspectRatio -> Automatic, 
 Frame -> True, FrameLabel -> {{"y", ""}, {"x", ""}}, 
 FrameTicks -> {Automatic, {ticks, ticks}}, 
 BaseStyle -> {FontWeight -> "Bold", FontSize -> 15,  FontFamily -> "Calibri"}, 
 Method -> {"FrameInFront" -> False}, PlotRangeClipping -> False]

enter image description here

Update: An alternative approach using custom ScalingFunctions:

ClearAll[sf, isf]
sf[t1_, t2_, gap_: 50][x_] := Piecewise[{{x, x <= t1}, 
  {t1 + gap/(t2 - t1) (x - t1), t1 <= x <= t2}, {t1 + gap + (x - t2), x >= t2}}]
isf[t1_, t2_, gap_: 50][x_] := InverseFunction[sf[t1, t2, gap]][x]

pr = Round[PlotRange[ListPlot[#, PlotRange->{Automatic, {300, 900}}]], 50]&/@{data2, data1};
ticks = Join @@ pr[[All, 1]];
gapcoords = Thread[{{pr[[1, 1, 2]], pr[[2, 1, 1]]}, #}] & /@ pr[[1, 2]];

Row[With[{g = #}, ListPlot[{data1, data2, ## & @@ gapcoords, ## & @@ gapcoords},
  Joined -> {False, False, True, True, True, True}, 
  PlotStyle -> Join[Directive /@ Thread[{PointSize[Large], {Red, Blue}}], 
    {#, #} & @ Directive[Thick, CapForm["Butt"], White],
    {#, #} & @ Directive[Thin, Dotted, Black]],
  Frame -> True,
  FrameTicks -> {Automatic, {ticks, ticks}}, 
  AspectRatio -> Automatic, 
  PlotRange -> {MinMax@pr[[All, 1]], pr[[1, 2]]}, 
  ScalingFunctions -> {{sf[pr[[1, 1, 2]], pr[[2, 1, 1]], g][#] &, 
        isf[pr[[1, 1, 2]], pr[[2, 1, 1]], g][#] &}, "Linear"}, 
  ImageSize -> Large,
  BaseStyle -> {FontWeight -> "Bold", FontSize -> 15, FontFamily -> "Calibri"}, 
  PlotRangeClipping -> False, 
  Method -> {"FrameInFront" -> False}]] & /@ {30, 90}, Spacer[20]]

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896
  • This is perfect and so compact that I do not understand everything, especially this command: FrameTicks -> {Automatic, {#,#}&@(Range[0, 300, 100]/. x : (200 | 300) -> {x, x + 1300})}. Could you show what has to be changed when the dashed line would be between x=100 and x=150? Can the x axis start exactly at 0? Thank you very much for your help. – mrz Jan 20 '19 at 21:54
  • Now I slowly understand how the code works. In my data analysis project I compare your plot with a geometric transformation of the two data sets (you helped me there too: https://mathematica.stackexchange.com/questions/189124/fitting-of-2d-data-points-with-a-function-considering-scaling-rotation-and-tran). There data points partly overlap and instead of using points I defined markers to distinguish them better: symbolPlusBlue = Graphics[{Blue, Line[{{{-1, 0}, {1, 0}}, {{0, -1}, {0, 1}}}]}];and symbolCrossRed = Graphics[{Red, Line[{{{-1, -1}, {1, 1}}, {{-1, 1}, {1, -1}}}]}];. – mrz Jan 21 '19 at 06:44
  • 1
    @mrz, try PlotMarkers -> {{symbolCrossRed, 0.1}, {symbolPlusBlue, 0.1}, "", "", "", ""}. – kglr Jan 21 '19 at 06:45
  • But it has to somehow to replace Thread[{PointSize[Large] ...? – mrz Jan 21 '19 at 07:03
  • 1
    @mrz, the size specified in plot markers overrides the PointSize directive in PlotStyle; so you can leave PlotStyle as is or use {Red, Blue} instead of Directive /@ Thread[{PointSize[.3], {Red, Blue}}. – kglr Jan 21 '19 at 07:07