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$
  • 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 '16 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 '16 at 16:12
  • $\begingroup$ @BobHanlon 's answer shows the fix. $\endgroup$ – JimB Jan 31 '16 at 16:14
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$
  • $\begingroup$ PlotLegends isn't working. Is it compatible with Mathematica 7 (as stated in the question) ? $\endgroup$ – Cham Jan 31 '16 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 '16 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 '16 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 '16 at 17:05

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.