Broken y axis at multiple locations

Question

I have some data that I want to compare on a broken y axis. I found a similar post Generating a broken or snipped axis in ListPlot but it is only for one break in the y-axis. For my plot, I want three breaks in the y-axis. One between zero and the first set of data, between the first and second set of data, and between the second and third set of data. I have a sketch of what I would like the data to look like. The snip function I was using from the post I listed seems to only let you set it to 0 or 1, so the squiggle can only go on top or the bottom of the plot, but in some cases I need the squiggle on both ends. Also, the code I got from that post cuts off some of my points?

And eventually, I want the data points to not be color coded but rather black and data1, data2, data3, and data4 corresponding to squares, triangles, diamonds, and x's as shown in the photo.

Here is my code so far:

list1 = {6.9310, 6.9362, 6.9427, 6.9484, 6.9538, 6.9579, 6.9611, 
   6.9633, 6.9661, 6.9666, 6.9682, 6.9695, 6.9702};
list2 = {6.9659, 6.9722, 6.9799, 6.9869, 6.9933, 6.9980, 7.0019, 
   7.0047, 7.0079, 7.0086, 7.0103, 7.0119, 7.0128};
list3 = {4.1774, 4.1845, 4.1926, 4.1999, 4.2069, 4.2116, 4.2157, 
   4.2187, 4.222, 4.2228, 4.2244, 4.226, 4.2269};
list4 = { 4.0106, 4.0114, 4.0129, 4.0137, 4.0154, 4.0167, 4.0175, 
   4.0176, 4.0192, 4.0189, 4.0202, 4.0208, 4.021};
listtot = {0.000, 0.099, 0.196, 0.291, 0.385, 0.476, 0.566, 0.654, 
   0.741, 0.826, 0.909, 1.111, 1.304};
data1 = Transpose[{listtot, list1}];
data2 = Transpose[{listtot, list2}];
data3 = Transpose[{listtot, list3}];
data4 = Transpose[{listtot, list4}];
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, data2}, PlotRange -> All, Joined -> False, 
   Mesh -> Full, PlotStyle -> Red, Axes -> {False, True}, 
   AxesStyle -> {None, snip[0]}, PlotRangePadding -> None, 
   ImagePadding -> {{40, 20}, {5, 5}}];
p3 = ListPlot[data3, PlotRange -> All, Joined -> False, Mesh -> Full, 
   PlotStyle -> Green, Axes -> {False, True}, 
   AxesStyle -> {None, snip[1]}, PlotRangePadding -> None, 
   ImagePadding -> {{40, 20}, {5, 5}}];
p4 = ListPlot[data4, PlotRange -> All, Joined -> False, Mesh -> Full, 
   PlotStyle -> Orange, AxesStyle -> {None, snip[1]}, 
   PlotRangePadding -> None, ImagePadding -> {{40, 20}, {15, 5}}];
Column[{p1, p3, p4} /. 
  Graphics[x__] :> 
   Graphics[x, ImagePadding -> getMaxPadding[{p1, p2, p3, p4}], 
    ImageSize -> 400]]

Answer 1

You can use Lukas Lang's ResourceFunction[PlotGrid] as follows:

plotGrid = ResourceFunction["PlotGrid"];

Add the option Frame -> True to all plots:

plt1 = ListPlot[{data1, data2}, Joined -> False, Mesh -> Full, 
   PlotStyle -> Red, Frame -> True];

plt3 = ListPlot[data3, Joined -> False, Mesh -> Full, 
   PlotStyle -> Green, Frame -> True];

plt4 = ListPlot[data4, Joined -> False, Mesh -> Full, 
   PlotStyle -> Orange, Frame -> True];

Construct an empty graphics to add as the last and/or first row:

emptygraphics = Graphics[{}, PlotRange -> {{0, 1.3}, {0, 1}},  Frame -> True, 
   FrameTicks -> {{None, None}, {Automatic, Automatic}}];

Use plotGrid with the option "MergeAxes" -> "Cut" and appropriate values for the option Spacings:

plotGrid[{{emptygraphics}, {plt1}, {plt3}, {plt4}, {emptygraphics}}, 
  ImageSize -> 700, AspectRatio -> 1/GoldenRatio,
  "MergeAxes" -> "Cut", Spacings -> {0, 20}, 
  ItemSize -> {1, {1/4, 1, 1, 1, 1/4}}]

Add the option FrameStyle -> {{Automatic, Opacity[0]}, {Automatic, Opacity[0]}} to all plots to make top and right frames invisible: