18
$\begingroup$

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

enter image description here

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

enter image description here

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?

Improve this question
$\endgroup$

1 Answer 1

Reset to default
23
$\begingroup$ 
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}]

enter image description here

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

enter image description here

Improve this answer
$\endgroup$
7
  • $\begingroup$ I have version 7. How can I convert this to work with version 7? $\endgroup$
    – Peter
    Dec 1, 2018 at 19:48
  • $\begingroup$ orz...crazy codes.., where can I find the detailed usage of Charting'FindTicks? or it's really hard to catch the codes meanings. $\endgroup$
    – Jerry
    Dec 2, 2018 at 2:29
  • 1
    $\begingroup$ @Peter, I don't have version 7. You have a better chance for getting the attention of someone with access to version 7, if post a new question asking specifically for a solution that works in version 7. $\endgroup$
    – kglr
    Dec 2, 2018 at 3:01
  • $\begingroup$ @jerry, if you have v10 or a newer version you can use Needs["GeneralUtilities`"]; PrintDefinitions[Charting'FindTicks] to see the code. $\endgroup$
    – kglr
    Dec 2, 2018 at 3:03
  • $\begingroup$ @kglr,great! Is it possible to develop a general function that is easy to understand to draw multiple Y-Axis diagram based on ListPlot or ListLinePlot, i.e. MYAixsListPlot[lists,labels,opts], I have spend time on doing this following your codes but it's difficult for me because too many Slots # make me lost... :( $\endgroup$
    – Jerry
    Dec 2, 2018 at 11:49

Not the answer you're looking for? Browse other questions tagged or ask your own question.