Wolfram mathematica 在Mathematica中将平面图转换(对齐)为三维图

Wolfram mathematica 在Mathematica中将平面图转换(对齐)为三维图,wolfram-mathematica,plot,Wolfram Mathematica,Plot,我有一个常微分方程,我用NDSolve求解它,然后在二维单纯形上绘制解 然后我需要在坐标(1,0,0),(0,1,0),(0,0,1)处变换(对齐或只是绘制)这个单纯形,所以它看起来像这个方案: 到目前为止,我使用ParametricPlot进行绘图。也许我只需要ParametericPlot3D,但我不知道如何正确调用它 以下是我目前的代码: Remove["Global`*"]; phi[x_, y_] = (1*x*y)/(beta*x + (1 - beta)*y); betam =

我有一个常微分方程,我用
NDSolve
求解它,然后在二维单纯形上绘制解

然后我需要在坐标(1,0,0),(0,1,0),(0,0,1)处变换(对齐或只是绘制)这个单纯形,所以它看起来像这个方案:

到目前为止,我使用
ParametricPlot
进行绘图。也许我只需要
ParametericPlot3D
,但我不知道如何正确调用它

以下是我目前的代码:

Remove["Global`*"];
phi[x_, y_] = (1*x*y)/(beta*x + (1 - beta)*y);
betam = 0.5;
betaf = 0.5;
betam = s;
betaf = 0.1;
sigma = 0.25;
beta = 0.3;
i = 1;
Which[i == 1, {betam = 0.40,  betaf = 0.60,  betam = 0.1,
   betaf = 0.1,  sigma = 0.25 , tmax = 10} ];
eta[x2_, y2_, p2_] = (betam + betaf + sigma)*p2 - betam*x2 -
   betaf*y2 - phi[x2, y2];
syshelp = {x2'[t] == (betam + betaf + sigma)*p2[t] - betam*x2[t] -
   phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*x2[t],
   y2'[t] == (betaf + betam + sigma)*p2[t] - betaf*y2[t] -
   phi[x2[t], y2[t]] - eta[x2[t], y2[t], p2[t]]*y2[t],
   p2'[t] == -(betam + betaf + sigma)*p2[t] + phi[x2[t], y2[t]] -
   eta[x2[t], y2[t], p2[t]]*p2[t]};
initialcond = {x2[0] == a, y2[0] == b, p2[0] == 1 - a - b};
tmax = 50;

solhelp =
   Table[
      NDSolve[
         Join[initialcond, syshelp], {x2, y2, p2} , {t, 0, tmax},
         AccuracyGoal -> 10, PrecisionGoal -> 15], 
      {a, 0.01, 1, 0.15}, {b, 0.01, 1 - a, 0.15}];

functions =
    Map[{y2[t] + p2[t]/2, p2[t]*Sqrt[3]/2} /. # &, Flatten[solhelp, 2]];

ParametricPlot[Evaluate[functions], {t, 0, tmax},
    PlotRange -> {{0, 1}, {0, 1}}, AspectRatio -> Automatic]

第三天使用Mathematica…

因为您的解决方案具有
x2[t]+y2[t]+p2[t]==1
的属性,所以应该足以绘制如下内容:

functions3D = Map[{x2[t], y2[t], p2[t]} /. # &, Flatten[solhelp, 2]];

ParametricPlot3D[Evaluate[functions3D], {t, 0, tmax}, 
 PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]

由于您的解决方案具有
x2[t]+y2[t]+p2[t]==1的属性,因此应足以绘制如下内容:

functions3D = Map[{x2[t], y2[t], p2[t]} /. # &, Flatten[solhelp, 2]];

ParametricPlot3D[Evaluate[functions3D], {t, 0, tmax}, 
 PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]

您可以使用
FindGeometricTransformation
找到从2D绘图中的三角形到3D绘图中的三角形的映射,并在
ParametericPlot3D
中使用该映射来绘制您的函数,例如

corners2D = {{0, 0}, {1, 0}, {1/2, 1}};
corners3D = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};

fun[pts1_, pts2_] := FindGeometricTransform[Append[pts2, Mean[pts2]], 
   PadRight[#, 3] & /@ Append[pts1, Mean[pts1]], 
  "Transformation" -> "Affine"][[2]]

ParametricPlot3D[Evaluate[fun[corners2D, corners3D][{##, 0}] & @@@ functions], 
  {t, 0, tmax}, PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]

您可以使用
FindGeometricTransformation
找到从2D绘图中的三角形到3D绘图中的三角形的映射,并在
ParametericPlot3D
中使用该映射来绘制您的函数,例如

corners2D = {{0, 0}, {1, 0}, {1/2, 1}};
corners3D = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};

fun[pts1_, pts2_] := FindGeometricTransform[Append[pts2, Mean[pts2]], 
   PadRight[#, 3] & /@ Append[pts1, Mean[pts1]], 
  "Transformation" -> "Affine"][[2]]

ParametricPlot3D[Evaluate[fun[corners2D, corners3D][{##, 0}] & @@@ functions], 
  {t, 0, tmax}, PlotRange -> {{0, 1}, {0, 1}, {0, 1}}]