Code for Electronic Supplement

PlaneGeometry Package

BeginPackage["PlaneGeometry`", {"ComputationalGeometry`"}];   (* for ConvexHull *)

AngleBisector::usage = "AngleBisector[{p, q, r}] gives {q,s}, which bisects angle pqr.";

Area::usage = "Area[p] gives the area of the polygon p.";

AreaHeron::usage = "AreaHeron[t] gives the area of the triangle t computed by Heron's formula.";

Between::usage = "Between[p, q, r] gives True if pqr form a straight line and q is betwen p and r.";

CenterOfArea::usage = "CenterOfArea[polygon] gives the center of gravity of the plane region formed by the polygon.";

CenterOfEdges::usage = "CenterOfEdges[{p, q, r, s}] gives the center of gravity of the four edges of the quadrilateral pqrs.";

Centroid::usage = "Centroid[p] gives the centroid of the polygon p. This is the center of gravity of the vertices.";

Circumcenter::usage = "Circumcenter[t] gives the circumcenter of the triangle t.";

Circumradius::usage = "Circumradius[t] gives the radius of the circumcircle of the triangle t.";

Circumcircle::usage = "Circumcircle[{p,q,r}] gives the circle that circumscribes triangle p, q, r.";

ConvexVertex::usage = "ConvexVertex[p] gives the index of a vertex of the polygon p that is a convex vertex.";

DiagonalIntersection::usage = "DiagonalIntersection[{p, q, r, s}] gives the intersection point of the two diagonals of the quadrilateral pqrs.";

Distance::usage = "Distance[u, v] gives the Euclidean distance between the points u and v in the plane.";

Exradii::usage = "Exradii[t] gives the three radii of the excircles at the external angles of the triangle t.";

extend::usage = "extend[l] forms the list obtained by putting the first entry of the list l at the end too.";

ExtendTriangleSides::usage = "ExtendTriangleSide[t, a:2] gives three segments that form elongated versions of the sides of the triangle t; a controls the amount of extension.";

Incenter::usage = "Incenter[t] gives the center of the inscribed circle of triangle t.";

Inradius::usage = "Inradius[t] gives the radius of the inscribed circle of triangle t.";

Inside::usage = "Inside[poly, pt] returns True if the point pt is inside or on the polygon poly.";

IntersectClosed::usage = "IntersectClosed[{a, b}, {c, d}] gives True if the closed segment ab intersects the closed segment cd.";

IntersectOpen::usage = "IntersectOpen[{a, b}, {c, d}] gives True if the open segment ab intersects the open segment cd.";

LeftOf::usage = "LeftOf[p, q, r] gives True if the point r is left of the directed infinite line determined by pq.";

RightOf::usage = "RightOf[p, q, r] gives True if the point r is left of the directed infinite line determined by pq.";

LineIntersection::usage = "LineIntersection[{p, q}, {r, s}] gives the point at which the line determined by the segment pq intersects the line determined by the segment rs.";

Medians::usage = "Medians[t] gives the three medians of a triangle t.";

NinePointCircle::usage = "NinePointCircle[t] gives the Circle object that represents the nine-point circle for the triangle t.";

Orientation::usage = "Orientation[p] gives +1 if the polygon p is given in counterclockwise order, -1 if it is clockwise.";

Orthocenter::usage = "Orthocenter[t] gives the orthocenter of the triangle t.";

Pedal::usage = "Pedal[t] gives the pedal triangle of a triangle t.";

Perimeter::usage = "Perimeter[p] gives the perimeter of the polygon p.";

Perp::usage = "Perp[v] rotates v 90˚ about the origin in a clockwise direction.";

PerpSegment::usage = "PerpSegment[{p, q}] gives the line segment obtained by rotating segment pq in a counterclockwise direction.";

PolygonDiagonal::usage = "PolygonDiagonal[p] gives the indices of an interior diagonal of the polygon p.";

