Как я могу построить функцию, определенную на единичном симплексе в Mathematica? - PullRequest
Новая
       48

Как я могу построить функцию, определенную на единичном симплексе в Mathematica?

6 голосов
/ 24 февраля 2011

Я пытаюсь построить функцию в Mathematica , которая определена над единичным симплексом. Чтобы взять случайный пример, предположим, что я хочу построить график sin (x1 * x2 * x3) по всем x1, x2, x3 так, чтобы x1, x2, x3> = 0 и x1 + x2 + x3 = 1. Есть ли аккуратный способ сделать это, кроме очевидного способа написать что-то вроде 

Plot3D[If[x+y<=1,Sin[x y(1-x-y)]],{x,0,1},{y,0,1}]

Mathematica graphics

В идеале мне нужен способ построения только над симплексом. Я нашел веб-сайт http://octavia.zoology.washington.edu/Mathematica/, в котором есть старый пакет, но он не работает в моей современной версии Mathematica .

Ответы [ 2 ]

9 голосов
/ 24 февраля 2011

Если вы хотите получить симметрично выглядящие графики, как в том пакете, который вы связали, вам нужно вычислить матрицу вращения, которая переводит симплекс в плоскость x / y.Вы можете использовать эту функцию ниже.Это довольно долго, потому что я ушел в расчеты, чтобы выяснить центрирование симплекса.Как ни странно, преобразование для 4-го симплексного графика намного проще.Измените переменную e, чтобы получить различную маржу 

simplexPlot[func_, plotFunc_] := 
 Module[{A, B, p2r, r2p, p1, p2, p3, e, x1, x2, w, h, marg, y1, y2, 
   valid},
  A = Sqrt[2/3] {Cos[#], Sin[#], Sqrt[1/2]} & /@ 
     Table[Pi/2 + 2 Pi/3 + 2 k Pi/3, {k, 0, 2}] // Transpose;
  B = Inverse[A];

  (* map 3d probability vector into 2d vector *)
  p2r[{x_, y_, z_}] := Most[A.{x, y, z}];

  (* map 2d vector in 3d probability vector *)
  r2p[{u_, v_}] := B.{u, v, Sqrt[1/3]};

  (* Bounds to center the simplex *)
  {p1, p2, p3} = Transpose[A];

  (* extra padding to use *)
  e = 1/20;

  x1 = First[p1] - e/2;
  x2 = First[p2] + e/2;
  w = x2 - x1;
  h = p3[[2]] - p2[[2]];
  marg = (w - h + e)/2;
  y1 = p2[[2]] - marg;
  y2 = p3[[2]] + marg;

  valid = 
   Function[{x, y}, Min[r2p[{x, y}]] >= 0 && Max[r2p[{x, y}]] <= 1];
  plotFunc[func @@ r2p[{x, y}], {x, x1, x2}, {y, y1, y2}, 
   RegionFunction -> valid]
  ]

Вот как ее использовать 

simplexPlot[Sin[#1 #2 #3] &, Plot3D]

http://yaroslavvb.com/upload/save/simplex-plot1.png

simplexPlot[Sin[#1 #2 #3] &, DensityPlot]

http://yaroslavvb.com/upload/save/simplex-plot2.png

Если вы хотите увидеть домен в исходной системе координат, вы можете повернуть график обратно в симплекс 

t = AffineTransform[{{{-(1/Sqrt[2]), -(1/Sqrt[6]), 1/Sqrt[3]}, {1/
      Sqrt[2], -(1/Sqrt[6]), 1/Sqrt[3]}, {0, Sqrt[2/3], 1/Sqrt[
      3]}}, {1/3, 1/3, 1/3}}];
graphics = simplexPlot[5 Sin[#1 #2 #3] &, Plot3D];
shape = Cases[graphics, _GraphicsComplex];
Graphics3D[{Opacity[.5], GeometricTransformation[shape, t]}, 
 Axes -> True]

http://yaroslavvb.com/upload/save/raster2.png

Вот еще один симплексный график, использующий традиционные трехмерныеоси от здесь и MeshFunctions->{#3&}, полный код здесь

http://yaroslavvb.com/upload/save/simplex.png

3 голосов
/ 24 февраля 2011

Попробуйте: 

Plot3D[Sin[x y (1 - x - y)], {x, 0, 1}, {y, 0, 1 - x}]

Mathematica graphics

Но вы также можете использовать Piecewise и RegionFunction: 

Plot3D[Piecewise[{{Sin[x y (1 - x - y)], 
    x >= 0 && y >= 0 && x + y <= 1}}], {x, 0, 1}, {y, 0, 1}, 
 RegionFunction -> Function[{x, y}, x + y <= 1]]
...