Frase Célebre de Carl Sagan

Cada esfuerzo por clarificar lo que es ciencia
y de generar entusiasmo popular sobre ella
es un beneficio para nuestra civilización global.

Carl Sagan

Rotación de un Tetraedro con respecto a los ejes coordenados

Descargar como Notebook

En Mathematica podemos dibujar un tetraedro utilizando dentro del comando Graphics3D[ ] el comando Tetrahedron[ ] donde se especifican los cuatro vértices de la figura,

Graphics3D[Tetrahedron[{{1, 0, 0},{1, 0, 1},{1, 1, 1},{0, 0, 1}}]]

Para realizar una rotación con respecto, por ejemplo al eje X, multiplicamos cada uno de los vértices del tetraedro por la matriz rx:

rx = {{1, 0, 0}, {0, Cos[θ], -Sin[θ]}, {0, Sin[θ], Cos[θ]}}

{{1, 0, 0}, {0, Cos[θ], -Sin[θ]}, {0, Sin[θ], Cos[θ]}}

Obteniendo :

rx.{2, 3, 4}

{2, 3 Cos[θ] - 4 Sin[θ], 4 Cos[θ] + 3 Sin[θ]}

Ahora, en general definimos por lista los vértices del tetraedro inicial y las matrices de rotación como funciones del ángulo de rotación por: rox, roy y roz.

lista = {{1, 2, 2}, {1, 0, 1}, {1, 1, 1}, {0, 0, 1}};
rox[θ_] := {{1, 0, 0}, {0, Cos[θ], -Sin[θ]}, {0, Sin[θ], Cos[θ]}}; 
roy[θ_] := {{Cos[θ], 0, -Sin[θ]}, {0, 1, 0}, {Sin[θ], 0, Cos[θ]}}; 
roz[θ_] := {{Cos[θ], -Sin[θ], 0}, {Sin[θ], Cos[θ], 0}, {0, 0, 1}};
Manipulate[rot[aa_] := Dot[r[θ], aa]; 
 Show[Graphics3D[Tetrahedron[lista], AxesOrigin -> {0, 0, 0}, 
   Axes -> True, AxesStyle -> Directive[Orange, 12], 
   AxesLabel -> {"X", "Y", "Z"}, PlotRange -> 3], 
  Graphics3D[Tetrahedron[Map[rot, lista]]]], {{θ, Pi/4, 
   "Angulo"}, 0, 
  2 Pi}, {{r, rox, "Rotación"}, {rox -> "Eje X", roy -> "Eje Y", 
   roz -> "Eje Z"}}]

Creación del GIF

Export[NotebookDirectory[] <> "tetra.gif", 
 Manipulate[rot[aa_] := Dot[r[θ], aa]; 
 Show[Graphics3D[Tetrahedron[lista], AxesOrigin -> {0, 0, 0}, 
   Axes -> True, AxesStyle -> Directive[Orange, 12], 
   AxesLabel -> {"X", "Y", "Z"}, PlotRange -> 3], 
  Graphics3D[Tetrahedron[Map[rot, lista]]]], {{θ, Pi/4, 
   "Angulo"}, 0, 
  2 Pi}, {{r, rox, "Rotación"}, {rox -> "Eje X", roy -> "Eje Y", 
   roz -> "Eje Z"}}], "AnimationRepetitions" -> Infinity]


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 Antonio Córdoba

Las matemáticas sirven para 
"instalar el sistema operativo" 
en el cerebro humano.

Antonio Córdoba

Trazas de las Superficies Cuadráticas

Descargar como Notebook

Las superficies cuadráticas corresponden a los conjuntos en el espacio de la forma:

donde  A, B, C, D, E, F, G, H, I y J son números reales, para facilitar su estudio eliminamos los términos con los productos entre las variables x, y, z, obteniendo:

los términos que eliminamos causan es rotaciones en las figuras. Así, obtenemos seis formas cuadráticas que corresponden: Paraboloide Elíptico, Paraboloide Hiperbólico, Cono, Elipsoide y los Hiperboloides de una y dos hojas.

Las trazas de una superficie corresponden a las figuras planas que se obtienen al ser cortadas por un plano, aquí consideraremos los planos: z = c, x = c, y = c.

En el siguiente aplicativo se muestra el comportamiento de estos cortes.

xy = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
xz = {xy[[1]], xy[[3]], xy[[2]]};
yz = {xy[[3]], xy[[2]], xy[[1]]};
lista = {{0, 0, -1, 0}, {1, 0, -1, 0}, {0, 1, 0, -4}, {0, -1, 0, 
    0}, {0, -1, 0, -1}, {0, -1, 0, 1}};
Manipulate[{n, c, d, e} = lista[[m]];
 Grid[{{Show[{ContourPlot3D[
       a x^2 + (-1)^n b y^2 + c z^2 + d z + e == 0, {x, -4, 
        4}, {y, -4, 4}, {z, -4, 4}, Mesh -> 3, BoxRatios -> Automatic,
        AxesLabel -> Automatic], 
      ParametricPlot3D[
       u plano[[1]] + v plano[[2]] + l plano[[3]], {u, -4, 4}, {v, -4, 4}, Mesh -> 3, BoundaryStyle -> Black, 
       PlotStyle -> FaceForm[Red, Yellow]]}], 
    Which[plano[[3]] == {0, 0, 1}, 
     ContourPlot[
      a x^2 + (-1)^n b y^2 + c l^2 + d l + e == 0, {x, -4, 4}, {y, -4, 4}, Axes -> True, FrameLabel -> Automatic, 
      PerformanceGoal -> "Quality"], plano[[3]] == {0, 1, 0}, 
     ContourPlot[
      a x^2 + (-1)^n b l^2 + c z^2 + d z + e == 0, {x, -4, 4}, {z, -4, 4}, Axes -> True, FrameLabel -> Automatic, 
      PerformanceGoal -> "Quality"], plano[[3]] == {1, 0, 0}, 
     ContourPlot[
      a l^2 + (-1)^n b y^2 + c z^2 + d z + e == 0, {y, -4, 4}, {z, -4, 4}, Axes -> True, FrameLabel -> Automatic, 
      PerformanceGoal -> "Quality"]]}}, 
  Frame -> All], {{l, 0, "Movimiento del plano (c)"}, -4, 
  4}, {{plano, xy, "Plano de Corte"}, {xy -> "   z=c   ", 
   xz -> "   y=c   ", yz -> "   x=c   "}}, {{a, 0.3}, 0.3, 
  2}, {{b, 1}, 0.3, 
  2}, {{m, 1, "Superficie"}, {1 -> "Paraboloide", 
   2 -> "Paraboloide Hiperbólico", 3 -> "Elipsoide", 4 -> "Cono", 
   5 -> "Hiperboloide de una hoja", 
   6 -> "Hiperboloide de dos hojas"}}, SaveDefinitions -> True]

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