Frase Célebre de David Hilbert

La física es muy importante...
para dejársela a los físicos.

David Hilbert

Punto de Fermat (Otro Método)

Descargar como Notebook

En una publicación anterior sobre el Punto de Fermat (aquí), punto que minimiza la suma de las distancias a los tres vértices de un triángulo, se explicó un procedimiento para su obtención: girando alrededor del vértice A un ángulo de 60º, obtuvimos un triángulo equilátero ACC' que se construyó sobre el lado AC y el Punto de Fermat se encuentra sobre la línea que une el vértice C' con B el vértice opuesto del triángulo ABC. (Ver publicación anterior aquí)

Graphics[{Line[{{0, 0}, {2, 2}, {4, 0}, {0, 0}}], Text["A", {0, 0.1}],
   Text["B", {4, 0.1}], Text["C", {2, 2.1}], 
  Text["C'", {1 - Sqrt[3], 1 + Sqrt[3]} + {0.1, 0.1}], 
  Text["P", {2.1, 1.1}], Red, Dashed, 
  Line[{{0, 0}, {1 - Sqrt[3], 1 + Sqrt[3]}, {2, 2}}], Green, 
  Line[{{1 - Sqrt[3], 1 + Sqrt[3]}, {4, 0}}]}]

Este procedimiento se pudo haber realizado para cualquier vértice, así el Punto de Fermat también se puede encontrar como: se construye un triángulo equilátero sobre cada lado y el punto intersección de las líneas que unen los vértices exteriores  de cada triángulo equilátero con el vértice opuesto es el Punto de Fermat del triángulo ABC.

Graphics[{Line[{{0, 0}, {2, 2}, {4, 0}, {0, 0}}], Text["A", {0, 0.1}],
   Text["B", {4, 0.1}], Text["C", {2, 2.1}], Text["P", {2.1, 1.1}], 
  Red, Dashed, 
  Line[{{0, 0}, {1 - Sqrt[3], 1 + Sqrt[3]}, {2, 2}, {3 + Sqrt[3], 
     1 + Sqrt[3]}, {4, 0}, {2, -2 Sqrt[3]}, {0, 0}}], Green, 
  Line[{{1 - Sqrt[3], 1 + Sqrt[3]}, {4, 0}}], 
  Line[{{3 + Sqrt[3], 1 + Sqrt[3]}, {0, 0}}], 
  Line[{{2, -2 Sqrt[3]}, {2, 2}}]}]

Generalizando en un aplicativo por el comando Manipulate:

vertice[a_, b_] := 
 Module[{cc = Arg[(a - b)[[1]] + I (a - b)[[2]]] + Pi/3}, 
  b + EuclideanDistance[a, b] {Cos[cc], Sin[cc]}]
triangulo[color_, a_, b_] := {color, Opacity[0.5], 
  Triangle[{a, b, vertice[a, b]}]}

Manipulate[
 aaa = u /. 
   NSolve[{q + t (vertice[s, p] - q) == 
       s + u (vertice[p, q] - s)}, {u, t}][[1]]; 
 Graphics[{{Line[{p, q, s, p}]}, triangulo[Red, p, q], 
   triangulo[Yellow, s, p], 
   triangulo[Green, q, s], {PointSize[0.01], 
    Point[{vertice[p, q], vertice[q, s], vertice[s, p], 
      s + aaa (vertice[p, q] - s)}]}, {Red, Dashed, Thickness[0.001], 
    Line[{vertice[p, q], s}], Line[{vertice[q, s], p}], 
    Line[{vertice[s, p], q}]}}, PlotRange -> 6], {{p, {1, 1}}, 
  Locator}, {{q, {-1, 1}}, Locator}, {{s, {-1, -1}}, Locator}]

Arrastrando con el Mouse los vértices del triángulo, el punto de corte de las líneas imaginarias es el Punto de Fermat.

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 Maria Mitchell

Nuestra mente está hambrienta 
y nos pide conocer todo lo que nos rodea,
y cuanto más conocemos mayor es nuestro deseo;
cuanto más vemos, más capaces somos de ver.
Además de aprender a ver, hay otro arte que debemos aprender:
no ver lo que no es.

Maria Mitchell

Gráfico del Campo de Pendientes y Curvas de Nivel sobre la Superficie de una Función

Descargar como Notebook

Curvas de Nivel

Las curvas de nivel de una función las podemos graficar en Mathematica mediante el comando ContourPlot, pero obtenemos una representación sobre un plano, si combinamos con el comando Texture nos representará estas curvas de nivel sobre la superficie de la función.

f1[x_, y_] := Cos[x] Sin[y]^2
f2[x_, y_] := x^2 - 2 y^2
f3[x_, y_] := Sin[x y]
Manipulate[
 Plot3D[f[x, y], {x, -3, 3}, {y, -3, 3}, 
  PlotStyle -> {Opacity[0.7], 
    Texture[ContourPlot[f[x, y], {x, -3, 3}, {y, -3, 3}, 
      ContourStyle -> Red, Frame -> None, ImageSize -> Large]]}, 
  Mesh -> None, ImageSize -> Large, 
  PlotPoints -> 35], {f, {f1, f2, f3}}]

Campos de Pendientes

El campo de pendientes de una función z = f[ x , y ] lo podemos obtener con comandos VectorPlot, VectorDensityPlot, StreamPlot o StreamDensityPlot, pero obtenemos una representación plana, combinándola con el comando Texture podemos obtener la representación sobre la superficie de la función.

f1[x_, y_] := (Cos[x] Sin[y]^2) Exp[Cos[x] Sin[y]^2]

f2[x_, y_] := x^2 - 2 y^2

f3[x_, y_] := Sin[x y]

Manipulate[

 Plot3D[f[x, y], {x, -3, 3}, {y, -3, 3}, 

  PlotStyle -> 

   Texture[estilo[

     Evaluate[D[f[x, y], {{x, y}}]], {x, -3, 3}, {y, -3, 3}, 

     Frame -> None, ImageSize -> Large]], Mesh -> None, 

  ImageSize -> Large, 

  PlotPoints -> 35], {f, {f1, f2, f3}}, {estilo, {VectorPlot, 

   VectorDensityPlot, StreamPlot, StreamDensityPlot}}]

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

http://www.wolfram.com/mathematica/?source=frontpage-quick-links

Frase Célebre de Marcus du Sautoy

Me hice matemático y no científico
porque a menudo la ciencia se equivoca.

Marcus du Sautoy