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
