这里提供一种Mathematica的解决方案。该方法涉及查找线段交点、线段片段以及分区,同时跟踪连接到哪些线段的点。
y[1] = 5 x + 3;
y[2] = 90 x + 7;
y[3] = -30 x + 28;
y[4] = 60 x + 2;
findpoints[n_] := Module[{},
xp = DeleteCases[{{First[#1], First[#2]},
Solve[Last[#1] == Last[#2], x]} & @@@
DeleteCases[
Tuples[Array[{#, y[#]} &, n], 2],
{{x_, _}, {x_, _}}], {_, {}}];
yp = y[#[[1, 1]]] /. #[[2, 1]] & /@ xp;
MapThread[{#1, {#2, #3}} &,
{xp[[All, 1]], xp[[All, 2, 1, 1, 2]], yp}]]
xyp = findpoints[4];
{xmin, xmax} = Through[{Min, Max}@
xyp[[All, 2, 1]]] + {-0.7, 0.7};
outers = Flatten[Array[Function[n,
MapThread[List[{{n, 0}, {##}}] &,
{{xmin, xmax}, y[n] /.
List /@ Thread[x -> {xmin, xmax}]}]], 4], 2];
xyp = Join[outers, xyp];
findlines[p_] := Module[{},
pt = DeleteCases[
Cases[xyp, {{p[[1, 1]], _}, _}], p];
n = First@Cases[pt,
{_, First@Nearest[Last /@ pt, Last[p]]}];
{{First[p], First[n]}, {Last[p], Last[n]}}]
lines = Map[findlines, xyp];
(* boundary lines *)
{ymin, ymax} = Through[{Min, Max}@outers[[All, 2, 2]]];
{lbtm, rbtm, ltop, rtop} = {{xmin, ymin},
{xmax, ymin}, {xmin, ymax}, {xmax, ymax}};
xminlines = Partition[Union@Join[{ymin, ymax},
Cases[xyp, {_, {xmin, _}}][[All, 2, 2]]], 2, 1] /.
x_Real :> {xmin, x};
xmaxlines = Partition[Union@Join[{ymin, ymax},
Cases[xyp, {_, {xmax, _}}][[All, 2, 2]]], 2, 1] /.
x_Real :> {xmax, x};
lines2 = Join[Last /@ lines, xminlines, xmaxlines,
{{lbtm, rbtm}}, {{ltop, rtop}}];
ListLinePlot[lines2]
![enter image description here](https://istack.dev59.com/C0tIJ.webp)
(* add vertex points *)
xyp2 = Join[xyp, {
{{SortBy[Cases[outers, {_, {xmin, _}}],
Last][[-1, 1, 1]], -1}, ltop},
{{SortBy[Cases[outers, {_, {xmax, _}}],
Last][[-1, 1, 1]], -1}, rtop},
{{SortBy[Cases[outers, {_, {xmin, _}}],
Last][[1, 1, 1]], -1}, lbtm},
{{SortBy[Cases[outers, {_, {xmax, _}}],
Last][[1, 1, 1]], -1}, rbtm}}];
anglecalc[u_, v_] := Mod[(ArcTan @@ u) - (ArcTan @@ v), 2 π]
getlineangles[] := Module[{},
(* find the angles from current line
to all the linked lines *)
angle = Map[
anglecalc[{c, d} - {g, h}, # - {g, h}] &,
union = DeleteCases[Union@Join[
Last /@ Cases[lines2, {{g, h}, _}],
First /@ Cases[lines2, {_, {g, h}}]],
{c, d}]];
Sort[Transpose[{N@angle, union}]]]
getpolygon[pt_, dir_] := Module[{},
Clear[p];
p[n = 1] = {{a, b}, {c, d}} = pt;
(* find the angles from vector (0, -1) or (0, 1)
to all the linked lines *)
angle = Map[anglecalc[If[dir == 1, {0, -1}, {0, 1}], # - {c, d}] &,
union = Union@Join[
Last /@ Cases[lines2, {{c, d}, _}],
First /@ Cases[lines2, {_, {c, d}}]]];
lineangles = Sort[Transpose[{N@angle, union}]];
(* next point *)
p[++n] = {{e, f}, {g, h}} = First@
Cases[xyp2, {_, lineangles[[1, 2]]}];
While[Last[p[n]] != Last[p[1]],
lineangles = getlineangles[];
(* reset first point *)
{{a, b}, {c, d}} = {{e, f}, {g, h}};
(* next point *)
p[++n] = {{e, f}, {g, h}} = First@
Cases[xyp2, {_, lineangles[[1, 2]]}]];
Array[p, n]]
len = Length[xyp];
polygons = Join[Array[(poly[#] = getpolygon[xyp[[#]], 1]) &, len],
Array[(poly[# + len] = getpolygon[xyp[[#]], 2]) &, len]];
graphics = DeleteDuplicates /@ Array[Last /@ poly[#] &, 2 len];
sortedgraphics = Sort /@ graphics;
positions = Map[Position[sortedgraphics, #] &,
DeleteDuplicates[sortedgraphics]][[All, 1, 1]];
unique = poly /@ positions;
poly2 = unique[[All, All, 2]];
poly2 = Delete[poly2,
Array[If[Length[Intersection[poly2[[#]],
Last /@ Take[xyp2, -4]]] == 4, {#}, Nothing] &,
Length[poly2]]];
len2 = Length[poly2];
poly3 = Polygon /@ Rest /@ poly2;
Array[(centroid[#] = RegionCentroid[poly3[[#]]]) &, len2];
Show[Graphics[Array[{ColorData[24][#],
poly3[[#]]} &, len2], AspectRatio -> 1/GoldenRatio],
Graphics[Array[Text[#, centroid[#]] &, len2]]]
![enter image description here](https://istack.dev59.com/JI5KB.webp)
unique2 = Extract[unique,
Flatten[Position[unique[[All, All, 2]],
makerelations[oneconnection_, areanumber_] := Module[{i},
If[Intersection @@ oneconnection == {} ||
(i = First[Intersection @@ oneconnection]) < 1,
Nothing,
centroidx = First[centroid[areanumber]];
linepos = y[i] /. x -> centroidx;
relation = If[linepos < Last[centroid[areanumber]],
" >= ", " < "];
string = StringJoin["y", relation, ToString[y[i]]]]]
findrelations[n_] := Module[{},
areanumber = n;
onearea = unique2[[areanumber]];
connections = Partition[First /@ onearea, 2, 1];
strings = DeleteDuplicates@
Map[makerelations[
StringJoin["Area ", ToString[areanumber],
If[areanumber > 9, ": ", ": "],
StringRiffle[strings, " &&\n "]]]
Show[Plot[Evaluate@Array[y, 4], {x, -1, 1.5},
PlotLegends -> "Expressions", Axes -> None],
Graphics[Array[Text[
Column@Array[findrelations, len2]
![enter image description here](https://istack.dev59.com/RrWvQ.webp)
Area 1: y >= 28 - 30 x &&
y < 3 + 5 x
Area 2: y >= 2 + 60 x &&
y >= 28 - 30 x &&
y < 7 + 90 x
Area 3: y < 28 - 30 x &&
y < 7 + 90 x &&
y < 2 + 60 x &&
y < 3 + 5 x
Area 4: y >= 3 + 5 x &&
y >= 28 - 30 x &&
y < 2 + 60 x
Area 5: y < 3 + 5 x &&
y >= 2 + 60 x &&
y < 7 + 90 x
Area 6: y < 28 - 30 x &&
y >= 2 + 60 x &&
y >= 3 + 5 x &&
y < 7 + 90 x
Area 7: y < 28 - 30 x &&
y >= 3 + 5 x &&
y < 2 + 60 x
Area 8: y < 28 - 30 x &&
y >= 7 + 90 x &&
y >= 3 + 5 x
Area 9: y < 2 + 60 x &&
y >= 7 + 90 x
Area 10: y >= 28 - 30 x &&
y >= 7 + 90 x
Area 11: y < 3 + 5 x &&
y >= 7 + 90 x &&
y >= 2 + 60 x