Projection of 3D Exclusion Lines to 2D

Question

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?

Answer 1

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], 
 PlotRangePadding -> -.05]

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], 
 PlotRangePadding -> -.05]

Answer 2

• 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}}]

Answer 3

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