Teorema de Napoleón

Descargar como Notebook

En geometría, el teorema de Napoleón es un resultado sobre triángulos equiláteros; se le atribuye a Napoleón Bonaparte (1769 - 1821), si bien no hay pruebas tangibles de que sea el verdadero autor. Aparece publicado en el calendario The Ladies' Diary de 1825, es decir cuatro años después su muerte .

El teorema dice: Si sobre los lados de un triángulo arbitrario, en el exterior de este, se construyen triángulos equiláteros, entonces los centros de estos triángulos son también vértices de un triángulo equilátero.

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]}]}
centro[a_, b_] := TriangleCenter[{a, b, vertice[a, b]}, "Incenter"]

Manipulate[
 Graphics[{{Line[{p, q, s, p}]}, triangulo[Red, p, q], 
   triangulo[Yellow, s, p], 
   triangulo[Green, q, s], {PointSize[Large], 
    Point[{centro[p, q], centro[q, s], centro[s, p]}]}, {Red, 
    Thickness[0.01], 
    Line[{centro[p, q], centro[q, s], centro[s, p], centro[p, q]}]}}, 
  PlotRange -> 5], {{p, {1, 1}}, Locator}, {{q, {-1, 1}}, 
  Locator}, {{s, {-1, -1}}, Locator}]

Observemos que con cuadrados en vez de triángulos no es cierto.

cuadrado[color_, a_, b_] := 
 Module[{tt = EuclideanDistance[a, b]}, {color, Opacity[0.5], 
   Rotate[{Rectangle[b, b + {tt, tt}], {Black, PointSize[Large], 
      Point[RegionCentroid@Rectangle[b, b + {tt, tt}]]}}, 
    Arg[(a - b)[[2]] + I (b - a)[[1]]] + Pi/2, b]}]
punto[a_, b_] := 
 Module[{cc = Arg[(a - b)[[1]] + I (a - b)[[2]]] + Pi/4}, 
  b + Sqrt[2] EuclideanDistance[a, b]/2 {Cos[cc], Sin[cc]}]

Manipulate[
 Graphics[{Line[{p, q, s, p}], cuadrado[Red, p, q], 
   cuadrado[Yellow, s, p], 
   cuadrado[Green, q, s], {Red, Thickness[0.01], 
    Line[{punto[p, q], punto[q, s], punto[s, p], punto[p, q]}]}}, 
  PlotRange -> 5], {{p, {1, 1}}, Locator}, {{q, {-1, 1}}, 
  Locator}, {{s, {-1, -1}}, Locator}]

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