“Engineers like to solve problems. If there are no problems handily available, they will create their own problems.”

~ Scott Adams

Díselo con Mathematica


Sábado, 11 de febrero de 2012

Como probablemente sepáis, la curiosa condición humana ha dado en celebrar el cercano 14 de febrero, en memoria del salvaje apaleamiento de un tal Valentín y su posterior decapitación, tras haber sido arrastrado hecho un desastre por las calles de Roma hasta la puerta Flaminia, el día de los enamorados.

Haciendo honor al subtítulo la página, en We choose the Moon hemos pensado… ¿por qué no aplicar la ingeniería, matemáticas, etc., incluso en ésta probablemente poco adecuada ocasión?

Quizá, por raro que parezca, habrá quien quiera declararse a su media naranja de un modo particularmente geek, o tal vez recordar a su medio átomo qué clase de fuerte interacción los mantiene unidos. Así que para ellos, unos cuantos trucos para decírselo… con Mathematica!

Empezando por uno fácil…

Vamos a empezar por una ecuación que destaca por su simplicidad e inocencia y que se puede deslizar en cualquier sitio sin mucha dificultad:

(1)   \begin{equation*}\sqrt{\cos\ x}\cos(200x)+\sqrt{|x|}-0.7(4-x^2)^{0.01}\end{equation*}

Para descubrir de qué se trata, podemos graficarlo con Mathematica, mediante el siguiente código:

Plot[Sqrt[Cos[x]]*Cos[200*x] + Sqrt[Abs[x]] - 0.7*(4-x*x)^0.01,{x,-2,2}]

Sin embargo, podemos mejorarlo un poco ajustando el gráfico, coloreándolo, y animándolo, exportándolo como .gif. Para ello se usa el comando Export[] sobre una tabla de gráficos, donde cada uno de ellos representa una frame de la animación. El código es el siguiente:

Export[NotebookDirectory[] <> "anim1.gif", Table[
   Plot[Sqrt[Cos[x]]*Cos[200*x] + Sqrt[Abs[x]] - 0.7*(4 - x*x)^0.01,
   {x, -2, t}, PlotStyle -> Red, Frame -> True,
   Axes -> False, PlotRange -> {{-2, 2}, {-1.7, 1.1}}]
, {t, -1.57, 2, 0.01}]]

Con ello, hemos logrado la siguiente animación, donde no deja de haber un curioso efecto de aliasing que la dota involuntariamente de cierta vida:

Ahora algo más complejo…

Si un simple corazón en 2D no te parece suficiente, quizá sea el momento de recurrir a algo más avanzado, como la superficie tridimensional cuya expresión, en principio bastante árida y formal como la mayoría en matemáticas es la siguiente:

(2)   \begin{equation*}\left(\left(x^2+\frac{9y^2}{4}+z^2-1\right)^3-x^2z^3-\frac{9y^2z^3}{80}\right)=0\end{equation*}

Esta expresión tan formal la podemos representar mediante el siguiente código:

RegionPlot3D[((x^2+(9y^2)/4+z^2-1)^3-x^2 z^3-(9y^2 z^3)/80) < 0,
  {x, -1.3, 1.3}, {y, -1.3, 1.3}, {z, -1.3, 1.3},
  PlotStyle -> {Red, Specularity[White, 40]}, Mesh -> {10, 8},
  Lighting -> "Neutral"]

Con lo que obtenemos este curioso resultado, el corazón de Taubin:

Nota: no sé si el hecho de que Taubin sea argentino es relevante para el caso.

Y si sólo lo mejor es suficiente…

Quizá creas que un simple corazón no basta para expresar suficientemente tanto tu amor como tu preocupante tendencia a involucrar los códigos y las matemáticas en todas las facetas de la vida. Pues bien, con esto puedes despejar ambas dudas a las claras.

Vamos a emplear un programa complejo, con lo que necesitarás un ordenador potente o mucha paciencia. En primer lugar definimos la siguiente función:

Rosa[x_, theta_] = Module[{
  phi = (Pi/2) Exp[-theta/(8 Pi)],
  X = 1 - (1/2) ((5/4) (1 - Mod[3.6 theta, 2 Pi]/Pi)^2 - 1/4)^2},
  y = 1.95653x^2(1.27689x-1)^2 Sin[phi]; r = X(x Sin[phi]+y Cos[phi]);
   {r Sin[theta],r Cos[theta],X(x Cos[phi]-y Sin[phi]),EdgeForm[]}];

Y ahora despejamos la salida del ventilador del ordenador, y graficamos dicha función de la manera siguiente:

ParametricPlot3D[Rosa[x, theta], {x, 0, 1}, {theta, -2 Pi, 15 Pi},
  PlotPoints -> {25, 576}, PlotStyle -> {Red, Specularity[White,40},
  Mesh -> {10, 8}, Lighting -> "Neutral"]

Con lo que después de un tiempo obtenemos finalmente una bonita rosa tridimensional, que se puede rotar o modificar de muchas formas y a buen seguro satisfará a los más exigentes:

Y para variar, conclusiones

Espero que haya resultado divertida  o curiosa la entrada de hoy, y que si alguien encuentra el amor con uno de estos trucos matemágicos, se apresure a reflejarlo debidamente en los comentarios! A veces un toque de originalidad no está de más en esta cultura prefabricada de hoy en día.

Las ecuaciones y funciones vienen principalmente de Mike Croucher, que escribe el absolutamente genial Walking Randomly y de Paul Nylander, que en algún punto de su vida vendió su alma a cambio de una increíble habilidad con Mathematica. Recomiendo encarecidamente ambos, pero sobretodo el blog de Mike, a quien se interese por las matemáticas computacionales. Que probablemente tenga tiempo libre el día 14.

Categoría: Sin categoría | Etiquetas: , | Comentarios: 6 Comentarios »


Página 1 de 1712345Última