0
$\begingroup$

I am using the TwoAxisListPlot package to generate a plot with two y-axes (obviously!). I have made a NonlinearModelFit to one of the plots in my two-axis plot and would like to overlay this fitted plot with my two-axis plot.

However, the Show function seems to be attaching the plot with the left-hand y-axis rather than the right-hand one. As seen here:

Miss-matched Axis

I checked the model by plotting the right-hand y-axis data with the model without the left-hand y-axis data, and it behaved as it should:

Working Model and Show

So there is no problem with the model or data it is the way I am overlaying my plots.Is there a way to tell Show which axis to "mate" a plot with?

Thanks all!

Unfortunately I can't seem to find the original link where I acquired the package. So I have attached the original package bellow. Sorry about that!

    (* Mathematica Package *)

(* Created by the Wolfram Workbench Sep 21, 2008 *)

BeginPackage["TwoAxisListPlot`"]
(* Exported symbols added here with SymbolName::usage *) 
TwoAxisListPlot::usage = 
  "TwoAxisListPlot[{data 1,data 2},opts] rescales the \
second data set and plots both data sets on the same plot with the \
ticks for the first data set on the left and those for the second \
data set on the right. Ticks are automatically colored to match the \
data set they represent. The function takes any option that can be \
used with ListPlot.";

TwoAxisListLinePlot::usage = 
  "TwoAxisListLinePlot[{data 1,data 2},opts] rescales the \
second data set and plots both data sets on the same plot with the \
ticks for the first data set on the left and those for the second \
data set on the right. Ticks are automatically colored to match the \
data set they represent. The function takes any option that can be \
used with ListLinePlot.";
Begin["`Private`"]
(* Implementation of the package *)

Unprotect[FindDivisions,TwoAxisListPlot,TwoAxisListLinePlot];

