5
$\begingroup$

All,

I am trying to create a graphic that looks like the follows:

ListLine Plot with two functions and labels

   f[x_] := 1*Exp[-x/2]*Sin[x];
   g[x_] :=  Exp[-x/2]*Cos[x];
   t1 = Table[i, {i, 0, 2*\[Pi], \[Pi]/12}];
   t2 = Table[i, {i, 0, \[Pi], \[Pi]/24}];

   data1 = Partition[Riffle[t1, f[t1]], 2];
   data2 = Partition[Riffle[t2, g[t2]], 2];

A custom function to extract max and min

minmaxCoords[dat_] := Module[{max, maxPos, min, minPos, fMin, fMax},
max = Max[dat[[All, 2]]]; 
maxPos = (First[Flatten[Position[#1, Max[#1]]]] &)[dat[[All, 2]]];
fMax = dat[[maxPos]][[1]];

min = Min[dat[[All, 2]]]; 
minPos = (First[Flatten[Position[#1, Min[#1]]]] &)[dat[[All, 2]]];
fMin = dat[[minPos]][[1]];  
{{fMin, min}, {fMax, max}}]


plot1 = ListLinePlot[
Callout[data1, {"\!\(\*SubscriptBox[\(f\), \(Min\)]\)", 
 "\!\(\*SubscriptBox[\(f\), \(Max\)]\)"}, minmaxf1, 
 CalloutMarker -> "Circle", Appearance -> "CurvedLeader"]
, Frame -> { {True, False}, {True, True}}
, FrameLabel -> {{"f(x)", "y"}, {"x", ""}}
, FrameTicks -> {{True, False}, {True, False}}
, GridLines -> {{First@First@minmaxCoords[data1], 
  First@Last@minmaxCoords[data1]}, None}
, GridLinesStyle -> Directive[Lighter@Red, Dotted]
, Ticks -> {{0, Pi, 2 Pi}, {-1, 1}}
, PlotStyle -> Lighter@Red
, ImageSize -> Large
, AspectRatio -> 0.4
];

plot2 = ListLinePlot[
Callout[data2, "\!\(\*SubscriptBox[\(g\), \(Min\)]\)", 
First@minmaxg1, CalloutMarker -> "Circle", 
Appearance -> "CurvedLeader", LeaderSize -> {20}]
, Frame -> { {False, True}, {False, False}}
, FrameTicks -> {{None, All}, {None, None}}
, FrameLabel -> {{"f1", "g(x)"}, {"x", ""}}
, GridLines -> {{First@First@minmaxg1}, None}
, GridLinesStyle -> Directive[Lighter@Blue, Dotted]
, PlotStyle -> Lighter@Blue
, ImageSize -> Large
, AspectRatio -> 0.4
];

 plot3 = Graphics[{Arrowheads[{-.02, .02}], 
 Arrow[{{First@First@minmaxf1, 0.1}, {First@Last@minmaxf1, 0.1}}], 
 Text["\[CapitalDelta]f", {2.5, 0.12}]}];

I try to plot:

  Overlay[{Show[plot1, plot3], plot2}]

enter image description here

I would really appreciate help on the following items:

  • Callout style
  • Callouts not appearing for red curve
  • Text on top of arrow
$\endgroup$
5
  • $\begingroup$ Sorry, should minmaxf1, and minmaxg1 be obvious? $\endgroup$ Aug 30, 2017 at 18:28
  • 1
    $\begingroup$ Looks like that got truncated when I copied and pasted the code. I added those definitions... $\endgroup$
    – Pam
    Aug 30, 2017 at 18:31
  • $\begingroup$ Why don't you post the solution as an answer? It is okay to self-answer. $\endgroup$
    – Szabolcs
    Aug 31, 2017 at 13:03
  • $\begingroup$ Indeed, I would roll back the edits so that there's an actual question here. $\endgroup$
    – evanb
    Sep 1, 2017 at 9:09
  • $\begingroup$ Rolled back Edits. $\endgroup$
    – Pam
    Sep 1, 2017 at 11:55

1 Answer 1

2
$\begingroup$

Here’s the answer

All,

   f[x_] := 1*Exp[-x/2]*Sin[x];
   g[x_] :=  Exp[-x/2]*Cos[x];
   t1 = Table[i, {i, 0, 2*\[Pi], \[Pi]/12}];
   t2 = Table[i, {i, 0, \[Pi], \[Pi]/24}];

   data1 = Partition[Riffle[t1, f[t1]], 2];
   data2 = Partition[Riffle[t2, g[t2]], 2];

A custom function to extract max and min

minmaxCoords[dat_] := Module[{max, maxPos, min, minPos, fMin, fMax},
max = Max[dat[[All, 2]]]; 
maxPos = (First[Flatten[Position[#1, Max[#1]]]] &)[dat[[All, 2]]];
fMax = dat[[maxPos]][[1]];

min = Min[dat[[All, 2]]]; 
minPos = (First[Flatten[Position[#1, Min[#1]]]] &)[dat[[All, 2]]];
fMin = dat[[minPos]][[1]];  
{{fMin, min}, {fMax, max}}]


minmaxf1 = minmaxCoords[data1];
minmaxg1 = minmaxCoords[data2];


plot1 = ListLinePlot[
Callout[data1, {"\!\(\*SubscriptBox[\(f\), \(max\)]\)", 
 "\!\(\*SubscriptBox[\(f\), \(min\)]\)"}, {Above, Below}, 
CalloutMarker -> "\[EmptyCircle]", CalloutStyle -> Gray, 
LabelStyle -> Directive[Italic], Background -> White, 
Frame -> False, FrameMargins -> 4
]
, Frame -> { {True, False}, {True, True}}
, FrameLabel -> {{"f(x)", "y"}, {"x", ""}}
, FrameTicks -> {{True, False}, {True, False}}
, GridLines -> {{First@First@minmaxCoords[data1], 
  First@Last@minmaxCoords[data1]}, None}
, GridLinesStyle -> Directive[Lighter@Red, Dotted]
, Ticks -> {{0, Pi, 2 Pi}, {-1, 1}}
, PlotStyle -> Lighter@Red
, ImageSize -> Large
, AspectRatio -> 0.5
];

plot2 = ListLinePlot[
Callout[data2, "\!\(\*SubscriptBox[\(g\), \(min\)]\)", Below, 
CalloutMarker -> "\[EmptyCircle]", CalloutStyle -> Gray, 
LabelStyle -> Directive[Italic], Background -> White, 
Frame -> False, FrameMargins -> 4]
, Frame -> { {False, True}, {False, False}}
, FrameTicks -> {{None, All}, {None, None}}
, FrameLabel -> {{"f1", "g(x)"}, {"x", ""}}
, GridLines -> {{First@First@minmaxg1}, None}
, GridLinesStyle -> Directive[Lighter@Blue, Dotted]
, PlotStyle -> Lighter@Blue
, ImageSize -> Large
, AspectRatio -> 0.5
];

plot3 = Graphics[{Arrowheads[{-.02, .02}], 
Arrow[{{First@First@minmaxf1, 0.1}, {First@Last@minmaxf1, 0.1}}], 
Text["\[CapitalDelta]f", {2.5, 0.12}]}];

Overlay[{Show[plot1, plot3], plot2}]

enter image description here

$\endgroup$

Your Answer

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

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