4
$\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$
  • $\begingroup$ Sorry, should minmaxf1, and minmaxg1 be obvious? $\endgroup$ – John Joseph M. Carrasco Aug 30 '17 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 '17 at 18:31
  • $\begingroup$ Why don't you post the solution as an answer? It is okay to self-answer. $\endgroup$ – Szabolcs Aug 31 '17 at 13:03
  • $\begingroup$ Indeed, I would roll back the edits so that there's an actual question here. $\endgroup$ – evanb Sep 1 '17 at 9:09
  • $\begingroup$ Rolled back Edits. $\endgroup$ – Pam Sep 1 '17 at 11:55
1
$\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, privacy policy and cookie policy

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