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