Frase Célebre de David Gelernter

La belleza es más importante en informática 
que en cualquier otro lugar en tecnología
porque la computación es muy complicada.
La belleza es la mejor defensa contra la complejidad.

David Gelernter

Proyecciones de un punto en el circulo unitario sobre sus diámetros

Descargar como Notebook

Tenemos el circulo unitario, centrado en el origen y de radio una unidad, y un punto que se mueve sobre él.
La proyección perpendicular de éste punto sobre los diámetros del circulo que están sobre los ejes coordenados x y y corresponden respectivamente a los valores de coseno y seno (puntos de color naranja y verde).

El segmento de recta que une a los puntos (naranja y verde) siempre tiene longitud de una unidad, su punto medio se encuentra en el corte del segmento con el radio correspondiente del punto sobre la circunferencia unitaria y todos estos puntos medios forman una circunferencia centrada en el origen y de radio media unidad.

gra1 = ContourPlot[x^2 + y^2 == 1, {x, -2, 2}, {y, -2, 2}, 
   Axes -> True];
gra2 = Point[{0, 0}];
Manipulate[
 Show[gra1, 
  If[circulo, ParametricPlot[0.5 {Cos[u], Sin[u]}, {u, 0, t}], gra1], 
  Graphics[{Blue, Line[{{-1, 0}, {1, 0}}], Line[{{0, -1}, {0, 1}}], 
    Green, If[radio, Line[{{0, 0}, {Cos[t], Sin[t]}}], gra2], Black, 
    If[linea, Line[{{0, Sin[t]}, {Cos[t], 0}}], gra2], Red, Dashed, 
    If[proy, Line[{{Cos[t], 0}, {Cos[t], Sin[t]}, {0, Sin[t]}}], 
     gra2], PointSize[0.02], Point[{Cos[t], Sin[t]}], Green, 
    Point[{0, Sin[t]}], Orange, Point[{Cos[t], 0}], Pink, 
    If[puntomedio, Point[0.5 {Cos[t], Sin[t]}], gra2]}]], {{t, 0, 
   "Punto"}, 0.00001, 6 Pi}, {{proy, False, "Proyección"}, {False, True}}, {linea, {False, True}}, {radio, {False, True}}, {puntomedio, {False, True}}, {circulo, {False, True}}]

Ahora, vamos a considerar la proyección de un punto en el circulo unitario sobre cualquier diámetro del mismo.

gra1 = ContourPlot[x^2 + y^2 == 1, {x, -2, 2}, {y, -2, 2}, 
   Axes -> True];
gra2 = Point[{0, 0}];
Manipulate[
 Show[gra1, ParametricPlot[{a, Tan[u] a}, {a, -Cos[u], Cos[u]}], 
  Graphics[{Point[{(Cos[t] + Tan[u] Sin[t])/(Tan[u]^2 + 
         1), (Tan[u] Cos[t] + Tan[u]^2 Sin[t])/(Tan[u]^2 + 1)}], Red, Dashed, Line[{{Cos[t], Sin[t]}, {(Cos[t] + Tan[u] Sin[t])/(Tan[u]^2 + 1), (Tan[u] Cos[t] + Tan[u]^2 Sin[t])/(Tan[u]^2 + 1)}}], PointSize[0.02], Point[{Cos[t], Sin[t]}]}]], {{t, 0, "Punto"}, 0, 2 Pi}, {{u, Pi/4, "Diamétro"}, -Pi, Pi/2}]

Para un punto fijo sobre el circulo unitario, las proyecciones ortogonales sobre los diámetros del circulo forman una circunferencia de radio media unidad y centro en el punto medio del radio del circulo en el punto fijo inicial.

gra1 = ContourPlot[x^2 + y^2 == 1, {x, -2, 2}, {y, -2, 2}, 
   Axes -> True];
