Teorema de van Aubel

Descargar como Notebook

Se debe a la publicación realizada en 1878 por H. H. van Aubel.

Dado un cuadrilátero cualquiera en un plano, a partir de cada lado dibujamos un cuadrado apoyado en él. Entonces los segmentos que unen los centros de cuadrados situados en lados opuestos tienen la misma longitud y además son segmentos perpendiculares ellos o sus prolongaciones.

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]}]
linea[a_, b_, c_, d_] := 
 ParametricPlot[punto[a, b] (1 - t) + t punto[c, d], {t, 0, 1}, 
  PlotStyle -> {Red, Thickness[0.01]}]
lineap[a_, b_, c_, d_] := 
 ParametricPlot[punto[a, b] (1 - t) + t punto[c, d], {t, -5, 6}, 
  PlotStyle -> {Orange, Dashed}]


Manipulate[
 Show[Graphics[{{Line[{p, q, s, r, p}]}, cuadrado[Red, p, q], 
    cuadrado[Yellow, s, r], cuadrado[Green, q, s], 
    cuadrado[Orange, r, p]}, PlotRange -> 10], lineap[p, q, s, r], 
  lineap[q, s, r, p], linea[p, q, s, r], 
  linea[q, s, r, p]], {{p, {1, 1}}, Locator}, {{q, {-1, 1}}, 
  Locator}, {{s, {-1, -1}}, Locator}, {{r, {1, -1}}, Locator}]

Este teorema es cierto sin importar si el cuadrilátero es o no convexo, y también si es o no simple.

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