Murciélago Complejo

Descargar como Notebook

Dadas las funciones

A[t] = 3 Sin³[t] - 3 I/4 Cos[4 t] y B[t] = 3/2 Sin⁵[t] - I/2 Cos[3 t]

graficando la parte real y la parte imaginaria del segmento que las une, podemos encontrar una gráfica que se asemeja a un murciélago.

A[t_] := 3. Sin[t]^3 - 3 I/4 Cos[4 t]
B[t_] := 3./2 Sin[t]^5 - I/2 Cos[3 t]
ParametricPlot[
 ReIm[λ A[t] + (1 -λ) B[t]], {λ, -1, 1}, {t,  0, 2 Pi}]

Podemos generar otro tipo de figuras variando el intervalo de Lambda.

Manipulate[
 ParametricPlot[
  ReIm[λ A[t] + (1 - λ) B[t]], {λ, -a, a}, {t,0, 2 Pi}], {a, 0.0001, 5}]

Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas

Frase Célebre de Albert Einstein

¡Si yo estuviese equivocado, uno sólo habría sido suficiente!

Refiriéndose al libro "100 autores en contra de Einstein"

Albert Einstein

Óvalo de Cassini

Descargar como Notebook

Dados dos puntos del plano (focos) y una constante positiva, el Óvalo de Cassini corresponde al conjunto de puntos en el plano tales que el producto de las distancias a los focos es igual a la constante dada.

Sean la constante C los focos en los puntos (-2,0) y (2,0). Entonces la ecuación del Óvalo de Cassini corresponde al conjunto:

Variando el valor C de la constante, obtenemos:

base = ContourPlot[((x + 2)^2 + y^2) ((x - 2)^2 + y^2) == 16, {x, -4, 4}, {y, -3, 3}, ContourStyle -> Green];
Manipulate[
 Show[base, 
  ContourPlot[((x + 2)^2 + y^2) ((x - 2)^2 + y^2) == c^2, {x, -4, 
    4}, {y, -3, 3}, ContourStyle -> {Dashed, Red}]], {c, 0, 10}]

Observamos, que para valores de C menores que la distancia entre los focos se obtienen dos óvalos al rededor de los focos, cuando la constante es igual a la distancia de los focos se obtiene una curva en forma de ocho alrededor de los focos y cuando C es mayor que la distancia entre los focos se obtiene la que se conoce como el Óvalo de Cassini.



Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas

Frase Célebre de Cicerón

Como nada es más hermoso que conocer la verdad,
nada es más vergonzoso que aprobar la mentira 
y tomarla por verdad.

Cicerón

Pila de Tablas

Descargar como Notebook

Tenemos una pila de tablas que giran a diferentes velocidades sobre su centro.

v[x_, y_, z_] = 
  Flatten[Table[{(-1)^i*x, (-1)^j*y, (-1)^k*z}, {i, 0, 1}, {j, 0, 
     1}, {k, 0, 1}], 2];

f = {{1, 2, 4, 3}, {1, 2, 6, 5}, {5, 6, 8, 7}, {3, 4, 8, 7}, {1, 3, 7, 5}, {2, 4, 8, 6}};

G[x_, y_, z_, s_, H_, t_] := 
 Table[Translate[
   Rotate[GraphicsComplex[v[x, y, z], Polygon[f]], 
    h (Cos[t] + 1) Pi/4, {0, 0, 1}], {0, 0, s*h}], {h, 1, H}]

Manipulate[
 Graphics3D[G[2, 2, .1, .25, 30, t], Lighting -> "Neutral", 
  ViewPoint -> Front, ViewAngle -> 35 Degree, Boxed -> False, 
  ImageSize -> 500], {t, 0, Pi}]

El código no es mio, pero no recuerdo su origen.

Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas

Frase Célebre de Petrus Jacobus Joubert

Es mejor debatir una cuestión sin resolverla
que resolver una cuestión sin debatirla.

Petrus Jacobus Joubert

La Super fórmula de Gielis

Descargar como Notebook

Es una generalización en coordenadas polares de la superelipse o curva de Lamé (de la cual publique aquí), fue propuesta en el año de 2003 por el biólogo Johan Gielis para simular la forma de algunos organismos unicelulares, se define como:

donde r es el radio y θ el ángulo para la representación polar.

En Mathematica

Definimos la función:

formula[{a_, b_, m_}, {n1_, n2_, n3_}, 
  phi_] := (Abs[Cos[m phi/4]/a]^n2 + Abs[Sin[m phi/4]/b]^n3)^(-1/n1)

Algunos de los mejores resultados se obtienen para a=b=1, veamos algunos ejemplos:

