Converting implicit region to line

Question

How to convert ImplicitRegion to Line, InfiniteLine or HalfLine?

I did it manually:

ir = ImplicitRegion[#, {x, y}] & /@ {{x <= 1/3 && 
      y == -x}, {x == 1/3 && y <= -(1/3)}, {1/3 <= x <= 1/2 && 
      y == -1 + 2 x}, {x <= 1/2 && y == 1 - 2 x}, {x >= 1/2 && 
      y == 0}, {2 x + 3 y == 1}};

line = {HalfLine[{{1/3, -1/3}, {0, 0}}], 
   HalfLine[{{1/3, -1/3}, {1/3, -1}}], Line[{{1/3, -1/3}, {1/2, 0}}], 
   HalfLine[{{1/2, 0}, {0, 1}}], HalfLine[{{1/2, 0}, {1, 0}}], 
   InfiniteLine[{{0, 1/3}, {1, -1/3}}]};

RegionEqual @@@ Transpose[{ir, line}]

Show[Region[#, PlotRange -> 3] & /@ ir, 
Graphics[{Dashed, line}, PlotRange -> 3]]

---

{True, True, True, True, True, True}

Notice that the third True can be sometimes False due to this bug in RegionEqual but True is the correct result.

Also notice that definition of HalfLine or InfiniteLine are not unique, I will accept any form.

There is also:

RegionConvert[HalfLine[{{1/3, -1/3}, {0, 0}}], "Implicit"]

---

ImplicitRegion[X + Y == 0 && X <= 2/3 + Y, {X, Y}]

But I think it only converts lines to implicit region but not the other way.

Answer 1

Edit

Clear["Global`*"];
transform[reg_] := 
  Module[{pair, type},
 {pt1, pt2} = {{x1, y1}, {x2, y2}} /. 
     FindInstance[{{x1, y1} ∈ reg, {x2, y2} ∈ 
         reg, {x1, y1} != {x2, y2}}, {x1, y1, x2, y2}][[1]];
   type = 
    First@RegionBounds[
      ImplicitRegion[pt1 + t     (pt2 - pt1) ∈ reg, {t}]];
   ReplaceAll[type
    , {{-∞, a_} /; a ∈ Reals :> 
      HalfLine[pt1 + t     (pt2 - pt1) /. t -> a, 
       Sign[-∞]    (pt2 - pt1)]
     , {a_, ∞} /; a ∈ Reals :> 
      HalfLine[pt1 + t     (pt2 - pt1) /. t -> a, 
       Sign[∞]    (pt2 - pt1)]
     , {-∞, ∞} :> 
      InfiniteLine[pt1 + t     (pt2 - pt1) /. t -> 1, 
       Sign[∞]    (pt2 - pt1)]
     , {a_, b_} /; a ∈ Reals && b ∈ Reals :> 
      Line[{pt1 + t     (pt2 - pt1) /. t -> a, 
        pt1 + t     (pt2 - pt1) /. t -> b}
       ]}]];
ir = ImplicitRegion[#, {x, y}] & /@ {{x <= 1/3 && 
      y == -x}, {x == 1/3 && y <= -(1/3)}, {1/3 <= x <= 1/2 && 
      y == -1 + 2     x}, {x <= 1/2 && y == 1 - 2     x}, {x >= 1/2 &&
       y == 0}, {2     x + 3     y == 1}};
result = transform /@ ir
Graphics[result, PlotRange -> 2]

{HalfLine[{1/3, -(1/3)}, {-1, 1}], HalfLine[{1/3, -(1/3)}, {0, -1}], Line[{{1/3, -(1/3)}, {1/2, 0}}], HalfLine[{1/2, 0}, {-1, 2}], HalfLine[{1/2, 0}, {1, 0}], InfiniteLine[{1, -(1/3)}, {1, -(2/3)}]}

Original

Only one way for Line,using RegionBounds.

reg1 = ImplicitRegion[1/3 <= x <= 1/2 && y == -1 + 2  x, {x, y}];
(* line1=Line[{{MinValue[x,{x,y}∈reg],MinValue[y,{x,y}\
∈reg]},{MaxValue[x,{x,y}∈reg],MaxValue[y,{x,y}\
∈reg]}}]; *)
line2 = Line@Transpose@RegionBounds[reg1]
Graphics[{DiscretizeRegion@reg1, Opacity[.2], Pink, 
  AbsoluteThickness[20], line2}]

Transpose /@ RegionBounds /@ ir

{{{-∞, -(1/3)}, {1/3, ∞}}, {{1/ 3, -∞}, {1/3, -(1/3)}}, {{1/3, -(1/3)}, {1/2, 0}}, {{-∞, 0}, {1/2, ∞}}, {{1/2, 0}, {∞, 0}}, {{-∞, -∞}, {∞, ∞}}}

• Need to be updated.

ir = ImplicitRegion[#, {x, y}] & /@ {{x <= 1/3 && 
      y == -x}, {x == 1/3 && y <= -(1/3)}, {1/3 <= x <= 1/2 && 
      y == -1 + 2     x}, {x <= 1/2 && y == 1 - 2     x}, {x >= 1/2 &&
       y == 0}, {2     x + 3     y == 1}};
pairs = {{x1, y1}, {x2, y2}} /. 
     FindInstance[{{x1, y1} ∈ #, {x2, y2} ∈ #, {x1, 
          y1} != {x2, y2}}, {x1, y1, x2, y2}][[1]] & /@ ir;
MapThread[
 First@RegionBounds[
    ImplicitRegion[#[[1]] + 
       t  (#[[2]] - #[[1]]) ∈ #2, {t}]] &, {pairs, ir}]

{{-∞, 1}, {-∞, 1}, {0, 1}, {-∞, 1}, {0, ∞}, {-∞, ∞}}