Trying to duplicate in Mathematica a graph from Ordinary Differential Equations by Tenenbaum and Pollard

195 Views Asked by At

In the textbook Ordinary Differential Equations by Tenenbaum and Pollard they have a graph of this eqn:

$x^3+y^3-3xy=0$

The graph is: enter image description here

I've tried:

Plot[x^3 + y^3 - 3 xy = 0, {x, 0, 10}, {y, 0, 10}]

but I get the error message:

Plot::nonopt: Options expected (instead of {y,-10,10}) beyond position 2 in Plot[x^3+y^3-3 xy=0,{x,-10,10},{y,-10,10}]. An option must be a rule or a list of rules.

I'm wondering if anyone can give me some guidance as to whether it's possible to produce this graphic in Mathematica, and if so, how to approach it. I know Mathematica well enough to plot simple functions and manipulate them, but this is beyond my experience and I haven't found the Mathematica help files helpful. Any guidance would be much appreciated!

3

There are 3 best solutions below

0
On

Play around with this.

  aa = ContourPlot[
   x^3 + y^3 - 3 x y == 0, {x, -2.3, 2.5}, {y, -2.3, 2.5}, 
   Axes -> True];

  bb = Plot[x, {x, -1.5, 1.5}];

  cc = Graphics[Line[{{2^(2/3), 0}, {2^(2/3), 1.32}}]]; 

  dd = Plot[-1 - 1. x, {x, -2.4, 1.6}];

  Show[aa, bb, cc, dd]

The plot looks like (you can add the other touches).

enter image description here

1
On

The Plot command works for functions of a single variable; you have an equation of two variables, which can be dealt with using ContourPlot:

ContourPlot[x^3 + y^3 == 3 x*y, {x, -2, 2}, {y, -2, 2},
  Frame -> False, Axes -> True, Ticks -> {{2^(2/3)}, {}}, 
 ContourStyle -> {Thickness[0.007], Black},
 Epilog -> {
   Line[{{{-2, 1}, {2, -3}}, {{-2, -2}, {3/2, 3/2}}}],
   {Thickness[0.005], Line[{{2^(2/3), 2^(1/3)}, {2^(2/3), 0}}]},
   PointSize[Large], Point[{3/2, 3/2}], 
   Text["(3/2,2/3)", {3/2, 3/2}, {-1.4, -0.5}]
   }]

enter image description here

If you really want the fractions typeset properly (or just want better quality typesetting more generally), you might look into the MaTeX package

2
On

The Math

Instead of using ContourPlot to plot $$ x^3+y^3-3xy=0\tag1 $$ I substituted $x=r\cos(\theta)$ and $y=r\sin(\theta)$ and solved for $r$ to get a polar equation on which to call PolarPlot: $$ r=\frac{3\sin(\theta)\cos(\theta)}{\cos^3(\theta)+\sin^3(\theta)}\tag2 $$ The asymptote is the only thing that is not mentioned in the question or original image. By symmetry, we see that the asymptote has slope of $-1$, and so it has an equation of the form $x+y=c$ for some constant $c$. Dividing $(1)$ by $x^2-xy+y^2$, we get $$ \begin{align} \frac{x^3+y^3}{x^2-xy+y^2}&=\frac{3xy}{x^2-xy+y^2}\tag{3a}\\[6pt] \lim_{x\to\infty}(x+y)&=\lim_{x\to\infty}\frac{3x((x+y)-x)}{x^2-x((x+y)-x)+((x+y)-x)^2}\tag{3b}\\ &=\lim_{x\to\infty}\frac{-3\left(1-\frac{x+y}x\right)}{1+\left(1-\frac{x+y}x\right)+\left(1-\frac{x+y}x\right)^2}\tag{3c}\\[6pt] &=-1\tag{3d} \end{align} $$ Explanation:
$\text{(3a)}$: divide $(1)$ by $x^2-xy+y^2$
$\text{(3b)}$: take the limit of both sides as $x\to\infty$
$\text{(3c)}$: divide numerator and denominator by $x^2$
$\text{(3d)}$: evaluate the limit ($x+y$ is bounded as $x\to\infty$)

