如何绘制易于修改并在 Mathematica 中简单完成的分岔图?

How to plot a bifurcation plot that is easily modifed and simply done in Mathematica?

我有很多分叉图要做,所以我想做一些可以轻松修改的事情。随附的代码是初步尝试。

p1 = Plot[{Sqrt[a], -Sqrt[a]}, {a, -3, 6}];
horiz = Graphics@
  Line[ {{-3, 2}, {6, 2}} ];(*horizontal line at y=2 *)
horiz2 = Graphics@
  Line[ {{-3, -2}, {6, -2}} ];(*horizontal line at y=2 *)
vertm = Graphics@
  Line[ {{-1, -2}, {-1, 2}} ];(*vertical line at a=-1 *)
vert0 = Graphics@
  Line[ {{  0, -2}, {0, 2}} ];(*vertical line at a=0 *)
vert1 = Graphics@
  Line[ {{  1, -2}, {1, 2}} ];(*vertical line at a=1 *)
vert2 = Graphics@
  Line[ {{  2, -2}, {2, 2}} ];(*vertical line at a=21 *)
vert3 = Graphics@
  Line[ {{  3, -2}, {3, 2}} ];(*vertical line at a=3 *)
vert4 = Graphics@
  Line[ {{  4, -2}, {4, 2}} ];(*vertical line at a=4 *)
vert5 = Graphics@
  Line[ {{  5, -2}, {5, 2}} ];(*vertical line at a=5 *)
Show[p1, horiz, horiz2, vertm, vert0, vert1, vert2, vert3, vert4, \
vert5] 

我希望所有的抛物线都是红色的,而不是蓝色和金色的,并且是粗体的,以便突出。最好在下面标记每条垂直线,例如 a=1。你能帮我吗?谢谢。

真诚的, MM

对于粗体红色抛物线:

p1 = Plot[{Sqrt[a], -Sqrt[a]}, {a, -3, 6}, 
   PlotStyle -> {{Red, Thickness[0.01]}, {Red, Thickness[0.01]}}];

要标记垂直线:

vert1 = Graphics@{Line[{{1, -2}, {1, 2}}], Text["a = 1", {1, 2}]};
vert2 = Graphics@{Line[{{2, -2}, {2, 2}}], Text["a = 2", {2, 2}]};

您可以使用 Table 来简化垂直线的生成。

Show[p1, vert1, vert2]

根据您的评论,我认为这更像是您想要做的。

verticalLines[xmin_, xmax_, step_] := 
 Table[Graphics@{Line[{{x, -2}, {x, 2}}], 
    Text["a = " <> ToString[x], {x, 2.2}], PointSize[Large], 
    Point[{x, -2}], Point[{x, 2}]}, {x, xmin, xmax, step}]

p1 = Plot[{Sqrt[a], -Sqrt[a]}, {a, -3, 6}, 
   PlotStyle -> {{Red, Thickness[0.01]}, {Red, Thickness[0.01]}}];

Show[p1, verticalLines[-1, 5, 1]]

p1 = Plot[{0, -a}, {a, -4, 4}, PlotRange -> {-4, 4}, 
   AxesLabel -> {"a", "y=f_a(y)=dy/dt"}, 
   PlotStyle -> {   {Red, Thickness[0.007]}, {Red, 
      Thickness[0.005]}  }];
vertm3 = Graphics@{Line[{ {-3, -3.5}, {-3, 3.0} }], 
    Text["a = -3", {-3, 3.5}]};
vertm2 = Graphics@{Line[{ {-2, -3.5}, {-2, 3.0} }], 
    Text["a = -2", {-2, 3.5}]};
vertm =  Graphics@{Line[{ {-1, -3.5}, {-1, 3.0} }], 
    Text["a = -1", {-1, 3.5}]};
vert0 =   
  Graphics@{Line[{ {  0, -3.5}, {  0, 3.0} }], 
    Text[  "a = 0", {0, 3.5}]};
vert1 =  Graphics@{Line[{ {   1, -3.5}, {  1, 3.0} }], 
    Text[  "a = 1", {1, 3.5}]};
vert2 =  Graphics@{Line[{ {   2, -3.5}, {  2, 3.0} }], 
    Text[  "a = 2", {2, 3.5}]};
vert3 =  Graphics@{Line [{ {  3, -3.5}, {  3, 3.0} }], 
    Text[  "a = 3", {3, 3.5}]};   
Show[p1, vertm3, vertm2, vertm, vert0, vert1, vert2, vert3, 
 Epilog -> {PointSize -> Large,
         Point[{{-3, 0}, {-3, 3}, {-2, 0}, {-2, 2}, {-1, 0}, {-1, 
      1}, {0, 0}, {1, 0}, {1, -1}, {2, 0}, {2, -2}, {3, 
      0}, {3, -3}}] }]