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]

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}]}}]}]

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]

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]

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}]

data2
) are above the red set of data (data1
). $\endgroup$