在Mathematica中将平面图变换（对齐）成3D图

我有一个ODE，我用NDSolve解决它，然后我在2D中绘制一个单纯形的解决方案。在Mathematica中将平面图变换（对齐）成3D图

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

然后，我需要变换（对齐或只图）这个单纯的三维坐标（1,0,0），（0,1,0），（0,0,1），所以它看起来是这样的方案：

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

来源

2012-01-26 0xbadc0de

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

来源

2012-01-26 04:57:38

你可以找到使用FindGeometricTransformation使用FindGeometricTransformation中的二维图中的三角形到三维中的图并使用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

来源

2012-01-26 09:20:21 Heike

在Mathematica中将平面图变换（对齐）成3D图

回答

相关问题