Математическая роза

Вот такую математическую открытку можно сделать с помощью Wolfram Mathematica. Здесь я расскажу, как получить эти формулы.

На такой рисунок меня вдохновила роза, нарисованная методом Монте-Карло с реализацией на JavaScript.

Вначале нам понадобится двумерный лепесток. Предлагается использовать следующую формулу:

График неравенства:

При заданном y неравенство выполняется для точек (x, y), для которых

 

При этом

Теперь зададим уравнение поверхности в сферических координатах .

Положим координату r равной константе r₀, то есть наша поверхность будет частью сферы радиуса r₀. Остаётся задать множество пар координат точек лепестка. Для задания данного множества используем двумерный лепесток. Роль x теперь будет играть , а роль y будет играть . Искомое множество имеет вид

  

Здесь

Параметры подобраны так, что разброс значений равен , разброс значений равен , а минимальное значение равняется .
Вот как выглядит полученный лепесток.

Всё, что остаётся сделать -- это взять несколько таких лепестков с разными радиусами сферы. Но для каждого лепестка ещё нужно сделать преобразование сферы по оси z, чтобы размеры всех эллипсоидов по оси z были одинаковыми.
В формулах, приведённых на рисунке, используется параметрическое представление поверхности в сферических координатах, при этом в уравнении для z для всех лепестков берётся одно и то же r.

Исходный код в Wolfram Mathematica:

theta[t_, s_] := (t + 1 + Sqrt[7])/(2*Sqrt[7])*0.4*Pi - 0.4*Pi + 0.1;

phi[t_, s_] := Sqrt[8 - 4*t^2/Abs[t - 3]]*s/(2*Sqrt[2])*Pi/4;

xx[t_] := 0;

yy[t_] := -3 t*(1 - t);

zz[t_] := -11 - 28 t;

rr = 0.5;

x1[t_] := 0;

y1[t_] := 0 + 7 t;

z1[t_] := -25 + 8 t;

r[k_] := 14 - 0.8 k;

phi0[k_] := 0.4*Pi*k;

Show[ParametricPlot3D[
  Table[{r[k]*Cos[phi0[k] + phi[t, s]]*Cos[theta[t, s]],
    r[k]*Sin[phi0[k] + phi[t, s]]*Cos[theta[t, s]],
    r[1]*Sin[theta[t, s]]}, {k, 1, 15}],
  {t, -1 - Sqrt[7], -1 + Sqrt[7]}, {s, -1, 1},
  PlotStyle ->
   Directive[Specularity[RGBColor[1, 0.3, 0], 20],
    RGBColor[1, 0, 0.5],
    Lighting -> {{"Directional", White, {2, 0, 2}}, {"Ambient",
       Darker[White]}}], Mesh -> None],
 ParametricPlot3D[{xx[t] + rr*Cos[phi], yy[t] + rr*Sin[phi],
   zz[t]}, {t, 0, 1}, {phi, 0, 2 Pi}, Mesh -> None,
  PlotStyle -> Darker[Green]],
 ParametricPlot3D[{x1[t] + phi*t*(1 - t), y1[t] - 25 phi*t*(1 - t)^3,
   z1[t]}, {t, 0, 1}, {phi, -1, 1}, Mesh -> None,
  PlotStyle -> Darker[Green]], PlotRange -> All]