Abstract
Can a room in 3space be designed so that a small person can find a hiding place that is invisible from guards located at every vertex of the room? Such a twodimensional polygon cannot exist. But the image shows a threedimensional room that does contain such a hiding place. The roof of the room has been removed so we can see inside: there are six ducts that come in from a wall almost to the opposite wall and the hiding place is the red dot in the central cubicle that is almost sealed off by the ducts.
Keywords
Computational Geometry Steiner Tree Signed Area Steiner Point Hiding PlaceCan a room in 3space be designed so that a small person can find a hiding place that is invisible from guards located at every vertex of the room? Such a twodimensional polygon cannot exist. But the image shows a threedimensional room that does contain such a hiding place. The roof of the room has been removed so we can see inside: there are six ducts that come in from a wall almost to the opposite wall and the hiding place is the red dot in the central cubicle that is almost sealed off by the ducts.
The implementation of routines of computational geometry provides a nice mix of symbolic, numerical, and graphical programming. In this chapter we present the start of a library of routines in plane geometry and show how they can be used to place guards in an art gallery. We also investigate the intriguing question of guarding a threedimensional art gallery, using Mathematica’s algebraic capabilities to analyze a complicated problem in detail.
15.1 Basic Computational Geometry
It is very useful to have on hand a library of routines to perform simple geometrical constructions. We will present some here and later apply them to the art gallery problem and in Chapter 17 to the problem of fourcoloring planar maps.
SACom = Compile [{x1, y1, x2, y2, x3, y3}, 0.5 (− x2 y1 + x3 y1 + x1 y2  x3 y2 − x1 y3 + x2 y3) ];
SignedArea[triangle_]: = SACom @@ Flatten[triangle] /; Length [triangle] == 3;
Area[p_]: = Abs [SignedArea[p]]
Orientation[triangle_]:= Sign[SignedArea[triangle]] /; Length[triangle] == 3;
But the orientation of a polygon is determined by the orientation at a convex vertex (a vertex for which the interior angle is less than 180°). We can find a convex vertex by using the first vertex in the list returned by Sort.
ConvexVertex[p_]:= Ordering[p, 1] [[1]];
Orientation [poly_]:= Orientation[poly⟦ ConvexVertex[poly]+{−1,0,1}/. {0 → Length [poly], Length[poly] + 1 → 1}⟧] /; Length[poly] > 3;
LeftOf [p_, q_, r_]:= Orientation [ {p, q, r}] = 1;
RightOf [p_, q_, r_]:= Orientation [ {p, q, r}] = −1;
With these few simple routines in hand, we can attack a famous and important problem: triangulating a polygon. Any ngon can be triangulated by drawing a certain number of internal diagonals. In fact, that certain number is n  2. We will want our routine to return the indices of the triangles in the triangulation. The proof/algorithm can be done by recursion: we simply choose an interior diagonal and use it to break the polygon into two pieces, which can be triangulated recursively. The fact that every polygon has an interior diagonal is not quite trivial. Here’s a proof: first choose a convex vertex v, and let u and w be the neighboring vertices. Consider the triangle formed by u, v, and w. If no other vertex lies inside or on this triangle, then uw is the desired interior diagonal (and triangle uvw is said to form an ear of the polygon). Otherwise, choose from those vertices lying inside the triangle the one that is farthest from the segment uw. It is easy to see that the segment determined by v and this optimal vertex is the desired interior diagonal.
Inside [{p_, q_, r_}, pt_]: = ! LeftOf[q, p, pt] && ! LeftOf[r, q, pt] && ! LeftOf[p, r, pt];
PolygonDiagonal[poly_]:= Module[{v = ConvexVertex[poly], invertices, u, w},
u = v − 1 /. 0 − Length [poly];
w = v + 1 /. 1 + Length [poly] → 1; invertices =
Select [Delete [poly, {{u}, {v}, {w}}], Inside [poly⟦{u, v, w}⟧, #] &];
Sort[If[invertices == {}, {u, w}, {Position[poly, Last[SortBy[ invertices, Area [{poly⟦u⟧, #1, poly⟦w⟧}] &]⟧⟦1, 1⟧, v}]⟧
Triangulate[poly_List]:=
If[Orientation[poly] == 1, Triangulate[poly, Range[Length[poly]⟧],
Reverse/@(Length[poly]+1−) Triangulate[Reverse[poly], Range[Length[poly]⟧)];
Triangulate [poly_, inds_]:= Module [{d = PolygonDiagonal [poly⟦inds⟧ ]},
Join[Triangulate[poly, Take[inds, d⟧,
Triangulate[poly, Drop[inds, d + {1, −1}⟧⟧;
Triangulate[_, {i1_, i2_, i3_}]:= {{i1, i2, i3}};
extend[a_]: = Flatten [{a, {First[a]}}, 1];
poly = {{0.85, 0.14}, {0.91, 0.23}, {0.59, 0.29}, {0.88, 0.44},
{0.68, 0.45}, {0.8, 0.62}, {0.86, 0.56}, {0.92, 0.68}, {0.92, 0.56},
{0.96, 0.57}, {0.96, 0.84}, {0.63, 0.9}, {0.61, 0.76},
{0.69, 0.77}, {0.64, 0.64}, {0.49, 0.76}, {0.4, 0.69},
{0.46, 0.59}, {0.38, 0.54}, {0.31, 0.72}, {0.21, 0.82},
{0.13, 0.81}, {0.17, 0.65}, {0.11, 0.6}, {0.28, 0.57}, {0.2, 0.46},
{0.33, 0.37}, {0.19, 0.35}, {0.13, 0.21}, {0.08, 0.2},
{0.07, 0.36}, {0.035, 0.36}, {0.038, 0.12}, {0.33, 0.11},
{0.54, 0.53}, {0.52, 0.094}, {0.68, 0.23}, {0.71, 0.094}};
Graphics[{Thick, Line[extend[poly⟧}]triangles = Triangulate[poly]
{{31, 32, 33}, {30, 31, 33}, {30, 33, 34}, {29, 30, 34}, {23, 24, 25},
{28, 29, 34}, {21, 22, 23}, {21, 23, 25}, {27, 28, 34}, {25, 26, 27},
{20, 21, 25}, {20, 25, 27}, {19, 20, 27}, {27, 34, 35}, {19, 27, 35},
{18, 19, 35}, {16, 17, 18}, {16, 18, 35}, {15, 16, 35}, {3, 4, 5},
{12, 13, 14}, {11, 12, 14}, {8, 9, 10}, {8, 10, 11}, {7, 8, 11},
{6, 7, 11}, {6, 11, 14}, {5, 6, 14}, {5, 14, 15}, {3, 5, 15}, {3, 15, 35},
{3, 35, 36}, {3, 36, 37}, {2, 3, 37}, {2, 37, 38}, {1, 2, 38}}
Graphics[
{{Thickness[0.01], Line[extend[poly⟧}, EdgeForm[Thickness[0.005⟧,]]
({Hue [ Random [], 0.4, 1], Polygon [poly⟦#⟧ ]} &) /@triangles}]
There are faster methods for triangulating a polygon (see [Oro, Oro1]), but the approach given here is surely the easiest to program and illustrates many fundamental ideas of computational geometry. Section 15.2 contains one application of triangulation. Another appears in §17.6, where we will consider countries on a map and want to place a vertex inside each country. Since the countries can be convex, it is not clear how to get an interior point. We can simply use the centroid of the largest triangle in a triangulation of a nonconvex country.
15.2 The Art Gallery Theorem
Consider an art gallery consisting of a single polygonal room with n walls. The art gallery theorem states that there is some way of placing \(\left\lfloor {\frac{n} {3}} \right\rfloor \) guards in the room so that every space in the gallery is seen by at least one of the guards. The theorem was first proved by V. Chvátal in 1975; in this section we shall show how a simple proof found by S. Fisk can be implemented so that Mathematica can figure out where to place the guards. This is a nice application of methods of both computational geometry and graph theory. An excellent exposition of this area, with many variations and unsolved problems, can be found in the books by J. O’Rourke [Oro, Oro1].
Consider a triangulated polygon and view it as a graph. It turns out that this graph can be threecolored (so that adjacent vertices get different colors). Choose the color that occurs least often and place a guard at each vertex that received that color. That proves the theorem, since each triangle will be totally guarded.
One can threecolor a triangulation by following one’s nose or, to be more precise, following the ear of the polygon. An ear of a polygon is a set of three consecutive vertices {u, v, w} such that the interior of the segment containing u and w is interior to the polygon. Meister’s twoear theorem states that every polygon has at least two ears (see [Oro1]). In our situation, where we have polygons triangulated by diagonals, it is not hard to see that at least one of the diagonals cuts off an ear. Thus a search for consecutive vertices {u, v, w} in the triangulation must succeed. Then recursion can be used to threecolor the triangulated polygon that remains after an otectomy (ear removal) is performed. We then just color v with the color not appearing on u or w.
Select [tris, Abs [#[3] −#⟦1⟧ == 2 &, tris, 1]
ThreeColor[pts_]: = ThreeColor[pts, Triangulate[pts⟧;
ThreeColor[pts_, _]:= {1,2,3}/; Length[pts] == 3
ThreeColor[pts_, tris_]:= Module[{i, oldcolors, ear},
ear = Select [tris, Abs [#⟦3⟧ #⟦1]⟧ == 2 &, 1] ⟦1⟧; i = ear⟦2⟧; oldcolors = ThreeColor [Delete [pts, i],
DeleteCases [tris, ear] /. {n_ /; n>i:→ n − 1} ]; Insert[oldcolors, First[Complement[{1, 2, 3},
oldcolors ⟦{i−1, i}⟧ ⟧, i⟧ /; Length [pts] > 3;
Show3ColoredPolygon[pts_]:= (tri = Triangulate[pts];
colors = Apply[RGBColor, IdentityMatrix[3], {1}];
Graphics[{PointSize[0.025],
({Thickness [0.012], Line[extend[pts⟧}, Line [pts ☦ ]] ⟦&⟧) /@tri, ({colors⟦#⟦2⟧⟧, Point [#⟦1⟧⟧} &) /@
Transpose[{pts, ThreeColor[pts, tri]}]}])
Show3ColoredPolygon[poly]
And here is a routine that uses the threecoloring to place the guards. Of course, there is no guarantee that one cannot guard the polygon with fewer guards at the vertices.
And the restriction to placing guards at vertices is not part of the original artgallery problem: by placing guards inside the polygon one can often come up with smaller number of guards. Still the \(\left\lfloor {\frac{n} {3}} \right\rfloor \) bound is sharp, since polygons exist for which that number of guards is necessary.
ShowGuards[poly]:= (col3 = ThreeColor[poly];
Graphics[{{Thickness[0.008], Line[extend[poly⟧},
{PointSize [0.05], Point [poly⟦Flatten [
Position[col3, Ordering[Last /@ Tally[col3], 1]⟦1⟧]]⟧]}} ]);
ShowGuards[ poly]
15.3 A Very Strange Room
An art gallery director who is unaware of the theory in §15.2 can always follow a very simple, if inefficient, strategy to place guards: just place a guard at every vertex. Any polygon can be triangulated, so every triangle will be seen by one of the vertex guards. Will this strategy work for the threedimensional version of this situation, where the gallery is a polyhedron? No! One can design a polyhedral room such that even if a guard is placed at every vertex, there will be an unguarded hiding place.
This result is due to R. Seidel, and appears in [Oro, p. 255]. However, the details of the construction in that book are somewhat vague and while there is no doubt that the construction works for appropriate parameters, great care is necessary if one wishes to build an exact computer image. We will do that here, using Mathematica to help determine the proper parameters.

cuboid makes a cuboid out of six Polygons (Cuboid is builtin, but it is a graphics primitive and does not give us the polygons, which we want for check ing the result algebraically).

facelessCuboid deletes a specified face, thus allowing easy duct construction.

SeidelRoom shows the room, with three style options to set the styles of the face, and a ShowHidingPlace option to show or suppress the hiding place.

frontWall, sideWall, and bottomWall are collections of polygons that form the walls with windows.

ε controls the interduct space, which is 1 + ε, and the distance of the faces from the sealed ductends.

m gives the three dimensions of the box; the ducts are centered in the box.

hiding locates the hiding place, slightly off center in the interior cubicle.

Module is not used, because we want access to the ducts and the hiding place.
SeidelRoom::usage =
“SeidelRoom [ε, m_List] draws a polyhedron so that guards at all vertices cannot see the hiding place in the center.”;
BoxFaceStyle::usage =
“BoxFaceStyle is an option to SeidelRoom that sets the style of the outer faces other than the top face.”;
TopFaceStyle::usage =
“TopFaceStyle is an option to SeidelRoom that sets the style of the top face.”;
DuctStyle::usage =
“DuctStyle is an option to SeidelRoom that sets the style of the duct faces.”;
ShowHidingPlace::usage =
“ShowHidingPlace is an option to SeidelRoom that places a point at the hiding place in the center.”;
cuboid [{a_, b_, c_}, {d_, e_, f_}]:= Polygon/@
{{{a, b, c}, {d, b, c}, {d, b, f}, {a, b, f}},
{{a, e, c}, {d, e, c}, {d, e, f}, {a, e, f}},
{{d, b, c}, {d, e, c}, {d, e, f}, {d, b, f}}, {{a, b, c}, {a, e, c},
{a, e, f}, {a, b, f}}, {{a, b, c}, {d, b, c}, {d, e, c}, {a, e, c}},
{{a, b, f}, {d, b, f}, {d, e, f}, {a, e, f}}};
facelessCuboid[pt1_, pt2_, n_]: = Delete[cuboid[pt1, pt2], n];
Options[SeidelRoom] =
{ShowHidingPlace→ True, BoxFaceStyle→ Automatic,
TopFaceStyle→ Automatic, DuctStyle→ Automatic};
SeidelRoom [ε_, m_, opts___]: =
(h= (1 + ε) / 2; outer = cuboid [{0, 0, 0}, m];
{hidingQ, bfs, topsty, ductsty} =
{ShowHidingPlace, BoxFaceStyle, TopFaceStyle, DuctStyle} /.
{{opts} /. Options[SeidelRoom]; hiding = m/2 + {0.25, 0, 0};
bfs, topsty, ductsty} = {FaceForm[bfs], FaceForm[topsty],
FaceForm [ductsty]} /. FaceForm [ Automatic] → {};
Graphics3D[{EdgeForm [Thickness[0.001⟧, {FaceForm [], outer},
frontWall = {EdgeForm[], Polygon[{{0, 0, 0},
{m⟦1⟧ /2−0.5, 0, 0}, {m⟦1⟧ /2−0.5, 0,m⟦3⟧}, {0, 0,m⟦3⟧}}],
Polygon [{{m⟦1⟧, 0, 0}, {m⟦1⟧ /2 + 0.5, 0, 0},
{m⟦1⟧ /2 + 0.5, 0, m⟦3⟧}, {m⟦1⟧, 0, m⟦3⟧}}], Polygon [ {{m⟦1⟧/2−0.5, 0,m⟦3⟧/2−h}, {m⟦1⟧ /2 + 0.5, 0,m⟦3⟧/2−h},
{m⟦1⟧ /2 + 0.5, 0,m⟦3⟧/2+h}, {m⟦1⟧ /2−0.5, 0, m⟦3⟧/2+h}}], polygon[
{{m⟦1⟧ /2−0.5, 0,m⟦3⟧/2−1−h}, {m⟦1⟧ /2 + 0.5, 0,m⟦3⟧/2−1−h},
{m⟦1J/2 + 0.5, 0, 0}, {m⟦1⟧ /2−0.5, 0, 0}}], Polygon[
{{m⟦1⟧ /2−0.5, 0,m⟦3⟧/2 + 1 + h}, {m⟦1J/2 + 0.5, 0, m⟦3⟧/2 + 1 + h}, {m⟦1⟧ /2 + 0.5, 0,m⟦3⟧}, {m⟦1⟧ /2−0.5, 0,m⟦3⟧}}]};
sideWall = {EdgeForm[]
Polygon [ {{m⟦1⟧, 0, 0}, {m⟦1⟧,m⟦2⟧/2−h−1, 0}, {m⟦1⟧, m⟦2⟧/2−h−1, m⟦3⟧}, {m⟦1⟧, 0, m⟦3⟧}} ],
Polygon [ {{m⟦1⟧, m ⟦2⟧, 0}, {m⟦1⟧, m⟦2⟧/2+h+1, 0}, {m⟦1⟧, m⟦2⟧ /2+h+1, m⟦3⟧}, {m⟦1⟧, m⟦2⟧, m⟦3⟧}} ],
Polygon [{{m⟦1⟧, m⟦2⟧ /2+h, 0}, {m⟦1⟧, m⟦2⟧ /2−h, 0}, {m⟦1⟧, m⟦2⟧ /2−h, m⟦3⟧}, {m⟦1⟧, m ⟦2⟧ /2+h, m⟦3⟧}} ],
pp = Polygon [{{m⟦1⟧,m⟦2⟧/2−h−1, 0}, {m⟦1⟧,m⟦2⟧/2−h, 0}, {m⟦1⟧, m⟦2⟧ /2−h, m⟦3⟧ /2−1/2}, {m⟦1⟧, m ⟦2⟧ /2−h−1, m⟦3⟧ /2−1/2}}],
pp1 = pp /. {x_, y_, z_}:→ {x, y, m⟦3⟧ − z}, {pp, pp1} /. {x_, y_, z_}:→ {x, m⟦2⟧ − y, z}};
bottomWall = {EdgeForm[],
pp = Polygon[{{0, 0, 0}, {m⟦1⟧ /2−h−1, 0, 0}, {m⟦1⟧ /2−h−1, m⟦2⟧, 0}, {0, m⟦2⟧, 0}}],
pp /. {x_, y_, z_}:→ {m⟦1⟧ −x, y, z}, Polygon [{{m⟦1⟧/2+h, 0, 0}, {m⟦1⟧/2−h, 0, 0}, {m⟦1⟧ /2−h, m⟦2⟧, 0}, {m⟦1⟧ /2+h, m ⟦2⟧, 0}}],
pp = Polygon [{{m⟦1⟧ /2−h−1, 0, 0}, {m⟦1⟧/2−h, 0, 0}, {m⟦1⟧/2−h, m⟦2⟧ /2−0.5, 0}, {m⟦1⟧/2−h−1,m⟦2⟧/2−0.5, 0}}],
p1 = pp /. {x_, y_, z_}:→ {x, m⟦2⟧ − y, z}, {pp, p1} /. {x_, y_, z_}:→ {m⟦1⟧ − x, y, z}};
{bfs, frontWall, sideWall, bottomWall, outer⟦{2, 4}J}, {topsty, outer⟦6J}, ducts = {ductsty, (facelessCuboid [{m⟦1⟧ /2−0.5, 0, #}, {m⟦1⟧/2 + 0.5, m⟦2⟧−ε, #+1}, 1] &) /@{m⟦3⟧/2−1−h, m⟦3⟧/2+h},
facelessCuboid [{ε, #, m⟦3⟧ /2−0.5}, {m⟦1⟧, # + 1,
m⟦3⟧/2 + 0.5}, 3] &) /@{m⟦2⟧/2−1−h, m⟦2J/2+h}, (facelessCuboid [{#, m ⟦2⟧ /2−0.5, 0}, {#+1,m⟦2⟧/2 + 0.5, m⟦3⟧ − ε}, 5] &)/@{m⟦1⟧/2−1−h, m⟦1⟧/2+h}},
If[hidingQ, {PointSize[0.02], Red, Point[hiding]}, {}]}, Sequence @@ FilterRules[{opts},
First /@ Options [Graphics3D⟧, Boxed → False,
PlotRange → Transpose [{{−0.5, −0.5, −0.5}, m+{0.5, 0.5, 0.5}}], BoxRatios → m]);
Now we can look at the entire room (with the top removed) or the ducts only. The hiding place is shown as a black dot. We can see it from the default viewpoint, but no vertex guard can see it, as we will prove in a moment.
SeidelRoom [0.37, {6, 6, 6}, ViewPoint →; {1.1, −2, 2.2},
TopFaceStyle → None, BoxFaceStyle → Opacity[.9],
SeidelRoom [0.37, {6, 6, 6},
SeidelRoom [0.37, {6, 6, 6}, ViewPoint→ {0, −3, 0},
TopFaceStyle→ Opacity[0.1],
BoxFaceStyle → Opacity [0.3], DuctStyle → {Opacity [0.1]} ]
It seems obvious that, for small enough ε, this construction will work. To find a precise value that works, we can use Mathematica to check visibilities. The main subroutine for such a check will be the determination whether a given polygon intersects a line segment. We need only consider the simple case where the polygon is parallel to one of the coordinate planes, and that is quite easy to program. And we can handle one direction only, transforming other directions to it.
blockingPolys = Cases[ducts, _Polygon, ∞];
guards =
Union[Cases[{cuboid[{0, 0, 0}, {6, 6, 6}], ducts}, {_, _, _}, ∞⟧; Length /@ {guards, blockingPolys}
{56, 30}
Now, intersect [P, Q, {{x0, y0}, {x1, y1}}, z] (defined in the next large block of code) returns True if the line segment from P to Q (these are points in R^{3}) strikes the horizontal rectangle determined by the x and yvalues and having height z. The code for intersect is simple, since one can use Solve to determine the exact value of the parameter t for which (1 − t) P + t Q strikes the blocking plane (it depends only on the zcoordinates of the two points and the zcoordinate of the plane). Then one need only check whether this value is between 0 and 1 and whether the x−y points that define the intersection are actually inside the rectangle.
fix[Polygon[{{2, 3,1}, {2,3,5}, {4,3,5}, {4,3,1}}⟧
{{{2, 1}, {4, 5}}, 3, 2, {1, 3}}
This means that the rectangle runs from {2, 1} to {4, 5} with constant coordinate 3 and occurring in the second position. The {1, 3} indicates the plane of the blocker.
slope [a_, b_, c_]:= (a − c) / (a − b);
intersect[P_, Q_, {{x0_, y0_}, {x1_, y1_}}, z_]:= ((0 < (t = slope [P⟦3⟧, Q⟦3⟧, z]) < 1) && (point = Drop [ (1 − t) P + tQ, − 1]; x0 ≤ point ⟦1⟧ ≤ x1 && y0 ≤ point ⟦2⟧ ≤ y1))
fix[p_Polygon]:= (l = (Length[Union[#]]@Transpose @@ p;
posn = Position[l, Min[l⟧⟦1, 1⟧;
d= DeleteCases[{1, 2,3}, posn];
xx = Transpose [ ({#⟦d⟦1⟧⟧, #⟦d⟦2⟧⟧} &) /@ p⟦1⟧ ]; {{Min/@xx, Max/@xx},
p⟦1, 1, posn⟧, posn, Complement [{1, 2, 3}, {posn}]})
SeidelVerify[ε_, m_]:= (SeidelRoom[ε, m]; blockingPolys = Cases[ducts, _Polygon, ∞];
guards = Union [Cases [ {cuboid [{0, 0, 0}, m], ducts}, {_, _, _}, ∞⟧;
answer = True;
Do[i = 0; blocked = False;
While [ ! blocked &&i < 30, i++;
ff = fix [blockingPolys⟦i⟧ ]; c = guards⟦j⟧;
p2 = Flatten [{c⟦ff⟦4⟧⟧, c⟦ff⟦3⟧⟧}];
p1 = Flatten [ {hiding⟦ff ⟦4⟧⟧, hiding⟦ff ⟦3⟧⟧} ];
blocked = ! MemberQ [blockingPolys⟦i, 1⟧, c] && intersect [p1, p2, ff ⟦1⟧, ff⟦2]⟧;
If [ ! blocked &&i == 30, If[! ListQ [answer], answer = {} ]; AppendTo[answer,
StringForm [ “Guard number sees the hiding place.”, j⟧⟧, {j, Length[guards]}];
If[answer === True, True, Column[answer⟧)
SeidelVerify[0.4, {6, 6, 6}]
Guard number 1 sees the hiding place.
Guard number 2 sees the hiding place.
Guard number 3 sees the hiding place.
Guard number 4 sees the hiding place.
SeidelVerify[0.37, {6, 6, 6}]
True
In fact, much more is true. One can arrange an array of indentations so that the total number of vertices, n, is 8 (3 k ^{2} + 1) and the number of hiding places is (k − 1)^{3} and, further, no guard can see more than eight hiding places. This yields an asymptotic result of C n ^{3/2} for the number of vertex guards needed for an nvertex polyhedron, where C is a constant.
However, the construction as outlined in [Oro] does not work, because it is specified there that the hiding place should be at the centers of their cubicles. Using Mathematica, I discovered that this yields lots of unintended visibilities. This is why the hiding place presented here is offset from the center of the cubicle; making the same change to Seidel’s construction in [Oro] yields the desired conclusions.
15.4 More Euclid
For further explorations in plane geometry it is useful to have a comprehensive library of routines to carry out standard geometrical constructions. Having such a library in place will make it much easier to attack programming problems that arise. We will make a start toward such a library in this section by adding to the routines defined in §15.1 and giving a few applications. All the routines of this chapter are gathered in the PlaneGeometry package.
poly = Table [ {x_{i}, y_{i}}, {i, 5}];
Flatten [poly ({1, −1} Reverse [#] &) /@ RotateLeft [poly⟧
{x_{1} y_{2}, −x_{2} y_{1}, x_{2} y_{3}, − x_{3} y_{2}, x_{3} y_{4}, − x_{4} y_{3}, x_{4} y_{5}, −x_{5} y_{4}, x_{5} y_{1}, − x_{1} y_{5})
SignedArea[poly_]:=
½ Total [Flatten[poly ({1, − 1} Reverse [#] &) /@ RotateLeft[poly]⟧ /;
Length[poly] > 3
IntersectOpen[{a_, b_}, {c_, d_}]: =
((LeftOf [a, b, c] && RightOf [a, b, d]) ǁ
(LeftOf [a, b, d] && RightOf [a, b, c])) &&
((LeftOf[c, d, a] && RightOf [c, d, b]) ǁ
(LeftOf[c, d, b] && RightOf [c, d, a]));
Between[p_, q_, r_]:= Orientation [ {p, q, r}] = 0 &&
If [p⟦1⟧ ≠ r⟦1⟧, p⟦1⟧ ≤ r⟦1⟧ <, q⟦1⟧ ǁ q⟦1⟧ ≤ r⟦1⟧ ≤, p⟦1⟧, p⟦2⟧ ≤, r⟦2⟧ ≤, q⟦2⟧ ǁ q⟦2⟧ ≤, r⟦2⟧ ≤, p⟦2⟧]
IntersectClosed[{a_, b_}, {c_, d_}]: = IntersectOpen[{a, b}, {c, d}] ǁ
Between[a, b, c] ǁ Between[a, b, d] ǁ
Between[c, d, a] ǁ Between[c, d, b]
LineIntersection[{{a_, b_}, {c_, d_}}, {{e_, f_}, {g_, h_}}]: =
{bce−ade−bcg+adg−afg+cfg+aeh−ceh,
bcf−adf−bfg+dfg−bch+adh+beh−deh}/
(be−de−af+cf−bg+dg+ah−ch)
Distance[u_, v_]:= Norm [u−v]
SideLengths[poly_]:= Apply[Distance, Partition[extend[poly], 2, 1], {1}];
Centroid[poly_]:= Mean[poly];
Medians[triangle_]:= Transpose[ {(triangle + RotateLeft[triangle]) /2, RotateRight[triangle]}]
Perimeter[triangle_]: = Total[SideLengths[triangle⟧;
Semiperimeter[triangle_]:= Perimeter[triangle] /2;
Incenter[triangle_]:=}SideLengths[triangle].RotateRight[triangle] / Perimeter[triangle];
Inradius[triangle_]:= Module \(\left[{\left\{{s = \frac{{perimeter\left[{triangle}\right]}} {2}} \right\},\surd \left({\frac{1} {s}Times@@\left({s  SideLengths \left[{triangle}\right]} \right)} \right)}\right]\)
Exradii[triangle_]:=
$$\left({\rm{s} = \rm{Semiperimeter}\,\left[{\rm{triangle}}\right];ss = \rm{SideLengths}\left[{\rm{triangle}}\right]\,\rm{N}\left[{\surd \left({\rm{s}\frac{{\left({\rm{s  ss}\left[\kern0.15em\left[3 \right]\kern0.15em\right]} \right)\left({\rm{s  ss}\left[\kern0.15em\left[2 \right]\kern0.15em\right]} \right)}} {{\rm{s  ss}\left[\kern0.15em\left[1 \right]\kern0.15em\right]}},\frac{{\left({\rm{s  ss}\left[\kern0.15em\left[3 \right]\kern0.15em\right]} \right)\left({\rm{s  ss}\left[\kern0.15em\left[1 \right]\kern0.15em\right]} \right)}} {{\rm{s  ss}\left[\kern0.15em\left[2 \right]\kern0.15em\right]}},\frac{{\left({\rm{s  ss}\left[\kern0.15em\left[1 \right]\kern0.15em\right]} \right)\left({\rm{s  ss}\left[\kern0.15em\left[2 \right]\kern0.15em\right]} \right)}} {{\rm{s  ss}\left[\kern0.15em\left[3 \right]\kern0.15em\right]}}} \right)}\right]} \right);$$Circumradius[triangle]:= (Total[Exradii[triangle⟧  Inradius[triangle]) / 4;
AreaHeron[triangle]:= is = Semiperimeter[triangle]; N[√ (s Times @@ (s − SideLengths [triangle])) ]);
RandomTriangle:= RandomReal[{0, 1}, {3, 2}];
Perp[v_]:= {1, 1}Reverse[v];
PerpSegment[{u_, v_}]:= {u, u + Perp [v − u]};
Circumcenter [ {a_, b_, c_}]: =
$$\rm{LineIntersection}\left[{\rm{perpSegment}\left[{\left\{{\frac{{\rm{b + c}}} {2},\rm{c}} \right\}}\right],\rm{perpSegment}\left[{\left\{{\frac{{\rm{a + b}}} {2},\rm{b}} \right\}}\right]}\right];$$Circumcircle[{a_, b_, c_}]:= Circle[Circumcenter[{a, b, c}], Circumradius[{a, b, c}⟧;
Orthocenter[triangle_]:= 3 Centroid[triangle]  2 Circumcenter[triangle];
NinePointCircle[triangle_]:= Circle[(Circumcenter[triangle] +Orthocenter[triangle]) /2, Circumradius[triangle] / 2];
Pedal[triangle]:= (LineIntersection[{Orthocenter[triangle], #}, Complement [triangle, {#}⟧ &) /@triangle;
ExtendTriangleSides[tri_, a_:2]:= Module[{t}, (t#⟦1⟧+ (1−t) #⟦2⟧ /. {{t→a}, {t→a}} &) /@ Table[Delete[tri, j], {j, 3}⟧
SeedRandom[5];
tri = RandomTriangle;
i = Incenter[tri];
Graphics[{{PointSize[0.025], Point[i]}, Thickness[0.006], Circle[i, Inradius[tri⟧, Line[extend[tri⟧}]
Manipulate[tri = {p1, p2, p3}; i = Incenter[tri];
Graphics[{EdgeForm[Thickness[0.006⟧,
FaceForm[Yellow], Disk[i, Inradius[tri⟧, Thickness[0.006],
Line[extend[tri⟧, {PointSize[0.025], Point[i]}},
PlotRange→ {{−0.1, 1.1}, {−0.1, 1.1}}], {{p1, {0, 0}}, Locator},
{{p2, {1, 0}}, Locator}, {{p3, {1, 1}}, Locator}]
Graphics[{{PointSize [0.025], Point[x = Circumcenter[tri⟧},
Thickness[0.006], Circle[x, Circumradius[tri⟧, Line[extend[tri⟧}]
Unprotect[O];
tri = {{0, 0}, {2, 0}, {0.3, 1.5}};
O = Orthocenter[tri]; feet = Pedal[tri];
altitudes = Line [Table [{tri⟦i⟧, feet⟦i⟧}, {i, 3}⟧;
pts =
Transpose[Cases[{O, tri, feet}, {_?NumericQ, _?NumericQ}, ∞⟧;
x1, x2, y1, y2} = {Min [pts⟦1⟧ ], Max [pts ⟦1⟧],
Min [pts ⟦2⟧], Max [pts ⟦2⟧]};
Graphics Thickness[0.005],
{Dashed, Line[ExtendTriangleSides[tri⟧}, altitudes}, {Thickness[0.017], Line[extend [tri⟧}, {PointSize[0.02], Point[O]}, {GrayLevel[1], PointSize[0.02], Point /@ feet}}, Frame → True,
FrameTicks → None, Background → RGBColor [1, 1, 0.6],
PlotRange → {{x1 − 0.3 (x2 − x1), x2 + 0.3 (x2 − x1)}, {y1 − 0.3 (y2 − y1), y2 + 0.3 (y2 − y1)}} ]

the three bisectors of the sides

the three points of the pedal triangle (the feet of the perpendiculars from the orthocenter, H, the large red point in the diagram)

the three midpoints of HV, where V is a vertex of the triangle
midpoints = First /@ Medians[tri];
H = Orthocenter[tri]; O = Circumcenter[tri];
Graphics [{Thickness [0.004], Line[extend[tri⟧, Line[{H, O}]}, {Thickness[0.01], NinePointCircle[tri]},
Circle[Circumcenter[midpoints], Circumradius[midpoints⟧, {PointSize[0.035], {Red, Point[H]}, {Green, Point[O]}, Point \(\left[{\frac{{H + O}} {2}}\right]\), {PointSize[0.025], Blue, Point[midpoints], \(\left({point\left[{\frac{{H + \# 1}} {2}}\right]\&} \right)\) /@ tri, Point [Pedal [tri⟧}}, Frame → True,
FrameTicks → None, Background →RGBColor[1, 1, 0.6]
WittenbauerParallellogram [quad_]:= Module {trisect},
$$\rm{trisect}\left[{\left\{{\rm{p}\_,\rm{q}\_} \right\}}\right]: = \left\{{\frac{{2\rm{p}}} {3} + \frac{\rm{q}}{3},\frac{\rm{p}}{3} + \frac{{2\rm{q}}}{3}} \right\};\rm{Apply}[\rm{LineIntersection}$$Partition[extend[Partition[RotateLeft[Flatten[trisect /@ Partition[extend[quad], 2, 1], 1⟧, 2⟧, 2, 1], {1}]
DiagonalIntersection [{a_, b_, c_, d_}]: = LineIntersection[{a, c}, {b, d}];
CenterOfArea[quad_]:= (4 Centroid[quad] − DiagonalIntersection[quad]) /3;
quad = {{0, 0}, {0, 3}, {3, 5}, {6, 2}};
Graphics[{PointSize[0.02], {Thickness[0.012], Line[extend[quad⟧},
Point [DiagonalIntersection [quad⟧, Line [quad ⟦{1, 3}⟧],
Line [quad⟦{2, 4}⟧], Point [Centroid [quad⟧,
{EdgeForm[Black], Red, Disk[CenterOfArea[quad], 0.07]}, {Dashed, Thickness[0.003], Blue, Line[extend[WittenbauerParallellogram[quad]⟧}}]
{CenterOfArea[quad], Centroid[WittenbauerParallellogram[quad⟧}$$\left\{{\left\{{\frac{{27}} {{11}},\frac{{80}} {{33}}} \right\},\left\{{\frac{{27}} {{11}},\frac{{80}} {{33}}} \right\}} \right\}$$
One can also look at the center of gravity of the edges of a quadrilateral, assuming uniform density. The late Joe Konhauser showed me a geometric construction that he had worked out (unpublished). Here are the details; the implementation — and the proof that this works — are good exercises. Given quadrilateral ABCD, let X, Y, Z, W be the midpoints of AB, BC, CD, DA, respectively. Bisect angle B and let the angle bisector BP intersect XY in P and choose P _{1}on XY so that P _{1} Y = XP (P and P _{1} are called isotonic points). Similarly, bisect angle D with DQ so that Q lies on WZ, and let Q _{1}on WZ be such that Q _{1} Z = WQ. Then the center of the edges is on the segment P _{1} Q _{1}. Repeating the construction using angles A and C instead yields another segment containing the center we want, and so the intersection of the two segments does the job.
v = Centroid[quad]; w = CenterOfArea[quad]; k = CenterOfEdges[quad];
d = DiagonalIntersection[quad];
Graphics[{PointSize[0.025], Thick, Line[extend[quad⟧,
Thickness[0.003], Line[{d, w} ], Point[{v, d, w, k}]}]
Manipulate [quad = {p1, p2, p3, p4}; v = Centroid [quad];
w = CenterOfArea[quad];
k = CenterOfEdges[quad];
d = DiagonalIntersection[quad];
Graphics[{PointSize[0.015], Thick, Line[extend[quad⟧,
Thickness[0.003], Line[{d, w} ], Point[{v, d, w}], Red, Point[k]},
PlotRange→ {{−0.05, 1.05}, {−0.05, 1.05}}], {{p1, {0.5, 0.2}}, Locator}, {{p2, {1, 0}}, Locator}, {{p3, {1, 0.5}}, Locator}, {{p4, {0, 1}}, Locator}]
SteinerPoint[tri_]:= Module [{c= Centroid [tri]}, Total [ (Distance [ {x, y}, #] &) /@tri], {x, c⟦1⟧}, {y, c⟦2⟧}⟧⟧
SeedRandom[5];
tri = RandomTriangle;
F = SteinerPoint[tri];
Graphics[{{PointSize[0.04], Point[F], Point[tri]}, Thickness[0.008], Line[extend[tri⟧, Line[{F, #}] & /@ tri}]
tri = {{0, 0}, {5, 0}, {2, 1}};
F = SteinerPoint[tri];
Graphics[{{PointSize[0.03], Point[F], Point[tri]},
Thickness[0.008], Line[extend[tri⟧, Line[{F, #}] & /@ tri}]

Two new points added, with one connected to A and B and the other to C and D;

Two new points added, with one connected to A and C and the other to B and D;

One new point added, connected to each of A, B, and C, with D connected to the closest of the four other points;

Previous case, but with all other triples instead of ABC,

No new points added, the tree being simply a path of the form ABCD;

No new points added, the tree having the form AB, AC, AD.
Of course, there are many more routines that such a library should contain and many examples that are worth drawing. The reader might enjoy working out Angles [polygon], which should give the sequence of angles of a polygon, and adding it to the package. A nice exercise is the illustration of Morley’s theorem on angle trisectors of a triangle (they meet in an equilateral triangle). [Cox] is a good reference for such things.