6
$\begingroup$

I need to display two y-values for a list of points. I tried doing this:

data=Import["https://pastebin.com/raw/cJtpDmcm","Table"];
p1=ListPlot[data[[All,1;;2]],PlotRange->{{6,10},{3,7}},ImageSize->500,PlotTheme->"Monochrome",BaseStyle->Directive["TR",FontSize->16,Black],Frame->{{True,False},{True,True}},FrameTicks -> {{All, None}, {All,None}},ImagePadding ->{{60, 60}, {60,10}}];
p2=ListPlot[data[[All,3;;4]],PlotRange->{{6,10},{100,300}},PlotTheme->"Monochrome",ImageSize->500,BaseStyle->Directive["TR",FontSize->16,Black],Frame->{{False,True},{False,False}},FrameTicks -> {{None, All}, {None, None}},ImagePadding ->{{60, 60}, {60,10}},FrameStyle -> {{Automatic, Red}, {Automatic, Automatic}},FrameTicksStyle -> Directive[16, "TR"],PlotStyle->Red];
Overlay[{p1,p2}]

Output:

enter image description here

It works, but I wish I could rescale the red y-values so I only need to plot one set of dots. Something like this:

enter image description here

How can I do that?

$\endgroup$
3
  • $\begingroup$ Do you know that the points lie exactly like that? In that case, would it do to simply put labels manually on the y-axis to the left? $\endgroup$
    – C. E.
    Aug 27, 2020 at 18:42
  • $\begingroup$ They don't lie exactly like that. Placing the labels manually won't be practical if I need to change the parameters. I was hoping for something automatic. $\endgroup$
    – Rodrigo
    Aug 27, 2020 at 18:50
  • 1
    $\begingroup$ Take a look at MultipleAxesListPlot. $\endgroup$ Aug 27, 2020 at 23:10

3 Answers 3

4
$\begingroup$

The tick marks on the right can constructed with an interpolation function like this:

data = Import["https://pastebin.com/raw/cJtpDmcm", "Table"];

ifun42 = Interpolation[data[[All, {4, 2}]], InterpolationOrder -> 1];
labels = {150, 200, 250, 300, 350};
ticks = Table[{ifun42[x],
     If[TrueQ@MemberQ[labels, x], Style[x, Red], Null]},
    {x, 100, 350, 10}] // Quiet;

The interpolation is from the 4th column of data to the 2nd. Note that an interpolation order of 1 spaces the tick marks linearly between the data points, not between the tick labels. This effect can be seen by comparing the spacing of the ticks at 160 and 170 to the spacing of the ticks at 170 and 180. A higher order interpolation, like the default of 3, gives better results.

For the horizontal and vertical gridlines, we will just use the Epilog option. But first, we construct the lines like this

pRange = {{6, 11}, {3, 8}};
horzLines = {Thin, Dashed, 
   Red, Line[Table[
     {pt, {pRange[[1, 2]], pt[[2]]}}, {pt, data[[All, {1, 2}]]}]],
   Blue, Line[Table[
     {{pRange[[1, 1]], pt[[2]]}, pt}, {pt, data[[All, {1, 2}]]}]]};
vertLines = {Thin, Dashed, Black, Line[Table[
      {pt, {pt[[1]], pRange[[2, 1]]}}, {pt, data[[All, {1, 2}]]}]]};

Now pull it all together like this

ListPlot[data[[All, 1 ;; 2]],
 PlotRange -> pRange,
 Frame -> True,
 FrameTicks -> {{All, ticks}, {All, None}},
 Epilog -> {horzLines, vertLines}
 ]

enter image description here

$\endgroup$
4
$\begingroup$

Using ifun42 from LouisB's answer in an alternative way

ifun42 = Interpolation[data[[All, {4, 2}]], InterpolationOrder -> 1];
invifun42 = InverseFunction @ ifun42;

options = {BaseStyle -> Directive["TR", FontSize -> 16, Black], 
   PlotStyle -> Black, ImageSize -> 500, PlotRange -> All, 
   PlotRangePadding -> 1, Frame -> True, 
   FrameStyle -> {{Automatic, Red}, {Automatic, Automatic}}, 
   FrameTicks -> {{All, Charting`ScaledTicks[{ifun42, invifun42}][##, {6, 2}] &}, 
      {All, None}}, 
    GridLines -> Automatic, GridLinesStyle -> Dashed};

ListPlot[{MapAt[ifun42, data[[All, 3 ;; 4]], {All, 2}], data[[All, 1 ;; 2]]}, 
 PlotStyle -> {Directive[Red, AbsolutePointSize[15]], Black}, options]

enter image description here

Alternatively,

prolog = ListPlot[data[[All, {3, 4}]], 
    ScalingFunctions -> {None, {ifun42, invifun42}}, 
    PlotStyle -> Directive[Red, AbsolutePointSize[15]]][[1]];

ListPlot[data[[All, 1 ;; 2]], options, Prolog -> prolog]

same picture

Replace {6, 2} in Charting`ScaledTicks[...][...] with {10, 1} to get

enter image description here

$\endgroup$
2
$\begingroup$

Adapting Jason B.'s answer here

Still plots two sets of points though.

TwoAxisListPlot[{list1_, list2_}, opts : OptionsPattern[]] := 
 Module[{plot1, plot2, ranges},
  {plot1, plot2} = ListLinePlot /@ {list1, list2};
  ranges = Last@Charting`get2DPlotRange@# & /@ {plot1, plot2};
  ranges[[2]] = Reverse@Last@ranges;
  ListPlot[{list1, Transpose[{
      First /@ list2,
      Rescale[Last /@ list2, Last@ranges, First@ranges]}]},
   Frame -> True,
   FrameTicks -> {
     {Automatic, Charting`FindTicks[First@ranges, Last@ranges]},
     {Automatic, Automatic}},
   FrameStyle -> {{Automatic, ColorData[97][2]}, {Automatic, Automatic}},
   FilterRules[{opts}, Options[ListPlot]]]]

data = Import["https://pastebin.com/raw/cJtpDmcm", "Table"];

TwoAxisListPlot[{data[[All, {1, 2}]], data[[All, {3, 4}]]}, Joined -> False]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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