RandomTriangle::usage = "RandomTriangle gives a random triangle with vertices in the unit square.";

SeidelVerify::usage = "SeidelVerify[ε, m_List] verifies that a polyhedron drawn via SeidelRoom[ε, m] works, in the sense that the hiding place is invisible from all the vertices.";

Semiperimeter::usage = "Semiperimeter[p] gives one-half of the perimeter of the polygon p.";

Show3ColoredPolygon::usage = "Show3ColoredPolygon[p] draws the polygon p along with a triangulation and three colors on the vertices.";

ShowGuards::usage = "ShowGuards[p] draws the polygon and p and shows how to place at most ⌊n/3⌋ guards at the vertices so that they see the entire interior of p, where n is the number of vertices of p.";

ShowHidingPlace::usage = "ShowHidingPlace is an option to SeidelRoom that places a point at the hiding place near the center.";

SideLengths::usage = "SideLengths[p] gives the side lengths of the polygon p.";

SignedArea::usage = "SignedArea[p] gives the signed area of a polygon p (positive area if orientation is counterclockwise, otherwise negative).";

SteinerPoint::usage = "SteinerPoint[{A,B,C}] shows the point P inside a triangle that minimizes PA + PB + PC.";

SteinerTree::usage = "SteinerTree[{p, q, r, s}] shows the Steiner tree for the quadrilateral pqrs.";

ThreeColor::usage = "ThreeColor[p] returns a three-coloring of the vertices of the polygon p, obtained by first triangulating p.";

Triangulate::usage = "Triangulate[p] triangulates the polygon p using diagonals. The output is the set of triangles, in terms of indices.";

RandomPolygon::usage = "RandomPolygon[n] gives a random polygon on n points in the unit square, via the Auer-Held steady-growth algorithm. RandomPolygon[pts] gives a random polygon using the points pts."; 

Smooth::usage = "Smooth[polygon] gives a polygon with twice as many points that is smoother than the original. There is a chance this will introduce self-intersections."; 

InitialStep::usage = "InitialStep is an option to ShowPolygon that, when ShowSteps is True, specifies the starting point of the movie.";

ShowPoints::usage = "ShowPoints is an option to RandomPolygon that, when ShowPolygon is True, determines whether the vertices are shown.";

ShowPolygon::usage = "ShowPolygon is an option to RandomPolygon that causes the polygon to be shown graphically.";

Smoothing::usage = "Smoothing is an option to RandomPolygon that doubles the number of vertices breplacing each vertex with the two vertices that are 1/4 of the way to their neighbors. The parameter, 4, can be changed by the Smoothing Parameter option. The effect is to smooth the polygon, eliminating some of the sharp edges."; 

SmoothingParameter::usage = "SmoothingParameter is an option to RandomPolygon that sets the constant used for the smoothing process. The default, 4, replaces each point by the points 1/4 of the way along to the neighbors."; 

PolygonQ::usage = "PolygonQ[p] returns True if p is a simple polygon. It is assumed that p is a list of distinct points with no superposition among its edges."; 

RandomPolygon::badwarn = "The smoothing process has led to a nonpolygon; a different random polygon is being generated.";

SmoothCurve::usage = "SmoothCurve is an option to RandomPolygon that causes the polygon to be interpolated into (fx,fy) that defines a smooth curve. However, there is a good chance the curve will have self-intersections."; 

ShowSteps::usage = "ShowSteps is an option to RandomPolygon that, when True, causes each step of the construction to be shown.";

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.";

BoxFaceStyle::usage = "BoxFaceStyle is an option to SeidelRoom that sets the style of the outer \
faces other than the top face.";

ShowHidingPlace::usage = "ShowHidingPlace is an option to SeidelRoom that places a point at the \
hiding place in the center.";

Begin["`Private`"];

Centroid[poly_] := Apply[Plus, poly] / Length[poly]

