Mathematica 如何绘制双纵坐标轴的图像?

来源:http://forum.simwe.com/thread-985179-1-1.html

提问:

现在需要作出这样一张图，如附件
数据共用一个横轴，但纵轴不同。不能直接让某一组数据直接乘一个常数以画到一起。
麻烦大家看一下。本版有过关于双坐标轴的讨论，但好像跟这个情况都不太一样，故再此一问。

解答:

方法一:

Plot[{Sin[x], Cos[x]}, {x, -1, 1}, 

 Frame -> {{True, True}, {True, False}}, 

 FrameTicks -> {{Automatic, {{-0.5, 5}, {0, 10}, {0.5, 

      15}}}, {Automatic, None}}, 

 FrameLabel -> {{"Left", "Right"}, {None, None}}]

方法二:

可以参考这个帖子：
https://groups.google.com/d/msg/comp.soft-sys.math.mathematica/CKE9Ghn43x8/F1_JnIbCYjsJ

Clear[TwoAxisDateListPlot];



TwoAxisDateListPlot[f_List, g_List, opts : OptionsPattern[]] := 

 Module[{p1, p2, fm, fM, gm, gM, old, new, newg}, 

  p1 = DateListPlot[f, Axes -> True, Frame -> False, 

    PlotRange -> Automatic];

  p2 = DateListPlot[g, Axes -> True, Frame -> False, 

    PlotRange -> Automatic];

  {fm, fM} = AbsoluteOptions[p1, PlotRange][[1, 2, 2]];

  {gm, gM} = AbsoluteOptions[p2, PlotRange][[1, 2, 2]];

  old = AbsoluteOptions[p2, Ticks][[1, 2, 2]];

  new = Flatten[{Rescale[First[#1], {gm, gM}, {fm, fM}], Rest[#1]}, 

      1] & /@ old;

  newg = {#[[1]], Rescale[#[[2]], {gm, gM}, {fm, fM}]} & /@ g;

  DateListPlot[{f, newg}, Axes -> False, Frame -> True, 

   FrameTicks -> {Automatic, Automatic, None, new}, 

   PlotRange -> {fm, fM}, opts]]



Clear[TwoAxisReverseDateListPlot];



TwoAxisReverseDateListPlot[f_List, g_List, opts : OptionsPattern[]] :=

  Module[{p1, p2, fm, fM, gm, gM, old, new, newg}, 

  p1 = DateListPlot[f, Axes -> True, Frame -> False, 

    PlotRange -> Automatic];

  p2 = DateListPlot[g, Axes -> True, Frame -> False, 

    PlotRange -> Automatic];

  {fm, fM} = AbsoluteOptions[p1, PlotRange][[1, 2, 2]];

  {gm, gM} = AbsoluteOptions[p2, PlotRange][[1, 2, 2]];

  old = AbsoluteOptions[p2, Ticks][[1, 2, 2]];

  new = Flatten[{fM + fm - Rescale[First[#1], {gm, gM}, {fm, fM}], 

       Rest[#1]}, 1] & /@ old;

  newg = {#[[1]], fM + fm - Rescale[#[[2]], {gm, gM}, {fm, fM}]} & /@ 

    g;

  DateListPlot[{f, newg}, Axes -> False, Frame -> True, 

   FrameTicks -> {Automatic, Automatic, None, new}, 

   PlotRange -> {fm, fM}, opts]]



TwoAxisReverseDateListPlot[f_List, g_List, r_, 

  opts : OptionsPattern[]] := 

 Module[{p1, p2, gg, pg2, m, M, fm, fM, gm, gM, ggm, ggM, old, new, 

   newg}, p1 = 

   DateListPlot[f, Axes -> True, Frame -> False, 

    PlotRange -> Automatic];

  gg = g;

  gg[[All, 2]] /= 1 - r;

  p2 = DateListPlot[g, Axes -> True, Frame -> False, 

    PlotRange -> Automatic];

  pg2 = DateListPlot[gg, Axes -> True, Frame -> False, 

    PlotRange -> Automatic];

  {fm, fM} = AbsoluteOptions[p1, PlotRange][[1, 2, 2]];

  {m, M} = {fm, 1/r fM};

  {gm, gM} = AbsoluteOptions[p2, PlotRange][[1, 2, 2]];

  {ggm, ggM} = AbsoluteOptions[pg2, PlotRange][[1, 2, 2]];

  old = AbsoluteOptions[pg2, Ticks][[1, 2, 2]];

  new = Flatten[{(M + m - Rescale[First[#1], {ggm, ggM}, {m, M}]), 

       Rest[#1]}, 1] & /@ old;

  newg = {#[[

       1]], (M + m - (1 - r) Rescale[#[[2]], {gm, gM}, {m, M}])} & /@ 

    g;

  DateListPlot[{f, newg}, Axes -> False, Frame -> True, 

   FrameTicks -> {Automatic, new, None, All}, PlotRange -> {m, M}, 

   opts]]

方法三:

http://wnsl.physics.yale.edu/levelscheme/