将平面图转换(对齐)到Mathematica中的3D图中

时间:2012-01-26 00:38:03

标签: wolfram-mathematica plot

我有一个ODE并且用NDSolve解决它,然后我在2D中的单纯形图上绘制解决方案。

Valid XHTML http://ompldr.org/vY2c5ag/simplex.jpg

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

Valid XHTML http://ompldr.org/vY2dhMg/simps.png

到目前为止,我使用ParametricPlot来制作我的情节。也许我需要的只是ParametricPlot3D,但我不知道如何正确地调用它。

到目前为止,这是我的代码:

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的第三天......

2 个答案:

答案 0 :(得分:3)

你可以使用FindGeometricTransformation找到2D绘图中三角形到三维地图的地图,然后在ParametricPlot3D中使用它绘制你的函数,例如

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}}]

Mathematica graphics

答案 1 :(得分:2)

由于您的解决方案具有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}}]

enter image description here