Graphics[#, Ticks -> None, Axes -> True, 
   AspectRatio -> 
    Automatic] & /@ (PolarPlot[
      formula[Sequence @@ Rest[#], θ, {θ, 0, 2 Pi},
      PlotLabel -> First[#],
      Axes -> None, 
      PlotStyle -> 
       Directive[{EdgeForm[Blue], FaceForm[Hue[0.5]]}]] & /@ {
     {"m=3; n1=4.5; n2=10; n3=10", {1, 1, 3}, {4.5, 10, 10}},
     {"m=4; n1=12; n2=15; n3=15", {1, 1, 4}, {12, 15, 15}},
     {"m=7; n1=10; n2=6; n3=6", {1, 1, 7}, {10, 6, 6}},
     {"m=5; n1=4; n2=4; n3=4", {1, 1, 5}, {4, 4, 4}},
     {"m=5; n1=2; n2=7; n3=7", {1, 1, 5}, {2, 7, 
       7}}, {"m=3; n1=5; n2=18; n3=18", {1, 1, 3}, {5, 18, 
       18}}, {"m=7; n1=3; n2=4; n3=17", {1, 1, 7}, {3, 4, 
       17}}, {"m=7; n1=3; n2=6; n3=6", {1, 1, 7}, {3, 6, 
       6}}, {"m=8; n1=1; n2=1; n3=8", {1, 1, 8}, {1, 1, 
       8}}, {"m=8; n1=1; n2=5; n3=8", {1, 1, 8}, {1, 5, 
       8}}, {"m=6; n1=1; n2=7; n3=8", {1, 1, 6}, {1, 7, 
       8}}, {"m=4; n1=1; n2=7; n3=8", {1, 1, 4}, {1, 7, 8}}
     } /. Line -> Polygon)

Resumiéndolas en un Manipulate:

Manipulate[
 PolarPlot[
   formula[{1, 1, m}, {n1, n2, n3},θ], {θ, 0, 
    2 \[Pi]},Axes -> None, 
   PlotStyle -> Directive[{EdgeForm[Blue], FaceForm[Hue[0.5]]}]] /. 
  Line -> Polygon, {m, {4, 5, 6, 7, 8}}, {n1, {1, 2, 3}}, {n2, {4, 5, 6, 7, 8}}, {n3, {4, 5, 6, 7, 8}}]

La Super Fórmula en 3D

Consideraremos las coordenadas en cartesianas dadas por:

Así, obtenemos :

Manipulate[
 ParametricPlot3D[{formula[{1, 1, m}, {n1, n2, n3}, θ] Cos[θ] formula[{1, 1, m}, {n1, n2, n3}, φ] Cos[φ], 
   formula[{1, 1, m}, {n1, n2, n3}, θ] Sin[θ] formula[{1, 1, m}, {n1, n2, n3}, φ] Cos[φ], 
   formula[{1, 1, m}, {n1, n2, n3}, φ] Sin[φ]}, {θ, 0, 2 Pi}, 
{φ, 0, 2 Pi}],{m, {4, 5, 6, 7, 8}}, {n1, {1, 2, 3}}, 
{n2, {4, 5, 6, 7, 8}}, {n3, {4, 5, 6, 7, 8}}]

La invitación es para modificar el código y darle otros valores a los parámetros que definen la Super fórmula.


Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas

Frase Célebre de Sylvia Serfaty

Resolver un problema matemático 
es como una caminata cuesta arriba,
excepto que no siempre puedes ver el camino 
o lo lejos que estás de la cima.

Sylvia Serfaty

Curva de Lamé

Descargar como Notebook

Su nombre se debe al matemático francés Gabriel Lamé, a quien se debe la notación cartesiana de las cónicas.

La curva de Lamé corresponde al lugar geométrico en el plano xy que satisface la ecuación:

donde k toma valores mayores que cero, si k es menor que 2 es una hipo-circunferencia y si k es mayor que 2 es una hiper-circunferencia.

En Mathematica

Grid@Table[{"k=", k, 
   ContourPlot[Abs[x]^k + Abs[y]^k == 1, {x, -1, 1}, {y, -1, 1}, 
    Axes -> True, ContourStyle -> Red, FrameTicks -> False]}, {k, 0.5,
    3, 0.5}]

El área de la región encerrada por una Curva de Lamé, está dada por :

Generalización

Se puede generalizar la Curva de Lamé considerando diferentes valores de los exponentes:

TableForm[
 Table[RegionPlot[Abs[x]^k + Abs[y]^n <= 1, {x, -1, 1}, {y, -1, 1}, 
   Axes -> True, FrameTicks -> False], {k, 0.5, 4, 1}, {n, 0.5, 4, 
   1}], TableHeadings -> {{"k=0.5", "k=1.5", "k=2.5", 
    "k=3.5"}, {"n=0.5", "n=1.5", "n=2.5", "n=3.5"}}]

Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas