Wolfram Function Repository

Instant-use add-on functions for the Wolfram Language

Function Repository Resource:

 HarmonicQuadrilaterals

Source Notebook

Generate three cyclic harmonic quadrangles from a reference triangle

Contributed by: Shenghui Yang (Wolfram Research)

ResourceFunction["HarmonicQuadrilaterals"][{p1,p2,p3}]

gives the three harmonic quadrilaterals corresponding to the triangle with corner points p1,p2, and p3.

Details

A harmonic quadrilateral is a cyclic quadrangle in which the products of the lengths of opposite sides are equal.
Harmonic quadrilateral is closely related to pole/polar line, symmedian and other important concepts in projective and inversion geometry.
HarmonicQuadrilaterals effectively uses TriangleConstruct and reflects one vertex of the triangle with respect to the projection of the circumcenter on the symmedian cevian. This gurantees that the final polygon is always convex, given a proper ordering of the new point and that of the random triangle.
ResourceFunction["HarmonicQuadrilaterals"][Triangle[{p1,p2,p3}]] is equivalent to ResourceFunction["HarmonicQuadrilaterals"][{p1,p2,p3}].
HarmonicQuadrilaterals gives a list of Polygon objects.

Examples

Basic Examples (3) 

Find three harmonic quadrilaterals that contain a triangle:

In[1]:=
tri = {{0, 0}, {2, 0}, {-0.2, 1}}; quads = ResourceFunction["HarmonicQuadrilaterals"][tri]
Out[2]=

Show these:

In[3]:=
GraphicsRow[Graphics[{ {Dashed, TriangleConstruct[tri, "Circumcircle"]}, {Transparent, EdgeForm[Thick], #}, {RGBColor[0, 0, 1], HatchFilling[], EdgeForm[ RGBColor[0, 0, 1]], Triangle[tri]}} ] & /@ quads] // Framed
Out[3]=

The products of the lengths of opposite sides are equal:

In[4]:=
sides = EuclideanDistance @@ {#[[1]], #[[2]]} & /@ NestList[RotateLeft, quads[[1, 1]], 3]
Out[4]=
In[5]:=
Chop[sides[[1]]*sides[[3]] - sides[[2]]*sides[[4]]]
Out[5]=

Scope (2) 

Some spiral similar triangles pairs (marked as red and blue) can be found by halving the diagonal or the extension of a side:

In[6]:=
tri = {{0, 0}, {2, 0}, {-0.2, 1}}; quad = ResourceFunction["HarmonicQuadrilaterals"][tri][[1, 1]];

Take the midpoint of one diagonal:

In[7]:=
q = Midpoint[quad[[{1, 3}]]]; Graphics[{Sequence[{Dashed, Line[ Part[quad, {1, 3}]]}, {Dashed, TriangleConstruct[tri, "Circumcircle"]}, {Transparent, EdgeForm[Thick], Polygon[quad]}], {RGBColor[0, 0, 1], HatchFilling[], EdgeForm[ RGBColor[0, 0, 1]], Triangle[tri]}, {RGBColor[1, 0, 0], HatchFilling[], EdgeForm[ RGBColor[1, 0, 0]], Triangle[{quad[[2]], quad[[3]], q}]}} ]
Out[8]=
In[9]:=
Graphics[{Sequence[{Dashed, Line[ Part[quad, {1, 3}]]}, {Dashed, TriangleConstruct[tri, "Circumcircle"]}, {Transparent, EdgeForm[Thick], Polygon[quad]}], {RGBColor[0, 0, 1], HatchFilling[], EdgeForm[ RGBColor[0, 0, 1]], Triangle[{quad[[3]], quad[[4]], q}]}, {RGBColor[1, 0, 0], HatchFilling[], EdgeForm[ RGBColor[1, 0, 0]], Triangle[{quad[[2]], quad[[3]], q}]}} ]
Out[9]=
In[10]:=
Graphics[{Sequence[{Dashed, Line[ Part[quad, {1, 3}]]}, {Dashed, TriangleConstruct[tri, "Circumcircle"]}, {Transparent, EdgeForm[Thick], Polygon[quad]}], {RGBColor[0, 0, 1], HatchFilling[], EdgeForm[ RGBColor[0, 0, 1]], Triangle[{quad[[4]], quad[[1]], q}]}, {RGBColor[1, 0, 0], HatchFilling[], EdgeForm[ RGBColor[1, 0, 0]], Triangle[{quad[[1]], quad[[2]], q}]}} ]
Out[10]=

Double the length of one side:

In[11]:=
Graphics[{ {Dashed, Line[quad[[{1, 3}]]]}, {Dashed, TriangleConstruct[tri, "Circumcircle"]}, {Transparent, EdgeForm[Thick], Polygon[quad]}, {RGBColor[0, 0, 1], HatchFilling[], EdgeForm[ RGBColor[0, 0, 1]], Triangle[tri]}, {RGBColor[1, 0, 0], HatchFilling[], EdgeForm[ RGBColor[1, 0, 0]], Triangle[{ quad[[2]], quad[[3]], ReflectionTransform[quad[[3]] - quad[[4]], quad[[3]]][ quad[[4]]]}]} } ]
Out[11]=

A harmonic quadrilateral can also be constructed with GeometricScene by equating the product of the lengths of opposite sides:

In[12]:=
RandomInstance[ GeometricScene[{a, b, c, d}, {GeometricAssertion[Polygon[{a, b, c, d}], "Counterclockwise", "Cyclic"], EuclideanDistance[a, b]*EuclideanDistance[c, d] == EuclideanDistance[b, c]*EuclideanDistance[d, a]}], RandomSeeding -> 77]
Out[12]=

Neat Examples (3) 

The vertices of a harmonic quadrilateral are inverse to some squares and vice versa. To find a proper inversion center, use the intersection of the orthogonal circles passing through the vertices of each diagonal:

In[13]:=
(* Evaluate this cell to get the example input *) CloudGet["https://www.wolframcloud.com/obj/27102f7e-9d74-466b-9c1a-4b8be5c9590c"]

The intersections of the two solid orthogonal circles are the proper inversion centers:

In[14]:=
Graphics[{Sequence[{Dashed, TriangleConstruct[tri, "Circumcircle"]}, {Transparent, EdgeForm[Thick], Polygon[quad]}, { RGBColor[0, 0, 1], HatchFilling[], EdgeForm[ RGBColor[0, 0, 1]], Triangle[tri]}], {Circle[twoOrthocircleCenters[[1]], twoOrthocircleradius[[1]]], Circle[twoOrthocircleCenters[[2]], twoOrthocircleradius[[2]]]}}, PlotRange -> {{-4, 3}, {-1, 4}} ] // Framed
Out[14]=

Either one can be chosen as the inversion center. The gray hatch-filled polygon is a square for each diagram:

In[15]:=
GraphicsRow[Graphics[{ {Dashed, TriangleConstruct[tri, "Circumcircle"]}, {Transparent, EdgeForm[Thick], Polygon@quad}, {Opacity[0.6], Gray, HatchFilling[], EdgeForm[Gray], Polygon@#}, MapThread[Arrow[{#1, #2}] &, {quad, #}] } ] & /@ invVert] // Framed
Out[15]=

A weaker version of the result is that any cyclic quadrilateral (not necessary harmonic) is the inversion of some rectangle. The inversion center is found in the similar way as described above.

Generate a set of random harmonic quadrilaterals:

In[16]:=
SeedRandom[11]; tri = RandomPoint[Circle[], 3]; quads = ResourceFunction["HarmonicQuadrilaterals"][tri]; GraphicsRow[Graphics[{ {Dashed, TriangleConstruct[tri, "Circumcircle"]}, {Transparent, EdgeForm[Thick], #}, {RGBColor[0, 0, 1], HatchFilling[], EdgeForm[ RGBColor[0, 0, 1]], Triangle[tri]}} ] & /@ quads] // Framed
Out[19]=

Check the distribution of the area of harmonic quadrilaterals in the unit circle:

In[20]:=
Histogram[Area /@ (Flatten@Table[ ResourceFunction["HarmonicQuadrilaterals"][ RandomPoint[Circle[], 3]], 3000]), 50]
Out[20]=

Publisher

Shenghui Yang

Version History

  • 1.0.1 – 04 May 2022
  • 1.0.0 – 25 April 2022

Source Metadata

  • Citation:
    Johnson, Roger A. (2007)[1929], Advanced Euclidean Geometry, Dover, p. 100, ISBN 978-0-486-46237-0

Related Resources

Author Notes

This function provides useful features to explorer the corresponding chapters in Advanced Euclidean Geometry and Euclidean Geometry in Mathematical Olympiads.

License Information