Generating a broken or snipped axis in ListPlot

Here is a solution that uses a BezierCurve to indicate a "snipped" axes. The function snip[x] places the mark on the axes at relative position x (0 and 1 being the ends). The function getMaxPadding gets the maximum padding on all sides for both plots (based on this answer). The two plots are then aligned one over the other, with the max padding applied for both.

snip[pos_] := Arrowheads[{{Automatic, pos, 
     Graphics[{BezierCurve[{{0, -(1/2)}, {1/2, 0}, {-(1/2), 0}, {0, 1/2}}]}]}}];
getMaxPadding[p_List] := Map[Max, (BorderDimensions@
    Image[Show[#, LabelStyle -> White, Background -> White]] & /@ p)~Flatten~{{3}, {2}}, {2}] + 1
p1 = ListPlot[data1, PlotRange -> All, Joined -> True, Mesh -> Full, PlotStyle -> Red, 
    AxesStyle -> {None, snip[1]}, PlotRangePadding -> None, ImagePadding -> 30];
p2 = ListPlot[data2, PlotRange -> All, Joined -> True, Mesh -> Full, PlotStyle -> Blue, 
    Axes -> {False, True}, AxesStyle -> {None, snip[0]}, PlotRangePadding -> None, ImagePadding -> 30];

Column[{p2, p1} /. Graphics[x__] :> 
    Graphics[x, ImagePadding -> getMaxPadding[{p1, p2}], ImageSize -> 400]]

enter image description here


This solution shifts data around and makes new ticks for the y axis.

compressYAxis[plot_,plotRange1_,plotRange2_] will modify the y axis of the supplied plot to exclude the region between the upper limit of plotRange1 and the lower limit of plotRange2. With your data, here is the plot with a compressed y axis:

data1 = {{1, 1.1}, {2, 1.5}, {3, 0.9}, {4, 2.3}, {5, 1.1}};
data2 = {{1, 1001.1}, {2, 1001.5}, {3, 1000.9}, {4, 1002.3}, {5, 1001.1}};

p = ListLinePlot[{data1, data2}, PlotRange -> All, 
 PlotLabel -> "Example of a compressed y axis", 
 AxesLabel -> {"x", "y"}];

compressYAxis[p, {0, 3}, {999, 1003}]

Mathematica graphics

You will have to fiddle with this if you want tick subdivisions or a different background colour; the compression marks could be improved too.

The definition is

Clear[compressYAxis];
compressYAxis[plot_, range1_, range2_] := 
  Module[{ytick1, ytick2, epilog1, target},
   ytick1 = FindDivisions[range1, 5] /. y_?NumericQ :> {y, y} /. {y_?NumericQ, _} /; y >= range1[[2]] :> Sequence[];
   ytick2 = FindDivisions[range2, 5] /. y_?NumericQ :> {y - range2[[1]] + range1[[2]], y} /. {y_?NumericQ, _} /; y <= range1[[2]] :> Sequence[];
   epilog = Options[plot, Epilog][[1, 2]];
   target = Subtract @@ Reverse@range1/(Subtract @@ Reverse@range1 + Subtract @@ Reverse@range2);
   Show[plot /. {x_?NumericQ, y_?NumericQ /; y > range2[[1]]} :> {x, y - range2[[1]] + range1[[2]]}, 
     PlotRange -> {range1[[1]], range1[[2]] + Subtract @@ Reverse@range2}, 
     Ticks -> {Automatic, Join[ytick1, ytick2]}, 
     Epilog -> Join[epilog, {White, Rectangle[Scaled[{-0.1, 0.98 target}], Scaled[{1.1, 1.02 target}]], Black, Text[Rotate["\\", \[Pi]/2], Scaled[{0, 0.98 target}], {-1.5, 0}], Text[Rotate["\\", \[Pi]/2], Scaled[{0, 1.02 target}], {-1.5, 0}]}]]
 ]

ScalingFunctions

We can use custom piecewise linear ScalingFunctions which efectively makes the interval $[3,1000]$ very short and add a glyph to indicate the break using Epilog or AxesStyle to

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

head = Graphics[{Antialiasing -> True,EdgeForm[None], FaceForm[White], 
    Polygon[{{-1, -1/6}, {1, 5/6}, {1, 1/6}, {-1, -5/6}}], Black, 
    CapForm["Butt"], AbsoluteThickness[1], 
    Line[{{{-1, -5/6}, {1, 1/6}}, {{-1, -1/6}, {1, 5/6}}}]}];
inset[pos_: Scaled[{0.005, .55}], size_: {1/3, 1/3}] := Inset[head, pos, Automatic, size]


{t1, t2} = {Ceiling[#[[1, 2]]], Floor[#[[2, 1]]]} &@
   (CoordinateBounds[#][[2]]&/@ {data1, data2});
{yrange1, yrange2} = {Floor[#, .5], Ceiling[#2, .5]} & @@@ 
  (CoordinateBounds[#][[2]] & /@ {data1, data2});
ticks = Join @@ (Charting`FindTicks[{0, 1}, {0, 1}][##] & @@@ {yrange1, yrange2});

Using inset[] as Epilog:

ListLinePlot[{data1, data2}, PlotStyle -> Thick,
 ScalingFunctions -> {"Linear", {sf[t1, t2], isf[t1, t2]}}, 
 Ticks -> {Automatic, ticks}, PlotRangeClipping -> False, 
 Epilog -> inset[], ImageSize -> Medium, AspectRatio -> Automatic]

enter image description here

Using head as Arrowheads in AxesStyle:

ListLinePlot[{data1, data2}, PlotStyle -> Thick,
 ScalingFunctions -> {"Linear", {sf[t1, t2], isf[t1, t2]}}, 
 Ticks -> {Automatic, ticks}, PlotRangeClipping -> False, 
 ImageSize -> Medium, AspectRatio -> Automatic,
 AxesStyle -> {Automatic, Arrowheads[{{.05, .55, MapAt[ 
  GeometricTransformation[#, RotationTransform[Pi/2]] &, head, {1}]}}]}]

enter image description here

A modification of rm-rf's snip used with Epilog and AxesStyle:

ClearAll[snip2, inset2]
head2 = Graphics[{Antialiasing -> True, FaceForm[White], 
   Rectangle[{-1/3, -1/2}, {2/3, 1/2}],
   {#, Translate[#, {1/2, 0}]} & @
    BezierCurve[{{0, -(1/2)}, {1/2, 0}, {-(1/2), 0}, {0, 1/2}}]}];
snip2[pos_] := Arrowheads[{{Automatic, pos, head2}}];
inset2[pos_: Scaled[{0.005, .55}], size_: {1/3, 1/3}] := Inset[MapAt[ 
  GeometricTransformation[#, RotationTransform[Pi/2]] &, head2, {1}], 
  pos, Automatic, size]

ListLinePlot[{data1, data2}, PlotStyle -> Thick,
 ScalingFunctions -> {"Linear", {sf[t1, t2], isf[t1, t2]}}, 
 Ticks -> {Automatic, ticks}, PlotRangeClipping -> False, 
 Epilog -> inset2[], ImageSize -> Medium, AspectRatio -> Automatic]

enter image description here

ListLinePlot[{data1, data2}, PlotStyle -> Thick,
 ScalingFunctions -> {"Linear", {sf[t1, t2], isf[t1, t2]}}, 
 Ticks -> {Automatic, ticks}, PlotRangeClipping -> False, 
 AxesStyle -> {Automatic, snip2[.55]}, ImageSize -> Medium, 
 AspectRatio -> Automatic]

enter image description here

TranslationTransform

We can translate data2 and modify vertical tick labels taking the translation into account:

data2translated = TranslationTransform[{0, -997}] @ data2;
ticks2 = Join[Charting`FindTicks[{0, 1}, {0, 1}][##] & @@ yrange1, 
   Charting`FindTicks[#, # + 997][## & @@ #] &@(yrange2 - 997)];
ListLinePlot[{data1, data2translated }, 
 PlotStyle -> Thick, PlotRangeClipping -> False, 
 ImageSize -> Medium, AspectRatio -> Automatic, 
 AxesStyle -> {Automatic, snip2[.55]}, 
 Ticks -> {Automatic, ticks2}]

enter image description here

Tags:

Plotting