Skip to main content

regions - Is DiscretizeRegion not yet ready ro discretize 3D-solids?


In the DiscretizeRegion documentation:



The region reg can be anything that is ConstantRegionQ and RegionEmbeddingDimension less than or equal to 3.




With DiscretizeRegion there could be an easy way to check volume calculations. First, I do it with a test region:


reg3D = ImplicitRegion[x - 2 < y < x - 1 && 0 < z < (x + y)/(x - y),
{{x, 0, 2}, {y, -2, 0}, {z, 0, 3}}];
{RegionEmbeddingDimension @ reg3D, ConstantRegionQ @ reg3D}
{3, True}

{Volume @ reg3D // N, Volume @ DiscretizeRegion[reg3D]}
{0.375, 0.373509}


Now my problem region:


reg3D = ImplicitRegion[x - 2 < y < x - 1 && 0 < z < Exp[(x + y)/(x - y)],
{{x, 0, 2}, {y, -2, 0}, {z, 0, 3}}];
{RegionEmbeddingDimension @ reg3D, ConstantRegionQ @ reg3D}
{3, True}

{vol = Volume @ reg3D, vol // N}
{(3 (-1 + E^2))/(4 E), 1.7628}

Volume @ DiscretizeRegion[reg3D];



DiscretizeRegion::drf: DiscretizeRegion was unable to discretize the region ImplicitRegion[<<2>>]. >>



Error; yet another method:


g = RegionPlot3D[reg3D, PlotPoints -> 100]

region


discreteReg = DiscretizeGraphics[g // Normal] // Quiet;
{RegionDimension @ discreteReg, RegionEmbeddingDimension @ discreteReg}

{2, 3}

I am now able to obtain the area:


Area @ discreteReg
12.5795

but not the volume, it fails once again.


<< NDSolve`FEM`
ToElementMesh @ discreteReg



MeshRegion::dgcell: The cell Polygon[{41,11121,408,403}] is degenerate. >> ToBoundaryMesh::femtemnm: A mesh could not be generated. >>



I didn't get much further! What can I do?



Answer



Based on a discussion with the developers, the new default "MarchingCells" method (in version 10.2 or later) should be able to handle this, but is running into exception handling problems related to the singularity at x == y.


This may be improved in a future version, for now some possible workarounds are below. It is not necessary to fill the interior to compute the volume, so for a crude approximation we may use the "Legacy" method to get a boundary representation


reg0 = ImplicitRegion[x - 2 < y < x - 1 && 0 < z < Exp[(x + y)/(x - y)],
{{x, 0, 2}, {y, -2, 0}, {z, 0, 3}}];


{bmr0 = BoundaryDiscretizeRegion[reg0, Method -> "Legacy"], Volume[bmr0]}

Mathematica graphics


which is not a great estimate.


This is an improvement, suggested by user21, which does fill the interior with 300000 or so tetrahedra.


em = NDSolve`FEM`ToElementMesh[reg0, 
"BoundaryMeshGenerator" -> {"RegionPlot", "SamplePoints" -> 35}];
NIntegrate[1, {x, y, z} ∈ em]

(* 1.74563 *)


The following avoids the singularity and uses a finer mesh for a better estimate


ϵ = $MachineEpsilon/2; 
reg = ImplicitRegion[x - 2 < y < x - 1 && 0 < z < Exp[(x + y)/(x - y)],
{{x, ϵ, 2}, {y, -2, ϵ}, {z, 0, 3}}];
{bmr = BoundaryDiscretizeRegion[reg, MaxCellMeasure -> 0.001], Volume[bmr]}

Mathematica graphics


Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...