gra2 = {PointSize[0.01], Point[{0, 0}]};
Manipulate[
 Show[gra1,Table[ParametricPlot[{a, Tan[u] a}, {a, -Cos[u],Cos[u]}], {u, -Pi/2, Pi/2, Pi/24.}], Graphics[{Point@Table[{(Cos[t] + Tan[u] Sin[t])/(Tan[u]^2 + 1), (Tan[u] Cos[t] + Tan[u]^2 Sin[t])/(Tan[u]^2 + 1)}, {u, -Pi/2, Pi/2, Pi/24.}],Red, PointSize[0.02],Point[{Cos[t], Sin[t]}], If[circulo, Circle[0.5 {Cos[t], Sin[t]}, 0.5], gra2]}]], {{t, 0, "Punto"}, 0, 2 Pi}, {circulo, {False, True}}]

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 Maryam Mirzakhani

Es imposible ser matemático
sin ser un poeta en el alma.

Maryam Mirzakhani

Curva Contrapodaria

Descargar como Notebook

En una publicación anterior, hablamos de la Curva Podaria, que correspondía a dada una curva C y un punto fijo P al lugar geométrico de las proyecciones ortogonales de P sobre las tangentes de la curva C. La ContraPodaria corresponde a las proyecciones ortogonales de P sobre la recta normal a cada punto de la curva C.

En el siguiente ejemplo el punto R pertenece a la Podaria de la curva C con respecto al punto P y Q la contraPodaria de la curva C con respecto al punto P.

Show[ContourPlot[{x^2 + x y == y, y == 0, x == 0, y == -1,
   x == -1}, {x, -3, 3}, {y, -3, 3}],
 Graphics[{Point[{-1, -1}], Text["P", {-1.1, -1.1}],
   Text["C", {0.9, 1}], Red, Point[{-1, 0}], Point[{0, -1}],
   Text["Podaria - R", {-1.5, 0.1}],
   Text["Q - ContraPodaria", {0.8, -1.1}]}]]

Dada la curva F(t) y un punto P, su recta normal en el punto t = t', tiene por ecuación:

F (t') +  {{0, 1}, {-1, 0}}F' (t') s, con s en los reales.

La recta perpendicular a la normal a C que pasa por el punto P, es paralela a recta tangente a C en el punto t',  tiene por ecuación:

P +F' (t') u, con u en los reales.

El punto de corte entre las rectas anteriores, es:

Vamos a construir un aplicativo para determinar la Podaria de algunas curvas planas:

f1[t_] := {t, t^2}
f2[t_] := {t, t^3 - 3 t^2}
f3[t_] := {Cos[t], 4 Sin[t]}
f4[t_] := {t^3, t^2}
f5[t_] := {4 Cos[t]^3, 5 Sin[t]^3}
Manipulate[m[t_] := f'[t] (Dot[f'[t], p - f[t]]/Norm[f'[t]]^2); 
 g1 = ParametricPlot[f[t], {t, -50, 50}, PlotStyle -> Green]; 
 Show[ParametricPlot[{p + t f'[r], f[r] + t Reverse[f'[r]] {1, -1}, 
    f[r] + t f'[r], p + t Reverse[f'[r]] {1, -1}}, {t, -20, 20}, 
   PlotRange -> 10], 
  ParametricPlot[f[t], {t, -50, 50}, PlotStyle -> Green], 
  If[Podaria, 
   ParametricPlot[{f[t] + m[t]}, {t, -20.00001, r}, 
    PlotStyle -> Pink], g1], 
  If[ContraPodaria, 
   ParametricPlot[{p - m[t]}, {t, -20.00001, r}, PlotStyle -> Red], 
   g1], Graphics[{Point[p], Point[f[r]], 
    Text["P", p + {-0.1, -0.1}]}]], {r, -20, 
  20}, {f, {f1, f2, f3, f4, f5}}, {p, {-5, -5}, {5, 
   5}}, {Podaria, {False, True}}, {ContraPodaria, {True, False}}, 
 ControlPlacement -> Left]

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