(* SACom = Compile[{x1, y1, x2, y2, x3, y3},
   0.5(-x2 y1+x3 y1+x1 y2-x3 y2-x1 y3+x2 y3)]; *)
   
SACom = Compile[{{v, _Real, 2}}, 
0.5 (-v[[2,1]] v[[1,2]]+v[[3,1]] v[[1,2]]+v[[1,1]] v[[2,2]]-v[[3,1]] v[[2,2]]-v[[1,1]] v[[3,2]]+v[[2,1]] v[[3,2]])];

(* SignedArea[triangle_] :=  SACom @@ Flatten[triangle] /; Length[triangle] == 3; *)

SignedArea[triangle_] := SACom[triangle] /; Length[triangle] == 3;

SignedArea[poly_] := Plus @@ Flatten[ poly * Map[{1,-1} * Reverse[#] &, 
     RotateLeft[poly]]]/2 /; Length[poly] > 3;
     
Area[p_] := Abs[SignedArea[p]];

Orientation[triangle_] := Sign[SignedArea[triangle]] /; Length[triangle] == 3;

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)

Inside[{p_, q_, r_}, pt_] := Module[{pp,qq,rr},
  {pp,qq,rr} = If[Orientation[{p,q,r}]==-1, Reverse, Identity][{p,q,r}];
  (!LeftOf[qq, pp, pt] && !LeftOf[rr, qq, pt] && !LeftOf[pp, rr, pt])]

