3

WRI confirmed the bugs in the quality options in DiscretizeRegion on 14/Nov/2022


I'm trying to plot the region defined by the following inequalities in 3D:

Sqrt[x^2+y^2-z^2]+Sqrt[-x^2+y^2+z^2]+Sqrt[x^2-y^2+z^2]<=Sqrt[2]&&0<=x<=1&&0<=y<=1&&0<=z<=1

Adopting the parameterization in this answer, I used the following code

Clear[sol, expr, reg, meshreg];
sol = SolveValues[{u^2 == x^2 + y^2 - z^2, v^2 == -x^2 + y^2 + z^2, 
    w^2 == x^2 - y^2 + z^2}, {x, y, z}];
expr = sol // Last;
reg = ParametricRegion[{expr, 
    u + v + w <= Sqrt[2]}, {{u, 0, 2}, {v, 0, 2}, {w, 0, 2}}];
Region[reg]

The output figure does not have smooth surfaces:

plot with the surfaces being not smooth

I tried to use DiscretizeRegion to get a smoother surface by specifying MaxCellMeasure, MeshQualityGoal, and AccuracyGoal. But none of them changed the smoothness of the surface. For example:

meshreg = 
  DiscretizeRegion[reg, MaxCellMeasure -> 0.001, 
   AccuracyGoal -> Infinity, MeshQualityGoal -> "Maximal"];
Graphics3D[{EdgeForm[], FaceForm[{Red, Opacity[.5]}], meshreg}, 
 Axes -> True]

produces:

enter image description here

with an error message:

DiscretizeRegion::drtol: Tolerance requested by the AccuracyGoal and PrecisionGoal options is too small to be achieved. Increasing to absolute tolerance 2.5809568279517847`*^-8

Ideally, I would like to have perfectly smooth surfaces (up to human eye precision..)

How to obtain it? Thank you!

Gustavo Delfino
  • 8,348
  • 1
  • 28
  • 58
YYing
  • 125
  • 6

1 Answers1

4
  • I also don't know why MaxCellMeasure -> 0.001, AccuracyGoal -> 5, MeshQualityGoal -> "Maximal" make no smooth effect.

  • Here we use the same methods in my previous answer,that is, at first deform the plot of RegionPlot3D and then using DiscretizeGraphics.

  • It seems that RegionPlot3D can not directly handle the complex variable function Sqrt. We can test this by RegionPlot3D[ And @@ {0 <= Sqrt[x^2 + y^2 - z^2] + Sqrt[-x^2 + y^2 + z^2] + Sqrt[x^2 - y^2 + z^2] <= Sqrt[2], x^2 + y^2 - z^2 >= 0, -x^2 + y^2 + z^2 >= 0, x^2 - y^2 + z^2 >= 0}, {x, 0, 1}, {y, 0, 1}, {z, 0, 1}, PlotPoints -> 80, MaxRecursion -> 4]

Clear[sol, expr, plot,newplot, reg];
sol = SolveValues[{u^2 == x^2 + y^2 - z^2, v^2 == -x^2 + y^2 + z^2, 
    w^2 == x^2 - y^2 + z^2}, {x, y, z}];
expr = sol // Last;
plot = RegionPlot3D[
    u + v + w <= Sqrt[2], {u, 0, Sqrt[2]}, {v, 0, Sqrt[2]}, {w, 0, 
     Sqrt[2]}, MaxRecursion -> 4, 
    PlotPoints -> 80]
newplot=plot /. {u_Real, v_Real, w_Real} -> expr;
reg =newplot // DiscretizeGraphics

enter image description here

  • The case when -1<=x<=1,-1<=y<=1,-1<=z<=1.
Clear[sol, plot];
sol = SolveValues[{u^2 == x^2 + y^2 - z^2, v^2 == -x^2 + y^2 + z^2, 
    w^2 == x^2 - y^2 + z^2}, {x, y, z}];
plot = RegionPlot3D[
   u + v + w <= Sqrt[2], {u, 0, Sqrt[2]}, {v, 0, Sqrt[2]}, {w, 0, 
    Sqrt[2]}, MaxRecursion -> 4, PlotPoints -> 80, 
   PlotRange -> Sqrt[2]];
DiscretizeGraphics /@ (plot /. {u_Real, v_Real, w_Real} -> # & /@ 
    sol) // RegionUnion

enter image description here

cvgmt
  • 72,231
  • 4
  • 75
  • 133