Наука и технологии России

Вход Регистрация

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

STRF.ru начинает публикации научно-популярных постов в рамках конкурса блогов. Из первой публикации мы узнаем: оказывается, только лишь с помощью формул нарисовать праздничный цветок - красную розу (и даже с шипами и листьями) не так уж и сложно. Для этого понадобится математическая программа Wolfram Mathematica и короткий скрипт. Слово автору блога Глебу Гренкину.

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


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



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

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

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

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

Положим координату r равной константе r0, то есть наша поверхность будет частью сферы радиуса r0. Остаётся задать множество пар координат точек лепестка. Для задания данного множества используем двумерный лепесток. Роль 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]

Оригинал публикации: http://glebgrenkin.blogspot.ru/2015/03/blog-post.html

РЕЙТИНГ

5.00
голосов: 14

Обсуждение

Новости

«Внеземной сигнал» оказался земной помехой

В США впервые вырастили полноценную печень из стволовых клеток

Найдена первопричина алкоголизма

Спортивная добавка благотворно влияет на рост и вес новорождённых

В Азербайджане найден крупный клад монет

Собачью привязанность проверили на МРТ

Кстати,
на
52%
сократились...
Водный форум БРИКС Tech in Media