1
$\begingroup$

I need to show the intersection area of two curves, using the manipulate function in Mathematica. Here's a fully working example, and a preview below it :

EffPot[r_, Energy_, AngMom_] := -Energy/r + (AngMom^2 - 1)/(2 r^2)

PotCurve[Energy_, AngMom_] := Plot[EffPot[r, Energy, AngMom], {r, 0, 10},
    PlotRange -> All,
    PlotPoints -> Automatic,
    PerformanceGoal -> "Quality",
    PlotStyle -> {Thick, RGBColor[0.60, 0.20, 0.40]}]

TotEnergy[Energy_] := Plot[(Energy^2 - 1)/2, {r, 0, 10},
    PlotStyle -> {Thick, RGBColor[0.20, 0.20, 0.80]}]

Manipulate[Show[PotCurve[Energy, AngMom], TotEnergy[Energy],
    PlotRange -> {{0, 10}, {-2, 2}},
    AspectRatio -> 1,
    Frame -> True,
    Axes -> True,
    AxesOrigin -> {0, 0},
    AxesStyle -> GrayLevel[0.7],
    Ticks -> True,
    GridLines -> Automatic,
    GridLinesStyle -> Directive[LightGray, Dashed],
    FrameLabel -> {
            Style["m r / k", 16, Italic],
            Style[Subscript["\[Phi]", "eff"], 16]
    },
    ImageSize -> 500],
    {{Energy, 1, "E"}, -Sqrt[5], Sqrt[5], 0.01, Appearance -> {"Labeled", "Closed"}},
    {{AngMom, 0, "J"}, 0.0, 5, 0.01, Appearance -> {"Labeled", "Closed"}}
    ]

Preview (with the intersection area added by hand) :

Two curves intersecting

So my question is how to colorize the intersection area between both curves ? Please, take note that I'm using Mathematica 7.

$\endgroup$
3
  • 1
    $\begingroup$ With Mathematica 10.2 (Windows) I just get a horizontal line for most of the possible settings of E and J. However, you should look at the Filling option for Plot. $\endgroup$
    – JimB
    Jan 31, 2016 at 15:47
  • $\begingroup$ Please, can you tell me what is wrong with the code, if it isn't working with your version of Mathematica ? The blue curve is just an horizontal line (total energy). The reddish curve is a potential curve (not a straight line). $\endgroup$
    – Cham
    Jan 31, 2016 at 16:12
  • $\begingroup$ @BobHanlon 's answer shows the fix. $\endgroup$
    – JimB
    Jan 31, 2016 at 16:14

1 Answer 1

3
$\begingroup$

EDIT: added use of PlotLegends package

Use a single Plot with the option Filling

Needs["PlotLegends`"];

EffPot[r_, Energy_, AngMom_] :=
 -Energy/r + (AngMom^2 - 1)/(2 r^2)

Manipulate[
 Plot[{
   EffPot[r, Energy, AngMom],
   (Energy^2 - 1)/2},
  {r, 0, 10},
  PlotStyle -> {
    {Thick, RGBColor[0.60, 0.20, 0.40]},
    {Thick, RGBColor[0.20, 0.20, 0.80]}},
  PlotRange -> {{0, 10}, {-2, 2}},
  AspectRatio -> 1,
  Frame -> True,
  Axes -> True,
  AxesOrigin -> {0, 0},
  AxesStyle -> GrayLevel[0.7],
  Ticks -> True,
  GridLines -> Automatic,
  GridLinesStyle -> Directive[LightGray, Dashed],
  FrameLabel -> {
    Style["m r / k", 16, Italic],
    Style[Subscript["\[Phi]", "eff"], 16]},
  ImageSize -> 500,
  Filling -> {2 -> {{1}, {White, LightGreen}}},
  PlotLegend -> {"EffPot", "TotEnergy"},
  LegendSize -> {.4, .2},
  LegendShadow -> False],
 {{Energy, 1, "E"}, -Sqrt[5], Sqrt[5], 0.01,
  Appearance -> {"Labeled", "Closed"}},
 {{AngMom, 0, "J"}, 0.0, 5, 0.01,
  Appearance -> {"Labeled", "Closed"}}]

enter image description here

Manually draw the legend to avoid the slow down in Manipulate

legend = Row[{
    Graphics[{Thick,
      RGBColor[0.60, 0.20, 0.40],
      Line[{{0, 0}, {1, 0}}]}],
    " EffPot    ",
    Graphics[{Thick,
      RGBColor[0.20, 0.20, 0.80],
      Line[{{0, 0}, {1, 0}}]}],
    " TotEnergy"},
   ImageSize -> {200, 20}];

Manipulate[
 Column[{
   legend,
   Plot[{
     EffPot[r, Energy, AngMom],
     (Energy^2 - 1)/2},
    {r, 0, 10},
    PlotStyle -> {
      {Thick, RGBColor[0.60, 0.20, 0.40]},
      {Thick, RGBColor[0.20, 0.20, 0.80]}},
    PlotRange -> {{0, 10}, {-2, 2}},
    AspectRatio -> 1,
    Frame -> True,
    Axes -> True,
    AxesOrigin -> {0, 0},
    AxesStyle -> GrayLevel[0.7],
    Ticks -> True,
    GridLines -> Automatic,
    GridLinesStyle -> Directive[LightGray, Dashed],
    FrameLabel -> {
      Style["m r / k", 16, Italic],
      Style[Subscript["\[Phi]", "eff"], 16]},
    ImageSize -> 500,
    Filling -> {2 -> {{1}, {White, LightGreen}}}]},
  Alignment -> Center],
 {{Energy, 1, "E"}, -Sqrt[5], Sqrt[5], 0.01,
  Appearance -> {"Labeled", "Closed"}},
 {{AngMom, 0, "J"}, 0.0, 5, 0.01,
  Appearance -> {"Labeled", "Closed"}}]

enter image description here

$\endgroup$
4
  • $\begingroup$ PlotLegends isn't working. Is it compatible with Mathematica 7 (as stated in the question) ? $\endgroup$
    – Cham
    Jan 31, 2016 at 16:15
  • $\begingroup$ Maybe my question wasn't clear enough, but the intersection shouldn't include the part going to infinity, below the curves. It should colorize the finite part only. $\endgroup$
    – Cham
    Jan 31, 2016 at 16:19
  • $\begingroup$ It is unclear what filling you want. See documentation for Filling to adjust however you want. $\endgroup$
    – Bob Hanlon
    Jan 31, 2016 at 16:45
  • $\begingroup$ The legend package works, but the manipulate is now extremely slow and laggy. I much prefer the legend you have done at first, but apparently this isn't compatible with Mathematica 7 :-( $\endgroup$
    – Cham
    Jan 31, 2016 at 17:05

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.