# Projection of 3D Exclusion Lines to 2D

I have a bunch of polynomials, which I draw them using this script

Plot3D[Min[3 x + 2 y, 2 y + 2 x + 1, y + 2 x, 2 y + 1, 1 ], {x, -3,
3}, {y, -3, 3}, Mesh -> Full,
AxesLabel -> {Style["x"], Style["y"], Style["v"]},
ExclusionsStyle -> Black]

I would like to project the 3D black lines to a 2D xy plane and keep those lines. How can I do this generically without using the ContourPlot?

• With ExclusionsStyle -> Black what appear as black lines are actually many small polygons covering "interiors of excluded subregions".
– kglr
Commented Jan 31 at 10:34
• Try Plot3D[Min[3 x + 2 y, 2 y + 2 x + 1, y + 2 x, 2 y + 1, 1], {x, -3, 3}, {y, -3, 3}, Mesh -> None, BoundaryStyle -> None, PlotStyle -> None, AxesLabel -> {Style["x"], Style["y"], Style["v"]}, ExclusionsStyle -> Directive[EdgeForm[{AbsoluteThickness[1/2], Green}], FaceForm[Red]]] and
– kglr
Commented Jan 31 at 10:34
• Plot3D[Min[3 x + 2 y, 2 y + 2 x + 1, y + 2 x, 2 y + 1, 1], {x, -3, 3}, {y, -3, 3}, Mesh -> None, BoundaryStyle -> None, PlotStyle -> None, AxesLabel -> {Style["x"], Style["y"], Style["v"]}, ExclusionsStyle -> {FaceForm[], Directive[Thin, Cyan]}] to see how excluded regions are rendered for ExclusionsStyle -> styleregion and ExclusionsStyle -> {styleregion, styleboundary}
– kglr
Commented Jan 31 at 10:37
• @kglr, you are indeed correct, and this was the reason for having many small polygons when using Contourplots. If you could put these two helpful comments into an answer with a 2d projection, I can accept it so that this question is set as solved. Commented Jan 31 at 10:51
– kglr
Commented Jan 31 at 11:26

ExclusionsStyle >> Details

So... with ExclusionsStyle -> Black what appear as black lines are actually many small polygons covering "interiors of excluded subregions".

To see how excluded regions are rendered with settings ExclusionsStyle -> styleregion and ExclusionsStyle -> {styleregion, styleboundary} in more detail, set Mesh and PlotStyle to None and use PlotRange to zoom in a smaller portion of the surface.

Plot3D[Min[3   x + 2   y, 2   y + 2   x + 1, y + 2   x, 2   y + 1, 1],
{x, -3, 3}, {y, -3, 3},
PlotRange -> {{0, .75}, {-.5, .5}}, ImageSize -> Large,
Mesh -> None, BoundaryStyle -> None, PlotStyle -> None,
ExclusionsStyle -> Directive[EdgeForm[{Thin, Green}], FaceForm[Red]]]

Plot3D[Min[3   x + 2   y, 2   y + 2   x + 1, y + 2   x, 2   y + 1, 1],
{x, -3, 3}, {y, -3, 3},
PlotRange -> {{0, .75}, {-.5, .5}}, ImageSize -> Large,
Mesh -> None, BoundaryStyle -> None, PlotStyle -> None,
ExclusionsStyle -> {FaceForm[], Directive[Thin, Blue]}]

To get 2D lines separating various regions of the surface, one possible way is to use RegionPlot as follows:

functions = {3  x + 2  y, 2  y + 2  x + 1, y + 2  x, 2  y + 1, 1};

### RegionPlot

fiveRegions = Map[# <= Min[functions] &] @ functions;

RegionPlot[fiveRegions, {x, -3, 3}, {y, -3, 3},
PlotStyle -> {Red, Green, Blue, Orange, Cyan},
PlotLegends -> Range[5],
BoundaryStyle -> Directive[AbsoluteThickness[2], Black]]

To get just the lines use PlotStyle -> None and to get rid of the outer boundary use a negative number for PlotRangePadding:

RegionPlot[fiveRegions, {x, -3, 3}, {y, -3, 3},
PlotStyle -> None,
BoundaryStyle -> Directive[AbsoluteThickness[1], Black],

### Plot3D + ConditionalExpression

conditionalExpressions =
Map[ConditionalExpression[#, # <= Min[functions]] &]@functions;

plot3d = Plot3D[conditionalExpressions, {x, -3, 3}, {y, -3, 3},
Mesh -> None, Exclusions -> None, BoundaryStyle -> Black]

Extract lines and remove the last columns of coordinates

Graphics[
Cases[Normal[plot3d], Line[x_] :> Line[x[[All, ;; 2]]], All],

• (+1) Thank you very much for providing further information. Commented Jan 31 at 11:30
• Do you mean this result?

• Since z==Min[3 x + 2 y, 2 y + 2 x + 1, y + 2 x, 2 y + 1, 1 ] equivalence to z<=3x+2y+0,z<=2y+2x+1,... etc, that is {-3,-2,1}.{x,y,z}<=0, {-2,-2,1}.{x,y,z}<=1, ...,we use HalfSpace[{-3, -2, 1}, 0],HalfSpace[{-2, -2, 1}, 1],... to express such regions etc. and found their intersection.

reg = BoundaryDiscretizeGraphics[#,
PlotRange -> {{-4, 4}, {-4, 4}, {-20,
2}}] & /@ {HalfSpace[{-3, -2, 1}, 0],
HalfSpace[{-2, -2, 1}, 1], HalfSpace[{-2, -1, 1}, 0],
HalfSpace[{0, -2, 1}, 1], HalfSpace[{0, 0, 1}, 1]} //
RegionIntersection;
Graphics[MeshPrimitives[reg, 1] /. {x_, y_, z_} :> {x, y},
PlotRange -> {{-3, 3}, {-3, 3}}]

• (+1) This is a very nice idea. Thanks for sharing that. Commented Jan 31 at 11:31
Min[3 x + 2 y, 2 y + 2 x + 1, y + 2 x, 2 y + 1, 1] == #1 == #2 & @@@
Subsets[{3 x + 2 y, 2 y + 2 x + 1, y + 2 x, 2 y + 1, 1}, {2}];
Reduce[Or @@ %, {x, y}]
Region[ImplicitRegion[%, {x, y}], Axes -> True,
PlotRange -> {{-3, 3}, {-3, 3}}, BaseStyle -> {Red, Thick},
TicksStyle -> Black]

(x < 1/3 && (y == -x || y == 1 - 2 x)) ||
(x == 1/3 && (y <= -(1/3) || y == 1/3)) ||
(1/3 < x < 1/2 && (y == -1 + 2 x || y == 1 - 2 x)) ||
(x >= 1/2 && y == 0)

Definitions of the five lines/infinite half-lines:

Min[3 x + 2 y, 2 y + 2 x + 1, y + 2 x, 2 y + 1, 1] == #1 == #2 & @@@
Subsets[{3 x + 2 y, 2 y + 2 x + 1, y + 2 x, 2 y + 1, 1}, {2}];
Reduce[#, {x, y}] & /@ % /. False -> Nothing // Column

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
• (+1)Thank you for sharing this answer. It is insightful. Commented Jan 31 at 12:44