$(3)$ says that the equation of the asymptote is $$ x+y=-1\tag4 $$ The Code

I wrote a function called DispLaTeX that renders a subset of $\LaTeX$ completely within Mathematica, without invoking external system tools. As this is not in the scope of this answer, I won't detail the function here, but I will simply inline the output of the function.

I tried to match the font, which on Mac OS X Mojave most closely matches "Droid Serif".

This bit of code gives the output of DispLaTeX

(* mtex1=DispLaTeX["$(\\frac32,\\frac32)$"] *)

mtex1=DisplayForm[RowBox[List[StyleBox[RowBox[List[StyleBox[FormBox[RowBox[
  List["(",RowBox[List[FractionBox["3","2"],",",FractionBox["3","2"]]],")"]],
  TraditionalForm],"InlineFormula"],"  "]]]]]];

latex1[size_] := 
 Style[mtex1, FontSize -> 12 size/400, 
  FontFamily -> "Droid Serif", FontWeight -> Bold]

(* mtex2=DispLaTeX["$2^{2/3}$"] *)

mtex2=DisplayForm[RowBox[List[StyleBox[RowBox[List[StyleBox[FormBox[
  SuperscriptBox["2",RowBox[List["2","/","3"]]],TraditionalForm],
  "InlineFormula"],"  "]]]]]];

latex2[size_] := 
 Style[mtex2, FontSize -> 12 size/400, 
  FontFamily -> "Droid Serif", FontWeight -> Bold]

(* mtex3=DispLaTeX["$X$"] *)

mtex3=DisplayForm[ RowBox[List[ StyleBox[ RowBox[List[ StyleBox[FormBox[
  StyleBox["X", "I"], TraditionalForm],  "InlineFormula"], "  "]]]]]];

latex3[size_] := 
 Style[mtex3, FontSize -> 16 size/400, 
  FontFamily -> "Droid Serif", FontWeight -> Bold]

(* mtex4=DispLaTeX["$Y$"] *)

mtex4=DisplayForm[RowBox[List[StyleBox[RowBox[List[StyleBox[FormBox[
  StyleBox["Y","I"],TraditionalForm],"InlineFormula"],"  "]]]]]];

latex4[size_] := 
 Style[mtex4, FontSize -> 16 size/400, 
  FontFamily -> "Droid Serif", FontWeight -> Bold]

(* mtex5=DispLaTeX["$O$"] *)

mtex5=DisplayForm[RowBox[List[StyleBox[RowBox[List[StyleBox[FormBox[
  StyleBox["O","I"],TraditionalForm],"InlineFormula"],"  "]]]]]];

latex5[size_] := 
 Style[mtex5, FontSize -> 16 size/400, 
  FontFamily -> "Droid Serif", FontWeight -> Bold]

Here is the main function and its output

p[size_] := 
 Module[{pt1 = {3/2, 3/2}, pt2 = {2^(2/3), 2^(1/3)}, 
   pt3 = {2^(2/3), 0}}, 
  PolarPlot[
   3 Sin[t] Cos[t]/(Sin[t]^3 + 
       Cos[t]^3), {t, -\[Pi]/4, 3 \[Pi]/4}, 
   PlotRange -> {{-2, 2}, {-2, 5/3}}, 
   PlotStyle -> {Thickness[1/120], Black}, Axes -> True, 
   Ticks -> None, AxesStyle -> Directive[Thickness[1/300]], 
   Epilog -> {PointSize[1/50], Thickness[1/200], Point[pt1], 
     Line[{{pt2, pt3}, {pt1, {-1, -1}}, {{-3, 2}, {2, -3}}}], 
     Text[latex1[size], pt1, {-5/4, -3/4}], 
     Text[latex2[size], pt3, {-3/4, 5/4}], 
     Text[latex3[size], {2, 0}, {-1/2, 1}], 
     Text[latex4[size], {0, 5/3}, {1/2, 0}], 
     Text[latex5[size], {0, 0}, {-3/2, 5/4}]}, ImageSize -> size]]

p[512]

a rendering of the polar equation