2
$\begingroup$

I'm having trouble getting RegionPlot3D and ContourPlot3D to work properly.

I have a classifier function that maps points in the unit cube to labels in the set {1,2,3}:

classifier[x_] := (x // Prepend[1] // 
 Dot[{{-257, -240, -46, 477}, {-359, -222, 192, 461}, {0, 0, 0, 0}}, #] & //
 Ordering[#, -1] & // First)

Here are 3 places in the feature space that have different labels:

classifier[{.1, .1, .7}] (* returns label 1 *)
classifier[{.5, .9, .7}] (* returns label 2 *)
classifier[{.5, .1, .7}] (* returns label 3 *)

I would like to color the unit cube (including the interior) with 3 colors to show where the classifier maps which values. Here is a simple way to do it.

Graphics3D[{Opacity[.5], PointSize[.05], 
  Table[{Switch[classifier[{x, y, z}], 1, Red, 2, Green, 3, Blue], 
    Point[{x, y, z}]}, {x, 0, 1, .1}, {y, 0, 1, .1}, {z, 0, 1, .1}]}]

enter image description here

However, it would be less visually distracting to have the regions be solid homogeneous colors. However, RegionPlot3D doesn't produce the colored regions. It instead produces one completely full plot and two blank plots:

Table[
 RegionPlot3D[
  i - .5 < classifier[{x, y, z}] < i + .5,
  {x, 0, 1}, {y, 0, 1}, {z, 0, 1},
  PlotLabel -> "region where classifier[x] near " <> ToString@i,
  PlotPoints -> {1000, Automatic, Automatic}
  ],{i, 3}]

enter image description here

I tried using ContourPlot3D to show the boundaries between the decision regions. However, ContourPlot3D only produces a coarse division when PerformanceGoal -> "Speed" and produces nothing for "Quality":

Table[
 ContourPlot3D[
  classifier[{x, y, z}],
  {x, 0, 1}, {y, 0, 1}, {z, 0, 1},
  Contours -> {1, 2, 3},
  PerformanceGoal -> pg,
  PlotLabel -> pg
  ], {pg, {Automatic, "Speed", "Quality"}}]

enter image description here

I also tried contourRegionPlot3D as mentioned here, with no luck.

Is there some simple option I'm missing?

$\endgroup$

2 Answers 2

2
$\begingroup$
  • We avoid using Ordering[#,-1] in RegionPlot3D or ContourPlot3D since they seems could not return the Boolean value.
  • We use Max[{a,b,c}]=a, Max[{a,b,c}]=b,Max[{a,b,c}]=c respectively.
F[x_, y_, 
   z_] := {{-257, -240, -46, 477}, {-359, -222, 192, 461}, {0, 0, 0, 
     0}} . {1, x, y, z};
MapThread[
 RegionPlot3D[#2, {x, 0, 1}, {y, 0, 1}, {z, 0, 1}, PlotStyle -> #1, 
   Mesh -> None, Boxed -> False, 
   Lighting -> {{"Ambient", White}}] &, {{Red, Green, Blue}, 
  Thread[Max[F[x, y, z]] == F[x, y, z]]}]
% // Show

enter image description here

Edit

  • Verify my conjecture: The three regions are convex polyhedrons.
Clear["Global`*"];
{f, g, h} = {{-257, -240, -46, 477}, {-359, -222, 192, 461}, {0, 0, 0,
      0}} . {1, x, y, z};
toSpace = 
  HalfSpace[Coefficient[#, {x, y, z}], 
    Coefficient[#, {x, y, z}] . {x, y, z} - #] &;
reg1 = RegionIntersection[toSpace[g - f], toSpace[h - f]];
reg2 = RegionIntersection[toSpace[f - g], toSpace[h - g]];
reg3 = RegionIntersection[toSpace[f - h], toSpace[g - h]];
{reg1, reg2, reg3} = 
  RegionIntersection[#, Cuboid[]] & /@ {reg1, reg2, reg3};
ConvexRegionQ /@ {reg1, reg2, reg3}
{Region[Style[reg1, Red]], Region[Style[reg2, Green]], 
 Region[Style[reg3, Blue]]}
% // Show

{True, True, True}

enter image description here

$\endgroup$
1
$\begingroup$

Just a variant of @cvgmt answer (which I voted for)

Using:

f[x_, y_, z_] := {{-257, -240, -46, 477}, {-359, -222, 192, 461}, {0, 0, 0, 
    0}} . {1, x, y, z}

Using Reduce to define inequalities:

regf[n_, col_] := 
 Module[{r = 
    ImplicitRegion[
     Reduce[{Max[f[x, y, z]] - f[x, y, z][[n]] == 0, 
        0 < x < 1 && 0 < y < 1 && 0 < z < 1}, {x, y, z}] // 
      FullSimplify, {{x, 0, 1}, {y, 0, 1}, {z, 0, 1}}]},
  Region[Style[r, col]]]

Visualizing:

Show @@ MapIndexed[
  regf[#2[[1]], #1] &, {{Red, Opacity[0.4]}, {Green, 
    Opacity[0.4]}, {Blue, Opacity[0.4]}}]

enter image description here

$\endgroup$
1
  • $\begingroup$ I have a conjecture that these are three convex polyhedrons. If we can get the vertex about the three polyhedrons, we will get the perfect solids. $\endgroup$ Commented Feb 2 at 9:48

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.