Inside[p_List/;Length[p]>3, pt_List] := 
  Module[{tris = (p[[#1]] & ) /@ Triangulate[p], 
    ans = False, i = 0}, 
   While[ !ans && i < Length[tris], 
     i++; ans = Inside[tris[[i]], pt]]; ans]

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}, 
    Identity[{Position[poly, 
      Last[Sort[invertices, 
    Area[{poly[[u]],#1, poly[[w]]}] <= 
     Area[{poly[[u]],#2, 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]

ThreeColor[pts_] := ThreeColor[pts, Triangulate[pts]];

ThreeColor[pts_, tris_] := {1,2,3} /; Length[pts] == 3

ThreeColor[pts_, tris_] := Module[{i, oldcolors},
 i = Select[tris, Abs[#[[3]] - #[[1]]]== 2 &, 1][[1,2]];
 oldcolors = ThreeColor[Delete[pts, i],
   DeleteCases[tris, ear] /. {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}];
 Show[Graphics[{PointSize[0.025],
{Thickness[0.012], Line[extend[pts]]},
Line[pts[[#]]]& /@ tri, 
 {colors[[#[[2]]]], Point[#[[1]]]}& /@ Transpose[{pts, ThreeColor[pts,tri]}]}],AspectRatio->Automatic])

ShowGuards[poly_] := (col3 = ThreeColor[poly];
Show[Graphics[{
 {Thickness[0.008], Line[extend[poly]]},
 {PointSize[0.03], Point /@ 
poly[[Flatten@Position[col3, Position[counts = (Count[col3, #] & /@ {1,2,3}), Min[counts]][[1,1]]]]]}}], AspectRatio->Automatic])


fc = Compile[{a,b,c},(a- c)/(a- b)];

intersect[P_, Q_, {{x0_, y0_}, {x1_, y1_}}, z_] := (
		(0 < ( t=fc[P[[3]], Q[[3]], z])< 1) && 
		(point = Drop[(1-t)P + t Q , -1] ;
		x0 ≤ point[[1]] ≤ x1 && y0 ≤ point[[2]]  ≤ y1))
				 
fix[p_Polygon] := (l = (Length[Union[#]] & ) /@ Transpose @@ p; 
    posn = First[First[Position[l, Min[l]]]]; 
    d = DeleteCases[{1, 2, 3}, posn]; 
    xx = Transpose[({#[[d[[1]]]],
                 #[[d[[2]]]]} & ) /@ 
          p[[1]]]; 
    {{Min /@ xx, Max /@ xx}, 
      p[[1,1,posn]], posn, 
     Complement[Range[3], {posn}]})

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[{a_,b_,c_}, {d_, e_, f_}, n_] := Delete[cuboid[{a, b, c}, {d, e, f}], n]
     
Options[SeidelRoom] = {BoxFaces -> AllButTop, ShowHidingPlace->True};


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[[1]]/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[[1]]/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}]]}, {topsty, outer[[6]]}, 
           ducts = {ductsty, (facelessCuboid[{m[[1]]/2 - 0.5, 0, #1}, 
                      {m[[1]]/2 + 0.5, m[[2]] - ε, #1 + 1}, 
           1] & ) /@ 
                 {m[[3]]/2 - 1 - h, m[[3]]/2 + h}, 
               (facelessCuboid[{ε, #1, 
            m[[3]]/2 - 0.5}, {m[[1]], #1 + 1, 
                        m[[3]]/2 + 0.5}, 3] & ) /@ {m[[2]]/2 - 1 - h, 
         m[[2]]/2 + h}, 
               (facelessCuboid[{#1, m[[2]]/2 - 0.5, 0}, {#1 + 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]); 

 SeidelVerify[ε_, m_] := (SeidelRoom[ε, m]; 
     blockingPolys = Cases[ducts, _Polygon, Infinity]; 
     guards = Union[Cases[{cuboid[{0, 0, 0}, m], ducts}, {_, _, _}, 
           Infinity]];
  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]]);       

SignedArea[poly_] := Plus @@ Flatten[
  poly * Map[{1,-1} * Reverse[#] &, 
     RotateLeft[poly]]]/2 /; Length[poly] > 3
     
Area[p_] := Abs[SignedArea[p]]

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_}}] :=
  {b*c*e - a*d*e - b*c*g + a*d*g - a*f*g + c*f*g + a*e*h - c*e*h, 
   b*c*f - a*d*f - b*f*g + d*f*g - b*c*h + a*d*h + b*e*h - 
    d*e*h}/
  (b*e - d*e - a*f + c*f - b*g + d*g + a*h - c*h)

Distance[u_, v_] := Norm[u - v]

SideLengths[poly_] :=  
  Apply[Distance, Partition[extend[poly], 2, 1], {1}]

Medians[triangle_] := Transpose[
  {(triangle + RotateLeft[triangle])/2, 
    RotateRight[triangle]}]
   
Centroid[poly_] := Apply[Plus, poly]/Length[poly]


Medians[triangle_] := Transpose[
  {(triangle + RotateLeft[triangle])/2, 
    RotateRight[triangle]}]

Perimeter[poly_] := Plus @@ SideLengths[poly]

Semiperimeter[poly_] := Perimeter[poly]/2

Incenter[triangle_] :=  SideLengths[triangle].RotateRight[triangle] / Perimeter[triangle]

Inradius[triangle_] := Module[{s = Perimeter[triangle]/2},
              Sqrt[Apply[Times, s - SideLengths[triangle]]/s]]

Exradii[triangle_] := (s = Semiperimeter[triangle];
	ss = SideLengths[triangle];
    N[Sqrt[s * {(s-ss[[3]])(s-ss[[2]])/(s-ss[[1]]),
            (s-ss[[3]])(s-ss[[1]])/(s-ss[[2]]),
            (s-ss[[1]])(s-ss[[2]])/(s-ss[[3]])}]])

Circumradius[triangle_] :=
  (Apply[Plus, Exradii[triangle]] - Inradius[triangle])/4
  
AreaHeron[triangle_] := (s = Semiperimeter[triangle];
  N[Sqrt[s Apply[Times, s - SideLengths[triangle]]]])

RandomTriangle := Array[Random[]&, {3,2}]

Perp[v_] :={-1, 1} * Reverse[v]

PerpSegment[{u_, v_}] := {u, u + Perp[v-u]} 

Circumcenter[{a_, b_, c_}] := LineIntersection[
 PerpSegment[{(b+c)/2, c}], PerpSegment[{(a+b)/2, b}]]

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,1,3}]]
		        
SteinerPoint[tri_] := Module[{c = Centroid[tri]},
  {x,y} /.Last[FindMinimum[
  Plus @@ (Distance[{x,y}, #]& /@ tri),
  {x, c[[1]]}, {y, c[[2]]}]]]
  
NetworkLength[{a_, b_, c_, d_}, P_, Q_] :=
 Distance[a, P] + Distance[b, P] + Distance[P,Q] +
 Distance[Q, c] + Distance[Q, d] 

SteinerTree[{a_, b_, c_, d_}] := Module[{p = Centroid[quad]},
 f1=FindMinimum[NetworkLength[{a,b,c,d}, {x1, y1}, {x2, y2}],
           {x1, p[[1]]-First[b-a]/100}, {y1, p[[2]]}, 
				{x2, p[[1]]} , {y2, p[[2]]}];
 f2=FindMinimum[NetworkLength[{a,c,b,d}, {x1, y1}, {x2, y2}],
   {x1, p[[1]]-.01}, {y1, p[[2]]}, {x2, p[[1]]} , {y2, p[[2]]}];
 perm = If[f1[[1]] > f2[[1]],{1,3,2,4},Range[4]];{P, Q} =
       {{x1,y1}, {x2,y2}} /. Last[ First[Sort[{f1,f2}]]];
Graphics[{
	Line[{a,b,c,d,a}],
	Line[{P,Q}],
	Line[{P,#}]& /@  {a,b,c,d}[[perm[[{1,2}]]]],
	Line[{Q,#}]& /@  {a,b,c,d}[[perm[[{3,4}]]]],
	PointSize[0.025], Point /@ {a,b,c,d,P, Q}}]];
  
CenterOfArea[quad_] := 
  (4/3) Centroid[quad] - (1/3) DiagonalIntersection[quad] /; Length[quad]==4;
  
CenterOfArea[tri_] := Centroid[tri] /; Length[tri]==3;
  
CenterOfArea[p_] := Module[{tris= Triangulate[p]}, 
  triangles = Table[p[[tris[[i]]]], {i, Length[p]-2}]; 
  ((Area /@ triangles).(Centroid /@ triangles))/Area[p]] /; Length[p]>4;

DiagonalIntersection[{a_, b_, c_, d_}] :=LineIntersection[{a,c},{b,d}];

AngleBisector[{p_, q_, r_}] := (v1 = (p-q)/Norm[p-q];
v2 = (r-q)/Norm[r-q]; N@{q, q + (v1+v2)/Norm[v1+v2]} );

Konh[{p_, q_, r_}] := LineIntersection[{p,r},AngleBisector[{p,q,r}]];

Isotomic[{p_, q_, r_}] := Module[{t}, t p + (1-t)r /. (t ->
    (First[Select[Flatten[t /. (Solve[Distance[t p + (1-t)r, r]^2 == Distance[p,q]^2, t])],  0 < # < 1 & ]]))];
 
CenterOfEdges[{a_, b_, c_, d_}] := ({x,y,z,w} = ({a,b,c,d} + {b,c,d,a})/2;
LineIntersection[
 {Isotomic[{w, Konh[{w,d,z}],z }],Isotomic[{x, Konh[{x,b,y}],y }]}, 
 {Isotomic[{w, Konh[{w,a,x}],x }],Isotomic[{z, Konh[{z,c,y}],y }]}]);
 
 
 If[$VersionNumber < 4, Unprotect[Mod]; Mod[a_, n_, 1] := Mod[a, n] /. 0 -> n; Protect[Mod]]; 

MinAndMax[x_, f_] := (
   x[[{Position[#, Min[#], 1, 1][[1,1]], 
       Position[#, Max[#], 1, 1][[1,1]]}]]&)[f /@ x]; 
       
LeftOfcom = Compile[{{p,_Real,1}, {q,_Real,1}, {r, _Real, 1}},
  p[[2]](r[[1]]-q[[1]]) + q[[2]](p[[1]]-r[[1]]) + r[[2]](q[[1]]-p[[1]]) > 0];

extend[s_] := Append[s, s[[1]]]; 

norm = Compile[{{v, _Real, 1}}, Sqrt[v . v]]; 

InsideTriangleQ = Compile[{{q, _Real, 2}, {p, _Real, 1}}, 
 3 == Abs[
  Sign[p[[2]](q[[1,1]] - q[[3,1]]) + q[[3,2]](p[[1]] - q[[1,1]]) + 
       q[[1,2]](q[[3,1]] - p[[1]])] + 
  Sign[p[[2]](q[[2,1]] - q[[1,1]]) + q[[1,2]](p[[1]] - q[[2,1]]) +
       q[[2,2]](q[[1,1]] - p[[1]])] + Sign[p[[2]](q[[3,1]] - q[[2,1]]) +
       q[[2,2]](p[[1]] - q[[3,1]]) + q[[3,2]](q[[2,1]]- p[[1]])]] ];          

IntersectInteriorQ[{a_, b_}, {c_, d_}] := 
  Xor[LeftOfcom[a, b, c], LeftOfcom[a, b, d]] && 
  Xor[LeftOfcom[c, d, a], LeftOfcom[c, d, b]] && a != c &&  a != b && b != c && b != d;

angle = Compile[{{v, _Real, 1}, {w, _Real, 1}}, 
    Sign[v[[2]] * w[[1]] - v[[1]] * w[[2]]]* ArcCos[v . w / Sqrt[v.v * w.w]]]; 
    
angle2 = Compile[{{v, _Real, 1}, {w, _Real, 1}}, ArcCos[v.w / Sqrt[v.v * w.w]]]; 

anglesign = Compile[{{v,_Real,1}, {w,_Real,1}},  Sign[v[[2]]*w[[1]] - v[[1]]*w[[2]]]];
    
AdditionalTriangle[{pt1_, pt2_}, p_] := {1, 2};

MinAndMax[x_, f_] := (x[[
      {Position[#, Min[#], 1, 1][[1,1]], 
       Position[#, Max[#], 1, 1][[1,1]]}]]&)[f /@ x];
       
AdditionalTriangle[poly_, p_] := 
  MinAndMax[Range[Length[poly]], angle[poly[[1]] - p, poly[[#]] - p] &]; 
 
VisibleEdge[pol_, pt_] := Module[{edges, epol = extend[pol]},
  If[Length[pol] == 2, pol,
    edges = Map[epol[[{#,# +1}]]&, Last /@ 
       Sort[Transpose[{
          Apply[ArcTan, (# - pt &) /@ pol, {1}], Range[Length[pol]]}]]];
  Select[edges, visibleQ[DeleteCases[edges, #], #, pt]&, 1][[1]]]];

visibleQ[blockers_, {p_,q_}, pt_] := {} == 
    Select[blockers,
      InsideTriangleQ[{p, q, pt}, #[[1]] ] ||
      InsideTriangleQ[{p, q, pt}, #[[2]] ] ||
      IntersectInteriorQ[#, {pt, p}] || 
      (MemberQ[#, p] && IntersectInteriorQ[#, {pt, q}]) &, 1];
    
Options[RandomPolygon] = {ShowSteps -> False, Smoothing -> False,
    ShowPoints -> True, InitialStep -> 1, SmoothingParameter -> 4, SmoothCurve -> False, ShowPolygon -> True}; 

NewPoint[{poly_, unused_}] := Module[{p, tri, s, n=Length[unused]},
    p = Select[Range[n],
    (tri = Append[poly[[AdditionalTriangle[poly,unused[[#]]]]],
     unused[[#]]];
    Length[s = Select[Delete[Range[n],#],
   InsideTriangleQ[tri, unused[[#]]]&,2]]≤1)&,1][[1]]; 
      If[Length[s]==1, p = s[[1]]];
      {Append[poly, unused[[p]]], Delete[unused, p]}];

RandomPolygonRaw[pts_] := Fold[(
   a = VisibleEdge[#1, #2][[1]]; 
   #1 /.{x___, a, y___} :> {x, a, #2, y}) &, 
     Take[#,2], Drop[#,2]]& [
   order = Nest[NewPoint,{Take[pts,2],Drop[pts,2]}, Length[pts]-2][[1]]];
  
RandomPolygon[n_Integer /; n >= 3, opts___] :=RandomPolygon[Array[Random[]&, {n, 2}], opts];

RandomPolygon[pts_List, opts___] := Module[
  {ans, ans1,smQ, m, smc, scQ, n=Length[pts]}, 
    {smQ, trQ, smc, scQ,ist, showQ, ptQ} = {Smoothing, ShowSteps, SmoothingParameter, 
     SmoothCurve,InitialStep, ShowPolygon, ShowPoints} /. {opts} /. Options[RandomPolygon];  
  ans = If[smQ, Function[p, Smooth[p, smc]], Identity][RandomPolygonRaw[pts]]; 
  If[smQ && !PolygonQ[ans], Message[RandomPolygon::badwarn]; Return[RandomPolygon[n, opts]]]; 
  If[scQ, Interpolation /@ 
    {Transpose[{Range[0, 1, 1/Length[ans]], First /@ extend[ans]}], 
     Transpose[{Range[0, 1, 1/Length[ans]], Last /@ extend[ans]}]},
  If[trQ, Do[
     pp = Take[order,j-1]; np = order[[j]]; 
     ans1=Select[ans, #==np||MemberQ[pp, #]&];
     pos = Position[ans1, np][[1,1]];
     pol = Sort[pp, Position[ans,#1][[1,1]]<Position[ans,#2][[1,1]]&];
Graphics[{
      {RGBColor[1,1,.5], Polygon[pol]},
      PointSize[0.02], RGBColor[0,0,1], Point/@ pp,
      {RGBColor[0,0,1],Polygon[ans1[[Mod[pos+{-1,0,1},Length[ans1],1]]]] }, Hue[0], Point /@ Take[order, {j,n}],
      {RGBColor[0,1,0],PointSize[.04],Point[np],
      Hue[0],
        PointSize[.02],Point[order[[j]]]},GrayLevel[0],Thickness[0.01],
      Line[extend[pp[[ConvexHull[pp]]]]]},
  PlotRange->{{-.10,1.1},{-.1,1.1}}, AspectRatio->1, Frame->True, FrameTicks->False],
     {j, Max[4,ist], Length[order]}];
  Graphics[{
     {RGBColor[1,1,.5], Polygon[ans],
     GrayLevel[0], Line[extend[ans[[ConvexHull[ans]]]]],
     PointSize[0.02], RGBColor[0,0,1], Point/@ ans}},
       PlotRange->{{-0.1,1.1},{-0.1,1.1}}, AspectRatio->1, Frame->True, FrameTicks->False]];

    If[showQ, Print@Graphics[{{RGBColor[1,1,0.5],Polygon[ans]},
      {GrayLevel[0], Line[extend[ans]]},
       PointSize[0.01], RGBColor[1,0,0],
      If[ptQ,Point /@ ans,{}]}, Sequence @@  FilterRules[{opts}, First /@ Options[Graphics]],
  PlotRange -> All,Frame -> True,FrameTicks ->None,
  DefaultColor -> RGBColor[0, 0, .2], Background -> RGBColor[0.2,0.2,1]]];  ans]]; 

Smooth[data_, c_Integer:4] := Flatten[Transpose[{
  (c - 1) data + RotateRight[data], (c - 1) data + RotateLeft[data]} / c], 1]; 

PolygonQ[x_] := Module[{ans = True, 
  edges = Partition[extend[x], 2, 1]}, 
  Do[If[IntersectInteriorQ[edges[[i]], edges[[j]]], 
    ans = False; Break[]], {i, 3, Length[x]}, {j, i - 2}]; 
  ans];

End[];
EndPackage[];

Computational Geometry

COA Code

.  Basic Computational Geometry

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;

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;

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]

Graphics[{{Thickness[0.01],Line[extend[poly]]},EdgeForm[Thickness[0.005]],({Hue[Random[],0.4,1],Polygon[poly[[#]]]}&)/@triangles}]

.  The Art Gallery Theorem

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]

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]

.  A Very Strange Room

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[[1]]/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[[1]]/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}]]},{topsty,outer[[6]]},
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[[2]]/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]);

SeidelRoom[0.37,{6,6,6},ViewPoint->{1.1,-2,2.2},TopFaceStyle->None,BoxFaceStyle->Opacity[.9],Epilog->{Text["x",{0.37,0.16}],Text["y",{0.75,0.28}]}]

SeidelRoom[0.37,{6,6,6},ViewPoint->{0.6,-0.7,1.5},TopFaceStyle->None]

SeidelRoom[0.37,{6,6,6},ViewPoint->{0,-3,0},
TopFaceStyle->Opacity[0.1], BoxFaceStyle->Opacity[0.3], DuctStyle->{Opacity[0.1]}]

blockingPolys =  Cases[ducts,_Polygon,∞];
guards = Union[Cases[{cuboid[{0,0,0}, {6,6,6}],ducts}, {_,_,_}, ∞]];
Length /@ {guards, blockingPolys}

fix[Polygon[{{2,3,1}, {2,3,5}, {4,3,5}, {4,3,1}}]]

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+t Q,-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}]

SeidelVerify[0.37,{6,6,6}]

.  More Euclid

poly=Table[{(Subscript[x, i]),(Subscript[y, i])},{i,5}];
Flatten[poly ({1,-1} Reverse[#]&)/@ RotateLeft[poly]]

SignedArea[poly_]:=(1/2) 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_}}]:=(({b c e-a d e-b c g+a d g-a f g+c f g+a e h-c e h,b c f-a d f-b f g+d f g-b c h+a d h+b e h-d e h})/(b e-d e-a f+c f-b g+d g+a h-c h))

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[{s=((Perimeter[triangle])/2)},(Sqrt[((Times@@(s-SideLengths[triangle]))/s)])]

Exradii[triangle_]:=(s=Semiperimeter[triangle];ss=SideLengths[triangle];N[(Sqrt[s {(((s-ss[[3]]) (s-ss[[2]]))/(s-ss[[1]])),(((s-ss[[3]]) (s-ss[[1]]))/(s-ss[[2]])),(((s-ss[[1]]) (s-ss[[2]]))/(s-ss[[3]]))}])]);
Circumradius[triangle_]:=(Total[Exradii[triangle]]-Inradius[triangle])/4;
AreaHeron[triangle_]:=(s=Semiperimeter[triangle];N[(Sqrt[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_}]:=LineIntersection[PerpSegment[{((b+c)/2),c}],PerpSegment[{((a+b)/2),b}]];
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)}}]

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[((H+O)/2)]},{PointSize[0.025],Blue,Point[midpoints],(Point[((H+#1)/2)]&)/@tri,Point[Pedal[tri]]}},Frame->True,FrameTicks->None,Background->RGBColor[1,1,0.6]]

WittenbauerParallellogram[quad_]:=Module[{trisect},
trisect[{p_,q_}]:={((2 p)/3)+(q/3),(p/3)+((2 q)/3)};Apply[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]]}

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]},
{x,y}/.Last[Quiet[FindMinimum[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}]