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

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

Математическая открытка к 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
голосов: 13

Обсуждение

Новости

Hubble заснял полярное сияние на Юпитере

Наношарф защитит от папарацци

В Сибири создали универсальный маркер стволовых раковых клеток

Биохимики нашли естественное «противоядие» от болезни Альцгеймера

Стали известны детали самой успешной операции по пересадке лица

Система редактирования геномов оказалась эффективной против герпеса

Кстати,
на
52%
сократились...
Конференция IPS-21