5
$\begingroup$

I have a set of characteristic equations, obtained by method of characteristics from Hamilton-Jacobi equation $$H(q,x) = (q^2-q)x+(1-q^2)x^2$$

$$\partial_s x = (2q-1)x-2qx^2$$

$$\partial_{-s} q = (q^2-q)+2(1-q^2)x$$

They are solved by $q(s) = 1$ and $x(s)$ being a solution of $\partial_s x = x-2x^2$.

The Hamiltonian also vanishes for, $H(1,x)=0, x= 0, x(q) = \frac{q}{1+q}$. And we have fixed points at, $(1,0), (1,1/2), (0,0)$. I want to obtain a phase portrait that looks something like,

enter image description here

I tried the following in Mathematica,

h[q_, x_] := (q^2 -] q) x + (1 - q^2) x^2 
StreamPlot[{D[h[q, x], x], -D[h[q, x], q]} // Evaluate, {q, -0.2, 
  1.2}, {x, -0.2, 0.6}

Some problems

  1. the flows don't look identical to the figure attached.

  2. Is there someway to format the Mathematica output so it looks aesthetically similar to the one pictured.

  3. Also, a way to plot green disks for the fixed points, and plot the vertical orange dashed line using Plot[].

    For reference. https://arxiv.org/pdf/1609.02849.pdf. Page 29, equation 103, 104 (trying to replicate this)

$\endgroup$
  • 3
    $\begingroup$ The equations you use in the code are not exactly the same as the equations you show in the post. E.g. (q^2 - q) is missing a factor of x. The order is also exchanged in the plotting command ($\partial x$ vs $\partial q$). But even after correcting these mistakes, the equations you quote simply do not correspond to the plot you show. $\endgroup$ – Szabolcs Aug 4 at 8:57
  • $\begingroup$ I'd suggest using ParametricPlot for the vertical line. $\endgroup$ – Michael E2 Aug 4 at 11:40
  • $\begingroup$ Do you want to plot the vector field in your code or the vector field in the image? If the image, what is the vector field for the image? (Or what is $H(q,x)$?) $\endgroup$ – Michael E2 Aug 4 at 11:42
  • $\begingroup$ thanks for your comments, i realised some typos. I edited to include $H(q,x)$ $\endgroup$ – jcp Aug 4 at 17:27
  • $\begingroup$ It still doesn't seem to be right, can you please update the StreamPlot code (if it helps to determine the correctness, using the stream points in my answer) so that it matches the system visualized in your image? As I understand this question (the first list item especially), you expect the system to be the same as in the image, and it's not. $\endgroup$ – C. E. Aug 4 at 17:59
9
$\begingroup$

Maybe this?:

h[q_, x_] := (x) (q - 1) ((q + 1) x - q);
sepstyle = Directive[ColorData[97][2], Dashed, AbsoluteThickness[1.6]];
StreamPlot[{D[h[q, x], x], -D[h[q, x], q]} // Evaluate,
  {q, -0.2, 1.2}, {x, -0.2, 0.6}, StreamScale -> 0.5, 
  StreamStyle -> AbsoluteThickness[1.6],
  StreamPoints -> {{
     {{0.5, 0}, sepstyle}, {{-0.1, 0}, sepstyle}, {{1.1, 0}, sepstyle},
     {{1., 0.2}, sepstyle}, {{1., -0.1}, sepstyle}, {{1., 0.55}, sepstyle},
     {{1/2, 1/3}, sepstyle}, {{1.1, 1.1/2.1}, sepstyle}, {{-0.1, -0.1/0.9}, sepstyle},
     Automatic}},
  Epilog -> {Green, PointSize@Large, Point[
     {q, x} /. Solve[
       {D[h[q, x], x], -D[h[q, x], q]} == 0 &&
        Det[D[h[q, x], {{q, x}, 2}]] < 0]
     ]},
  AspectRatio -> Automatic] /. _Arrowheads -> Arrowheads[0.03]

enter image description here

With further manual styling and specification of StreamPoints you can get the following. I think for really good figures some boring grunt-work of this sort is often required. Automatic figures in Mathematica are pretty good, but a "B" still less than an "A".

enter image description here

$\endgroup$
  • $\begingroup$ Perhaps add Axes -> True, AxesStyle -> {Black, AbsoluteThickness[1.]}, together with Method -> {"AxesInFront" -> False}, if the axes are important $\endgroup$ – Michael E2 Aug 4 at 12:10
9
$\begingroup$

This is more of a comment than an answer. I suspect that your equations may not be the same as those used for the image that you posted.

Start by picking some points on the trajectories in the image:

origin = {187, 127}; (*{0, 0}*)
xpt = {610, 128}; (*{1,0}*)
ypt = {187, 381};(*{0,0.6}*)
xscale = First[xpt - origin];
yscale = Last[ypt - origin]/0.6;

pixels = {{403, 106}, {143, 104}, {149, 164}, {154, 200}, {154, 
    232}, {151, 278}, {153, 323}, {326, 206}, {370, 207}, {422, 
    212}, {648, 96}, {663, 155}, {689, 170}, {706, 199}, {644, 381}};
pts = (# - origin)/{xscale, yscale} & /@ pixels;

HighlightImage[img, {Green, origin, xpt, ypt, Red, pixels}, ImageSize -> 500]

Mathematica graphics

If we drop test points at these positions, they should travel as the image shows. However, what we get is something qualitatively different:

Show[
 StreamPlot[
  {x (2 q - 1) + 2 q*x^2, -(q^2 - q) - 2 (1 - q^2)*x},
  {q, -0.2, 1.2},
  {x, -0.2, 0.6},
  StreamPoints -> pts,
  AspectRatio -> 0.6
  ],
 ListPlot[
  pts,
  PlotStyle -> Directive[PointSize[Large], Red]
  ],
 Epilog -> {
   Red,
   InfiniteLine[{0, 0}, {1, 0}],
   InfiniteLine[{1, 0}, {0, 1}]
   }
 ]

Mathematica graphics

I don't believe that the equations you posted can be the same as the ones used for the image since, among other things, there is a cycle about the point (0, 1), which is not the case in your image.

$\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.