Mark all Points in a triangle that have a certain property

Question

I want to mark all points inside of a triangle having the following property:

I can center a line segment of length $c$ on the point so that the line segment is entirely contained inside the triangle.

See the figure below that I created by hand. The gray points have the property because I can center such a line segment there. Exemplary line segments are depicted in black.

Is there any way to produce a plot that visualizes this property?

Actually, I do not know how to start here.

Answer 1

Edit

Clear["Global`*"];
pts = {{0., 0.}, {10., 0.}, {5, 8}, {1, 6}} // Map@N // 
   Rationalize[#, 0] &;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} ∈ reg && {x2, y2} ∈ 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80, 
   MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] := 
  Module[{instance, vector}, 
   instance = 
    FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
       u^2 + v^2 >= (L/2)^2}, {u, v}];
   vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
   Show[plot, 
    Graphics[{Red, AbsolutePointSize[5], Point[pt], 
       Arrow[{pt, pt - L/2 Normalize@{u, v}}], 
       Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector, 
     PlotRange -> {{0, 10}, {0, 10}}]]];
Manipulate[
 fig[pt], {{pt, pt0}, Locator, 
  TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]

Original

• When L=8.

Clear[pts, reg, L, conditions, results];
pts = {{0, 0}, {10, 0}, {5, 9.}} // Rationalize;
reg = Triangle[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {{x1, y1} ∈ reg, {x2, y2} ∈ 
     reg, {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= 
     L^2}, {x == (x1 + x2)/2, y == (y1 + y2)/2}];
results = Resolve[conditions, Reals] // FullSimplify;
Show[Graphics[{EdgeForm[Red], FaceForm[], reg}], 
 RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 50, 
  MaxRecursion -> 4]]

• When L=5.

• We can test convex polygon.

Clear[pts, reg, L, conditions, results];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 4.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} ∈ reg && {x2, y2} ∈ 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
Show[Graphics[{EdgeForm[Red], FaceForm[], reg}], 
 RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 50, 
  MaxRecursion -> 2]]

• Or random convex polygon.

SeedRandom[10];
reg = RandomPolygon[{"Convex", 5}, DataRange -> {0, 10}];
reg = Polygon@Rationalize[MeshCoordinates[reg], 0]; 
L = 10.0 // Rationalize;
conditions = 
  Exists[{x1, y1, x2, 
    y2}, {x1, y1} ∈ reg && {x2, y2} ∈ 
     reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2, 
   x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
Show[Graphics[{EdgeForm[Red], FaceForm[], reg}], 
 RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 50, 
  MaxRecursion -> 2]]

Answer 2

If we phrase out the problem as "for each point {x, y} in the sought region there exists a line passing through it on which both points at the distance l/2 from {x, y} are inside the triangle", the problem is basically already solved with use of RegionMember, Exists and the Pythagorean theorem.

Pretty similar to the @cvgmt's answer, but anyway:

With[
 {rt = RegionMember[RegularPolygon[3]],
  l = 29/20},
 Resolve[
   Exists[{u, v},
    u^2 + v^2 == (l/2)^2,
    rt[{x, y} + {u, v}] && rt[{x, y} - {u, v}]],
   Reals] //
  RegionPlot[{rt[{x, y}], #},
    {x, -1, 1}, {y, -1/2, 1},
    PlotPoints -> 200, AspectRatio -> Automatic] &]

This of course relies on the fact that triangles are convex. This solution also extends to polygons and other regions that are convex, but Resolve'ing the equations is certainly easiest for plain old triangles.

---

EDIT:

It can be also shown how the hole in the middle is formed by tracing midpoints of line segments whose both ends reside on the triangle boundary:

With[
  {poly = RegularPolygon[3],
   l = 29/20},
  With[
   {background =
     With[{rt = RegionMember[poly]},
      Resolve[
        Exists[{u, v},
         u^2 + v^2 == (l/2)^2,
         rt[{x, y} + {u, v}] && rt[{x, y} - {u, v}]],
        Reals] //
       RegionPlot[{rt[{x, y}], #},
         {x, -1, 1}, {y, -1/2, 1},
         PlotPoints -> 200, AspectRatio -> Automatic] &]},
   With[
    {boundary = RegionBoundary[poly]},
    Table[With[
      {o = RegionIntersection[boundary,
          Line[{{0, 0}, {Sin[a], -Cos[a]}}]][[1, 1]]},
      Show[
       {background,
        Graphics[{Line[{o, #}],
            Point[{o, Midpoint[{o, #}], #}]} & /@
          RegionIntersection[Circle[o, l], boundary][[1]]]}]],
     {a, 0., 2 Pi, Pi/60}]]]] // ListAnimate