FindDivisions = 
 If[$VersionNumber < 6.1, Developer`FindDivisions, 
  FindDivisions]; 

  setcol[styl : _RGBColor | _Hue | _CMYKColor | _GrayLevel] := {styl}

setcol[styl_List] := 
 With[{col = 
    Select[styl, 
     MemberQ[{RGBColor, Hue, CMYKColor, GrayLevel}, Head[#]] &]}, 
  If[col =!= {}, {col}, col]]

setcol[_] := {}

rools2 = {{a : _RGBColor | _Hue | _CMYKColor | _GrayLevel List, {}} \
:> {a, ColorData[1][2]}, {{}, 
     b : _RGBColor | _Hue | _CMYKColor | _GrayLevel} :> {ColorData[1][
      1], b}, {{}, {}} :> {ColorData[1][1], ColorData[1][2]}};

frameproc[opts__] := Module[{styls},
  styls = Select[{opts}, #[[1]] === PlotStyle &][[1, 2]];
  If[Length[styls] == 1, styls = Join[styls, styls], Take[styls, 2]];
  Map[setcol, styls] /. rools2
  ]

  Options[TwoAxisListPlot] = {AlignmentPoint -> Center, 
   AspectRatio -> 1/GoldenRatio, Axes -> True, AxesLabel -> None, 
   AxesOrigin -> Automatic, AxesStyle -> {}, Background -> None, 
   BaselinePosition -> Automatic, BaseStyle -> {}, 
   ClippingStyle -> None, ColorFunction -> Automatic, 
   ColorFunctionScaling -> True, ColorOutput -> Automatic, 
   ContentSelectable -> Automatic, 
   CoordinatesToolOptions -> Automatic, DataRange -> Automatic, 
   DisplayFunction :> $DisplayFunction, Epilog -> {}, Filling -> None,
    FillingStyle -> Automatic, FormatType :> TraditionalForm, 
   Frame -> True, FrameLabel -> None, 
   FrameStyle -> {{ColorData[1][1], ColorData[1][2]}, Automatic}, 
   FrameTicks -> Automatic, FrameTicksStyle -> {}, GridLines -> None, 
   GridLinesStyle -> {}, ImageMargins -> 0.`, ImagePadding -> All, 
   ImageSize -> Automatic, InterpolationOrder -> None, 
   Joined -> False, LabelStyle -> {}, MaxPlotPoints -> \[Infinity], 
   Mesh -> None, MeshFunctions -> {#1 &}, MeshShading -> None, 
   MeshStyle -> Automatic, Method -> Automatic, 
   PerformanceGoal :> $PerformanceGoal, PlotLabel -> None, 
   PlotMarkers -> None, PlotRange -> Automatic, 
   PlotRangeClipping -> True, PlotRangePadding -> Automatic, 
   PlotRegion -> Automatic, PlotStyle -> Automatic, 
   PreserveImageOptions -> Automatic, Prolog -> {}, 
   RotateLabel -> True};

Options[TwoAxisListLinePlot] = {AlignmentPoint -> Center, 
   AspectRatio -> 1/GoldenRatio, Axes -> True, AxesLabel -> None, 
   AxesOrigin -> Automatic, AxesStyle -> {}, Background -> None, 
   BaselinePosition -> Automatic, BaseStyle -> {}, 
   ClippingStyle -> None, ColorFunction -> Automatic, 
   ColorFunctionScaling -> True, ColorOutput -> Automatic, 
   ContentSelectable -> Automatic, 
   CoordinatesToolOptions -> Automatic, DataRange -> Automatic, 
   DisplayFunction :> $DisplayFunction, Epilog -> {}, Filling -> None,
    FillingStyle -> Automatic, FormatType :> TraditionalForm, 
   Frame -> True, FrameLabel -> None, 
   FrameStyle -> {{ColorData[1][1], ColorData[1][2]}, Automatic}, 
   FrameTicks -> Automatic, FrameTicksStyle -> {}, GridLines -> None, 
   GridLinesStyle -> {}, ImageMargins -> 0.`, ImagePadding -> All, 
   ImageSize -> Automatic, InterpolationOrder -> None, Joined -> True,
    LabelStyle -> {}, MaxPlotPoints -> \[Infinity], Mesh -> None, 
   MeshFunctions -> {#1 &}, MeshShading -> None, 
   MeshStyle -> Automatic, Method -> Automatic, 
   PerformanceGoal :> $PerformanceGoal, PlotLabel -> None, 
   PlotMarkers -> None, PlotRange -> Automatic, 
   PlotRangeClipping -> True, PlotRangePadding -> Automatic, 
   PlotRegion -> Automatic, PlotStyle -> Automatic, 
   PreserveImageOptions -> Automatic, Prolog -> {}, 
   RotateLabel -> True};

TwoAxisListPlot[{data1_List, data2_List}, opts : OptionsPattern[]] := 
 Module[{pltopts, d2vals, d1mn, d1mx, d2mn, d2mx, newdata, rescl, 
   tcklocsm, tcklocsM, d2tcks},
  pltopts = 
   If[Select[{opts}, #[[1]] === PlotStyle &] === {}, 
    Join[{opts}, {FrameStyle -> {{ColorData[1][1], ColorData[1][2]}, 
        Automatic}}], 
    Join[{opts}, {FrameStyle -> {frameproc[opts], Automatic}}]];
  d2vals = If[MatrixQ[data2], data2[[All, 2]], data2];
  {d1mn, d1mx} = 
   If[MatrixQ[data1], {Min[data1[[All, 2]]], 
     Max[data1[[All, 2]]]}, {Min[data1], Max[data1]}];
  {d2mn, d2mx} = {Min[d2vals], Max[d2vals]};
  rescl[num_] := Rescale[num, {d2mn, d2mx}, {d1mn, d1mx}];
  newdata = 
   If[MatrixQ[data2], 
    Transpose[{data2[[All, 1]], rescl[#] & /@ d2vals}], 
    rescl[#] & /@ d2vals];
  {tcklocsM, tcklocsm} = 
   FindDivisions[{d2mn, d2mx} + ((d2mx - d2mx) .05) {-1, 1}, {10, 
     5}];
  d2tcks = 
   Join[MapThread[{rescl[#1], 
       NumberForm[N[#2], {5, 2}], {0.00675`, 
        0.`}, {AbsoluteThickness[0.125`]}} &, {tcklocsM, 
      tcklocsM}], {rescl[#], 
       "", {0.00375`, 
        0.`}, {AbsoluteThickness[0.125`]}} & /@ (Flatten[
       tcklocsm[[All, 2 ;; -2]]])];
  ListPlot[{data1, newdata}, 
   FrameTicks -> {{Automatic, d2tcks}, {Automatic, Automatic}}, 
   Evaluate@pltopts, Options[TwoAxisListPlot]]

  ]

  TwoAxisListLinePlot[{data1_List, data2_List}, 
  opts : OptionsPattern[]] := 
 Module[{pltopts, d2vals, d1mn, d1mx, d2mn, d2mx, newdata, rescl, 
   tcklocsm, tcklocsM, d2tcks},
  pltopts = 
   If[Select[{opts}, #[[1]] === PlotStyle &] === {}, 
    Join[{opts}, {FrameStyle -> {{ColorData[1][1], ColorData[1][2]}, 
        Automatic}}], 
    Join[{opts}, {FrameStyle -> {frameproc[opts], Automatic}}]];
  d2vals = If[MatrixQ[data2], data2[[All, 2]], data2];
  {d1mn, d1mx} = 
   If[MatrixQ[data1], {Min[data1[[All, 2]]], 
     Max[data1[[All, 2]]]}, {Min[data1], Max[data1]}];
  {d2mn, d2mx} = {Min[d2vals], Max[d2vals]};
  rescl[num_] := Rescale[num, {d2mn, d2mx}, {d1mn, d1mx}];
  newdata = 
   If[MatrixQ[data2], 
    Transpose[{data2[[All, 1]], rescl[#] & /@ d2vals}], 
    rescl[#] & /@ d2vals];
  {tcklocsM, tcklocsm} = 
   FindDivisions[{d2mn, d2mx} + ((d2mx - d2mx) .05) {-1, 1}, {10, 
     5}];
  d2tcks = 
   Join[MapThread[{rescl[#1], 
       NumberForm[N[#2], {5, 2}], {0.00675`, 0.`}, {GrayLevel[0.`], 
        AbsoluteThickness[0.125`]}} &, {tcklocsM, 
      tcklocsM}], {rescl[#], 
       "", {0.00375`, 0.`}, {GrayLevel[0.`], 
        AbsoluteThickness[0.125`]}} & /@ (Flatten[
       tcklocsm[[All, 2 ;; -2]]])];
  ListLinePlot[{data1, newdata}, 
   FrameTicks -> {{Automatic, d2tcks}, {Automatic, Automatic}}, 
   Evaluate@pltopts, Options[TwoAxisListLinePlot]]

  ]
$\endgroup$
  • 1
    $\begingroup$ Can you add a link to the package for reference? $\endgroup$ – J. M. will be back soon Jul 1 '16 at 10:46
  • $\begingroup$ Unfortunately I cannot find the link anymore, however I can attach the package itself to my original question. I hope that is sufficient! $\endgroup$ – Q.P. Jul 1 '16 at 10:51
  • 2
    $\begingroup$ Here's a link: library.wolfram.com/infocenter/MathSource/7507 $\endgroup$ – Szabolcs Jul 1 '16 at 11:34
  • $\begingroup$ @Szabolcs Thanks! Good find! $\endgroup$ – Q.P. Jul 1 '16 at 12:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.