Plot with multiple Y-axes

Question

I would like to create plot with multiple Y-axes which looks this:

I can do it for two Y-axes in the following way:

data = Table[{n, n*n, n*n*n}, {n, 0, 100}] // Transpose;
ip = {{30, 50}, {30, 25}};
plot1 = ListPlot[
 data[[1]],
 ImagePadding -> ip,
 ImageSize -> 500,
 PlotStyle -> Red,
 Frame -> {True, True, True, False},
 FrameStyle -> {Black, Red, Black, Black}
 ];
plot2 = ListPlot[
 data[[2]],
 ImageSize -> 500,
 PlotStyle -> Blue,
 ImagePadding -> ip,
 Frame -> {False, False, False, True},
 FrameTicks -> {{False, All}, {False, False}},
 FrameStyle -> Blue

];

Overlay[{plot1, plot2}]

but how I can add the third Y-axis ? Probably I could use the same approach with Overlay, but for this I would need to create plot with gap between plot area and frame. Is it possible? Or there is another way to do it?

Answer 1

ClearAll[axisF]
axisF[tl_: (.01), styl_: {Thickness[.001]}, tSide_: Left][min_, max_, scale_: 1] := 
 Module[{tf = tSide /. {Automatic | Left -> Identity, Right -> ({-1, 1} # &)},
   tcks = DeleteDuplicates[Replace[Charting`FindTicks[{0, 1/scale}, {0, 1}][min, max], 
    {x_?NumericQ, y_?NumericQ} :> {x, y, tl , styl}, {1}] /. {x_, 0.} :> tl/2, 
      #[[1]] == #2[[1]] &]}, 
  {styl, Line@Thread[tf@{0, Through@{Min, Max}@#[[All, 1]]}], 
   {Line[{tf@{0 - #3, #}, tf@{0, #} }], 
    Text[#2, tf@{#3, #}, {tSide, Center}]} & @@@ #} & @ tcks]

Examples:

data = Table[{n, n*n, n*n*n}, {n, 0, 100}] // Transpose;
ip = {{30, 50}, {30, 25}};
axes = Translate[axisF[2, #,  #2][0, 100, #3], {#4, 0}] & @@@ 
  Transpose[{Directive[#, FontSize -> 12] & /@ {Blue, Purple, Red}, 
  {Right, Left, Left}, {1, 100, 1000},
  {-Length[data[[1]]] .02, Length[data[[1]]] 1.02, Length[data[[1]]] 1.3}}];

labels = Text[Style[#, 16, #2, "Panel"], {#3, 50}, {0, 0}, {0, 1}] & @@@
  Transpose[{{"Label1", "Label2", "Label3"}, {Blue, Purple, Red}, 
  {-Length[data[[1]]] .17, Length[data[[1]]] 1.17, Length[data[[1]]] 1.45}}];

ListPlot[data/ {1, 100, 10000}, 
 AspectRatio -> 1, PlotStyle -> {Blue, Purple, Red, Magenta}, 
 ImagePadding -> ({{2, 5}, {1, 1}} ip), ImageSize -> 700, 
 Frame -> {{None, None}, {Automatic, Automatic}}, 
 FrameTicks -> {{Automatic, None}, {Automatic, Automatic}}, 
 PlotRangeClipping -> False, Epilog -> {axes, labels}]

axes = Translate[axisF[2, #,  #2][0, 100, #3], {#4, 0}] & @@@ 
   Transpose[{Directive[#, FontSize -> 12] & /@ {Blue, Purple, Red, Magenta}, 
  {Right, Left, Left, Left}, {1, 100, 1000, 1}, 
  {-Length[data[[1]]] .02, Length[data[[1]]] 1.02, 
    Length[data[[1]]] 1.3, Length[data[[1]]] 1.6}}];

labels = Text[Style[#, 16, #2, "Panel"], {#3, 50}, {0, 0}, {0, 1}] & @@@
    Transpose[{{"Label1", "Label2", "Label3", "Label4"},
    {Blue, Purple, Red, Magenta}, 
    {-Length[data[[1]]] .17, Length[data[[1]]] 1.17, 
     Length[data[[1]]] 1.45, Length[data[[1]]] 1.75}}];

ListPlot[data[[{1, 2, 3, 1}]]/ {1, 100, 10000, 2}, 
 AspectRatio -> 1, PlotStyle -> {Blue, Purple, Red, Magenta}, 
 ImagePadding -> ({{2, 6}, {1, 1}} ip), ImageSize -> 700, 
 Frame -> {{None, None}, {Automatic, Automatic}}, 
 FrameTicks -> {{Automatic, None}, {Automatic, Automatic}}, 
 PlotRangeClipping -> False, Epilog -> {axes, labels}]