Files
UnrealEngine/Engine/Source/ThirdParty/OpenVDB/openvdb-12.0.0/openvdb_wolfram/OpenVDBLink/LevelSet.m
2025-05-18 13:04:45 +08:00

1059 lines
32 KiB
Mathematica

(* ::Package:: *)
(* ::Title:: *)
(*LevelSet*)
(* ::Subtitle:: *)
(*Create a level set representation of a region.*)
(* ::Text:: *)
(*Copyright Contributors to the OpenVDB Project*)
(*SPDX-License-Identifier: Apache-2.0*)
(* ::Section:: *)
(*Initialization & Usage*)
Package["OpenVDBLink`"]
PackageExport["OpenVDBLevelSet"]
OpenVDBLevelSet::usage = "OpenVDBLevelSet[reg] creates a signed distance level set representation of reg.";
(* ::Section:: *)
(*OpenVDBLevelSet*)
(* ::Subsection::Closed:: *)
(*OpenVDBLevelSet*)
Options[OpenVDBLevelSet] = {"Creator" :> $OpenVDBCreator, "Name" -> None, "ScalarType" -> "Float"};
OpenVDBLevelSet[args___] /; !CheckArgs[OpenVDBLevelSet[args], {1, 3}] = $Failed;
OpenVDBLevelSet[args___] :=
With[{res = pOpenVDBLevelSet[args]},
res /; res =!= $Failed
]
OpenVDBLevelSet[args___] := mOpenVDBLevelSet[args]
(* ::Subsection::Closed:: *)
(*pOpenVDBLevelSet*)
Options[pOpenVDBLevelSet] = Options[OpenVDBLevelSet];
pOpenVDBLevelSet[expr_, opts:OptionsPattern[]] := pOpenVDBLevelSet[expr, $OpenVDBSpacing, $OpenVDBHalfWidth, opts]
pOpenVDBLevelSet[expr_, spacing_?Positive, opts:OptionsPattern[]] := pOpenVDBLevelSet[expr, spacing, $OpenVDBHalfWidth, opts]
pOpenVDBLevelSet[expr_, spacing_?Positive, width_?Positive, OptionsPattern[]] :=
Block[{reg, type, vdb},
reg = processSDFInput[expr];
type = OptionValue["ScalarType"];
(
vdb = iOpenVDBLevelSet[reg, spacing, width, type, True];
(
OpenVDBSetProperty[vdb, "Creator" -> OptionValue["Creator"]];
OpenVDBSetProperty[vdb, "Name" -> OptionValue["Name"]];
vdb
) /; OpenVDBScalarGridQ[vdb]
) /; reg =!= $Failed && validScalarTypeQ[type]
]
pOpenVDBLevelSet[___] = $Failed;
(* ::Subsection::Closed:: *)
(*iOpenVDBLevelSet*)
(* ::Subsubsection::Closed:: *)
(*Surface mesh / complex*)
iOpenVDBLevelSet[mr_?triangleSurfaceMeshQ, args__] :=
triangleSurfaceComplexSignedDistanceField[MeshCoordinates[mr], Join @@ MeshCells[mr, 2, "Multicells" -> True][[All, 1]], mr["ConnectivityMatrix"[1, 2]], args]
iOpenVDBLevelSet[{coords_?coordinatesQ, pcells:_List|_Polygon}, args__] :=
With[{cells = stripPolygonCells[pcells]},
triangleSurfaceComplexSignedDistanceField[coords, cells, None, args] /; validTriangleCellsQ[cells, Length[coords]]
]
iOpenVDBLevelSet[mr_?surfaceMesh3DQ, args__] :=
Block[{tri},
tri = Quiet[laxMeshBlock @ Region`Mesh`TriangulateMeshCells[mr, MaxCellMeasure -> \[Infinity]]];
iOpenVDBLevelSet[tri, args] /; triangleSurfaceMeshQ[tri]
]
(* ::Subsubsection::Closed:: *)
(*Surface with thickness*)
iOpenVDBLevelSet[{mr_MeshRegion?triangleSurfaceMeshQ, r_?Positive}, args__] :=
thickSurfaceSignedDistanceField[MeshCoordinates[mr], Join @@ MeshCells[mr, 2, "Multicells" -> True][[All, 1]], r, args]
iOpenVDBLevelSet[{coords_?coordinatesQ, pcells:_List|_Polygon, r_?Positive}, args__] :=
With[{cells = stripPolygonCells[pcells]},
thickSurfaceSignedDistanceField[coords, cells, r, args] /; validTriangleCellsQ[cells, Length[coords]]
]
thickSurfaceSignedDistanceField[coords_, cells_, r_, spacing_, width_, type_, signedQ_] :=
Block[{vdb = OpenVDBCreateGrid[spacing, type]},
vdb["offsetSurfaceLevelSet"[coords, cells-1, r, spacing, width, signedQ]];
vdb
]
(* ::Subsubsection::Closed:: *)
(*Tube regions*)
iOpenVDBLevelSet[capsule_CapsuleShape?ConstantRegionQ, args__] := iOpenVDBLevelSet[Tube @@ capsule, args]
iOpenVDBLevelSet[Tube[ptspec_, r_?Positive], args__] :=
Block[{segdata = tubeSegmentData[ptspec]},
tubeComplexSignedDistanceField[Sequence @@ segdata, r, args] /; segdata =!= $Failed
]
iOpenVDBLevelSet[tube_Tube, args__] :=
Block[{mr = Quiet[DiscretizeGraphics[tube]]},
iOpenVDBLevelSet[mr, args] /; MeshRegionQ[mr]
]
iOpenVDBLevelSet[{mr_MeshRegion?lineMesh3DQ, r_?Positive}, args__] :=
tubeComplexSignedDistanceField[MeshCoordinates[mr], Join @@ MeshCells[mr, 1, "Multicells" -> True][[All, 1]], r, args]
iOpenVDBLevelSet[{coords_?coordinatesQ, lcells:_List|_Line, r_?Positive}, args__] :=
With[{cells = stripLineCells[lcells]},
tubeComplexSignedDistanceField[coords, cells, r, args] /; validLineCellsQ[cells, Length[coords]]
]
tubeComplexSignedDistanceField[coords_, cells_, r_, spacing_, width_, type_, signedQ_] :=
Block[{vdb = OpenVDBCreateGrid[spacing, type], coords2, cells2},
coords2 = Join[coords, coords[[cells[[All, 2]]]] + .0001];
cells2 = Transpose[Append[Transpose[cells], Range[Length[coords]+1, Length[coords]+Length[cells]]]]-1;
vdb["offsetSurfaceLevelSet"[coords2, cells2, r, spacing, width, signedQ]];
vdb
]
(* ::Subsubsection::Closed:: *)
(*Torus*)
iOpenVDBLevelSet[torus:(Torus|FilledTorus)[___]?ConstantRegionQ, spacing_, args__] :=
Block[{torusspec, c, rin, rout, rmid, rtube, n, pts},
torusspec = torusData @@ torus;
(
{c, rin, rout} = torusspec;
rmid = N[Mean[{rin, rout}]];
rtube = 0.5(rout - rin);
n = Ceiling[2\[Pi]*rmid/spacing];
pts = Append[c[[3]]] /@ CirclePoints[c[[1 ;; 2]], rmid, n];
AppendTo[pts, First[pts]];
iOpenVDBLevelSet[Tube[pts, rtube], spacing, args]
) /; torusspec =!= $Failed
]
torusData[] = {{0, 0, 0}, 0.5, 1.0};
torusData[c_?VectorQ] := {c, 0.5, 1.0}
torusData[c_?VectorQ, {rin_?Positive, rout_?Positive}] /; rout > rin := {c, rin, rout}
torusData[___] = $Failed;
(* ::Subsubsection::Closed:: *)
(*Ball*)
iOpenVDBLevelSet[ball:(Ball|Sphere)[___]?ConstantRegionQ, spacing_, width_, type_, signedQ_] /; RegionEmbeddingDimension[ball] == 3 :=
Block[{ballspec, c, r, vdb},
ballspec = singleBallData @@ ball;
(
{c, r} = ballspec;
vdb = OpenVDBCreateGrid[spacing, type];
vdb["ballLevelSet"[c, r, spacing, width, signedQ]];
vdb
) /; ballspec =!= $Failed
]
singleBallData[] = {{0, 0, 0}, 1};
singleBallData[3] = {{0, 0, 0}, 1}
singleBallData[c_?VectorQ] := {c, 1}
singleBallData[c_?VectorQ, r_?Positive] := {c, r}
singleBallData[___] = $Failed;
(* ::Subsubsection::Closed:: *)
(*SphericalShell*)
iOpenVDBLevelSet[shell:HoldPattern[SphericalShell][___]?ConstantRegionQ, args___] /; RegionEmbeddingDimension[shell] == 3 :=
Block[{shellspec, c, r1, r2, ballout, ballin},
shellspec = sphericalShellData @@ shell;
(
{c, {r1, r2}} = shellspec;
ballout = iOpenVDBLevelSet[Ball[c, r2], args];
(
ballin = iOpenVDBLevelSet[Ball[c, r1], args];
OpenVDBDifferenceFrom[ballout, ballin] /; OpenVDBScalarGridQ[ballin]
) /; OpenVDBScalarGridQ[ballout]
) /; shellspec =!= $Failed
]
sphericalShellData[] = {{0, 0, 0}, {1/2, 1}};
sphericalShellData[{r1_, r2_}] := {{0, 0, 0}, {r1, r2}}
sphericalShellData[c_?VectorQ] := {c, {1/2, 1}}
sphericalShellData[c_?VectorQ, r_?Positive] := {c, {r/2, r}}
sphericalShellData[c_?VectorQ, {r1_, r2_}] := {c, {r1, r2}}
sphericalShellData[r_] := {{0, 0, 0}, {r/2, r}}
sphericalShellData[___] = $Failed;
(* ::Subsubsection::Closed:: *)
(*Cuboid*)
iOpenVDBLevelSet[cuboid_Cuboid?ConstantRegionQ, spacing_, width_, type_, signedQ_] :=
Block[{bds, vdb},
bds = RegionBounds[cuboid];
(
vdb = OpenVDBCreateGrid[spacing, type];
vdb["cuboidLevelSet"[bds, spacing, width, signedQ]];
vdb
) /; And @@ Less @@@ bds
]
iOpenVDBLevelSet[hex_Hexahedron?ConstantRegionQ, args__] /; Volume[hex] == Volume[BoundingRegion[hex]] := iOpenVDBLevelSet[BoundingRegion[hex], args]
(* ::Subsubsection::Closed:: *)
(*Special polyhedra*)
iOpenVDBLevelSet[poly_?specialPolyhedonQ, args__] :=
With[{data = polyhedronTriangleData[poly]},
(
triangleSurfaceComplexSignedDistanceField[##, None, args, False]& @@ data
) /; data =!= $Failed
]
(* ::Subsubsection::Closed:: *)
(*EmptyRegion / FullRegion*)
iOpenVDBLevelSet[EmptyRegion[3], spacing_, width_, ___] := OpenVDBCreateGrid[spacing, "BackgroundValue" -> spacing*width, "GridClass" -> $gridLevelSet]
iOpenVDBLevelSet[FullRegion[3], spacing_, __] := OpenVDBCreateGrid[spacing, "BackgroundValue" -> -10^12., "GridClass" -> $gridLevelSet]
(* ::Subsubsection::Closed:: *)
(*BooleanRegion*)
(* ::Text:: *)
(*Would be nice to allow any Boolean function, but then we will need Boolean operations that don't clear the second input, which we don't have right now.*)
iOpenVDBLevelSet[reg:BooleanRegion[bfunc_, regs_]?ConstantRegionQ, args__] /; RegionEmbeddingDimension[reg] == 3 :=
Block[{op},
op = booleanHead[bfunc, Length[regs]];
(
If[op === Or,
unionRegionSDFs[regs, args],
intersectRegionSDFs[regs, args]
]
) /; op =!= $Failed
]
booleanHead[bfunc_, n_] :=
Block[{vars, expr},
vars = \[FormalX] /@ Range[n];
expr = bfunc @@ vars;
Which[
expr === Or @@ vars, Or,
expr === And @@ vars, And,
True, $Failed
]
]
unionRegionSDFs[args__] := booleanRegionSDFs["gridUnion", args]
intersectRegionSDFs[args__] := booleanRegionSDFs["gridIntersection", args]
booleanRegionSDFs[boolVDB_, regs_, args__] :=
Block[{vdb1, vdb2},
vdb1 = iOpenVDBLevelSet[First[regs], args];
If[vdb1 === $Failed,
Return[$Failed]
];
Do[
vdb2 = iOpenVDBLevelSet[reg, args];
If[vdb2 === $Failed,
OpenVDBDeleteGrid[vdb1];
Return[$Failed]
];
vdb1[boolVDB[vdb2[[1]]]];,
{reg, Rest[regs]}
];
vdb1
]
(* ::Subsubsection::Closed:: *)
(*TransformedRegion*)
iOpenVDBLevelSet[treg:TransformedRegion[reg_, tfunc_TransformationFunction]?ConstantRegionQ, args__] /; RegionEmbeddingDimension[treg] == 3 :=
With[{res = iOpenVDBLevelSet[reg, args]},
OpenVDBTransform[res, tfunc] /; res =!= $Failed
]
(* ::Subsubsection::Closed:: *)
(*RegionBoundary*)
iOpenVDBLevelSet[RegionBoundary[reg_], args__, _] := iOpenVDBLevelSet[reg, args, False]
(* ::Subsubsection::Closed:: *)
(*General 3D region*)
iOpenVDBLevelSet[reg_?ConstantRegionQ, args__] /; RegionEmbeddingDimension[reg] == 3 :=
Block[{bmr},
bmr = Quiet[laxMeshBlock @ BoundaryDiscretizeRegion[reg]];
iOpenVDBLevelSet[bmr, args] /; BoundaryMeshRegionQ[bmr]
]
(* ::Subsubsection::Closed:: *)
(*Generic behavior*)
iOpenVDBLevelSet[rspec_List, args__] /; VectorQ[rspec, !NumericQ[#]&] := unionRegionSDFs[rspec, args]
iOpenVDBLevelSet[___] = $Failed;
(* ::Subsection::Closed:: *)
(*Argument conform & completion*)
SyntaxInformation[OpenVDBLevelSet] = {"ArgumentsPattern" -> {_, _., _., OptionsPattern[]}};
(* ::Subsection::Closed:: *)
(*Messages*)
Options[mOpenVDBLevelSet] = Options[OpenVDBLevelSet];
mOpenVDBLevelSet[expr_, ___] /; !validToLevelSetQ[expr] :=
(
Message[OpenVDBLevelSet::reg, expr, 1];
$Failed
)
mOpenVDBLevelSet[_, OptionsPattern[]] /; !TrueQ[$OpenVDBSpacing > 0] :=
(
Message[OpenVDBLevelSet::novoxsz];
$Failed
)
mOpenVDBLevelSet[_, _., OptionsPattern[]] /; !TrueQ[$OpenVDBHalfWidth > 0] :=
(
Message[OpenVDBLevelSet::nowidth];
$Failed
)
mOpenVDBLevelSet[_, vx_, ___] /; !TrueQ[vx > 0] && !OptionQ[vx] :=
(
Message[OpenVDBLevelSet::nonpos, vx, 2];
$Failed
)
mOpenVDBLevelSet[_, _, w_, ___] /; !TrueQ[w > 0] && !OptionQ[w] :=
(
Message[OpenVDBLevelSet::nonpos, w, 3];
$Failed
)
mOpenVDBLevelSet[__, OptionsPattern[]] :=
Block[{validQ = validScalarTypeQ[OptionValue["ScalarType"]]},
(
Message[OpenVDBLevelSet::nonscalar, OptionValue["ScalarType"]];
$Failed
) /; !validQ
]
mOpenVDBLevelSet[___] = $Failed;
OpenVDBLevelSet::reg = "`1` at position `2` is not a constant 3D region.";
OpenVDBLevelSet::novoxsz = "No grid spacing is provided since $OpenVDBSpacing is not a positive number.";
OpenVDBLevelSet::nowidth = "No half band width is provided since $OpenVDBHalfWidth is not a positive number."
OpenVDBLevelSet::nonpos = "`1` at position `2` is expected to be a positive number";
OpenVDBLevelSet::nonscalar = "`1` is not a valid setting for \"ScalarType\". Evaluate OpenVDBGridTypes[\"Scalar\"] for a list of valid types.";
(* ::Section:: *)
(*Utilities*)
(* ::Subsection::Closed:: *)
(*Coordinate & cell utilities*)
validTriangleCellsQ[cells_, max_] := MatrixQ[cells, IntegerQ] && Length[cells[[1]]] == 3 && Min[cells] >= 1 && Max[cells] <= max
validLineCellsQ[cells_, max_] := MatrixQ[cells, IntegerQ] && Length[cells[[1]]] == 2 && Min[cells] >= 1 && Max[cells] <= max
stripPolygonCells[Polygon[cells_]] := cells
stripPolygonCells[pcells:{__Polygon}] :=
With[{cells = pcells[[All, 1]]},
Which[
VectorQ[cells, VectorQ], cells,
VectorQ[cells, MatrixQ], Join @@ cells,
VectorQ[cells, ArrayQ[#, 1|2]&], Join[Join @@ Select[cells, MatrixQ], Select[cells, VectorQ]],
True, $Failed
]
]
stripPolygonCells[expr_] := expr
stripLineCells[Line[cells_]] := cells
stripLineCells[lcells:{__Line}] :=
With[{cells = lcells[[All, 1]]},
Which[
VectorQ[cells, VectorQ], cells,
VectorQ[cells, MatrixQ], Join @@ cells,
VectorQ[cells, ArrayQ[#, 1|2]&], Join[Join @@ Select[cells, MatrixQ], Select[cells, VectorQ]],
True, $Failed
]
]
stripLineCells[{i1_Integer, i2_Integer}] := {{i1, i2}}
stripLineCells[expr_] := expr
(* ::Subsection::Closed:: *)
(*processSDFInput*)
processSDFInput[expr_] :=
With[{res = Join @@ expandMultisetRegion /@ If[ListQ[expr], Identity, List][expr]},
If[Length[res] == 1,
First[res],
res
]
];
expandMultisetRegion[(h:Ball | Sphere)[pts_?MatrixQ, r___]?ConstantRegionQ] /; Length[pts[[1]]] == 3 := h[#, r]& /@ pts
expandMultisetRegion[reg:(Cone | Cylinder)[pts_?ArrayQ, ___]?ConstantRegionQ] /; MatchQ[Dimensions[pts], {_, _, 3}] := Thread[reg]
expandMultisetRegion[reg:(Hexahedron | Prism | Pyramid | Tetrahedron)[pts_?ArrayQ]?ConstantRegionQ] /; MatchQ[Dimensions[pts], {_, _, 3}] := Thread[reg]
expandMultisetRegion[reg_] := {reg}
(* ::Subsection::Closed:: *)
(*tubeSegmentData*)
tubeSegmentData[pts_List] /; MatrixQ[pts, realQ] && Length[pts[[1]]] == 3 := {pts, Partition[Range[Length[pts]], 2, 1]}
tubeSegmentData[pts_List] /; VectorQ[pts, MatrixQ[#, realQ] && Length[#[[1]]] == 3&] :=
{
Join @@ pts,
Join @@ Plus[Partition[Range[Length[#]], 2, 1]& /@ pts, Prepend[Most[Accumulate[Length /@ pts]], 0]]
}
tubeSegmentData[pts_List] :=
With[{data = tubeSegmentData /@ pts},
(
{
Join @@ data[[All, 1]],
Join @@ Plus[data[[All, 2]], Prepend[Most[Accumulate[Length /@ data[[All, 1]]]], 0]]
}
) /; FreeQ[data, $Failed, {1}]
]
tubeSegmentData[Line[pts_]] := tubeSegmentData[pts]
tubeSegmentData[bc:(_BSplineCurve|_BezierCurve)] :=
With[{mr = Quiet[DiscretizeGraphics[bc]]},
{MeshCoordinates[mr], Join @@ MeshCells[mr, 1, "Multicell" -> True][[All, 1]]} /; MeshRegionQ[mr] && RegionDimension[mr] == 1
]
tubeSegmentData[___] = $Failed
(* ::Subsection::Closed:: *)
(*polyhedronTriangleData*)
specialPolyhedonQ[reg_] := TrueQ[specialPolyhedonHead[Head[reg]]] && ConstantRegionQ[reg] && RegionEmbeddingDimension[reg] === 3
specialPolyhedonHead[Cube] = True;
specialPolyhedonHead[Cuboid] = True;
specialPolyhedonHead[Dodecahedron] = True;
specialPolyhedonHead[Hexahedron] = True;
specialPolyhedonHead[Icosahedron] = True;
specialPolyhedonHead[Octahedron] = True;
specialPolyhedonHead[Parallelepiped] = True;
specialPolyhedonHead[Prism] = True;
specialPolyhedonHead[Pyramid] = True;
specialPolyhedonHead[Simplex] = True;
specialPolyhedonHead[Tetrahedron] = True;
polyhedronTriangleData[c_Cube] := cubeTriangleData @@ c
polyhedronTriangleData[c_Cuboid] := cuboidTriangleData @@ c
polyhedronTriangleData[d_Dodecahedron] := dodecahedronTriangleData @@ d
polyhedronTriangleData[h_Hexahedron] := hexahedronTriangleData @@ h
polyhedronTriangleData[i_Icosahedron] := icosahedronTriangleData @@ i
polyhedronTriangleData[o_Octahedron] := octahedronTriangleData @@ o
polyhedronTriangleData[p_Parallelepiped] := parallelepipedTriangleData @@ p
polyhedronTriangleData[p_Prism] := prismTriangleData @@ p
polyhedronTriangleData[p_Pyramid] := pyramidTriangleData @@ p
polyhedronTriangleData[s_Simplex] := simplexTriangleData @@ s
polyhedronTriangleData[t_Tetrahedron] := tetrahedronTriangleData @@ t
polyhedronTriangleData[___] = $Failed;
platonicSpecs[args___] :=
Block[{data = {args}, center, angles, l, cuboidres},
center = {0, 0, 0};
angles = {0, 0};
l = 1;
Switch[Prepend[If[ListQ[#], Length[#], 0]& /@ data, Length[data]],
{0}, Null,
{1, 0}, {l} = data,
{1, 2}, {angles} = data,
{1, 3}, {center} = data,
{2, 2, 0}, {angles, l} = data,
{2, 3, 0}, {center, l} = data,
{2, 3, 2}, {center, angles} = data,
{3, __}, {center, angles, l} = data,
_, Return[$Failed]
];
{center, angles, l}
]
rotatePolyhedronCoordinates[coords_, {\[Theta]_, \[Phi]_}, center_] := (RotationTransform[\[Phi], {0, 1, 0}, center] @* RotationTransform[\[Theta], {0, 0, 1}, center])[coords]
cubeTriangleData[args___] :=
Block[{center, angles, l, cuboidres},
{center, angles, l} = platonicSpecs[args];
cuboidres = cuboidTriangleData[center - 0.5l{1, 1, 1}, center + 0.5l{1, 1, 1}];
If[angles =!= {0, 0},
cuboidres[[1]] = rotatePolyhedronCoordinates[cuboidres[[1]], angles, center];
];
cuboidres
]
cuboidTriangleData[l_] := cuboidTriangleData[l, l+1]
cuboidTriangleData[l_, u_] :=
{
Tuples[Transpose[{l, u}]],
{{1,2,4},{1,4,3},{1,5,6},{1,6,2},{1,7,5},{1,3,7},{2,8,4},{2,6,8},{3,4,8},{3,8,7},{5,7,6},{6,7,8}}
}
$dodecacoords = {{-1.3763819204711736, 0., 0.2628655560595668}, {1.3763819204711736, 0., -0.2628655560595668}, {-0.42532540417601994, -1.3090169943749475, 0.2628655560595668}, {-0.42532540417601994, 1.3090169943749475, 0.2628655560595668}, {1.1135163644116066, -0.8090169943749475, 0.2628655560595668}, {1.1135163644116066, 0.8090169943749475, 0.2628655560595668}, {-0.2628655560595668, -0.8090169943749475, 1.1135163644116066}, {-0.2628655560595668, 0.8090169943749475, 1.1135163644116066}, {-0.6881909602355868, -0.5, -1.1135163644116068}, {-0.6881909602355868, 0.5, -1.1135163644116068}, {0.6881909602355868, -0.5, 1.1135163644116066}, {0.6881909602355868, 0.5, 1.1135163644116066}, {0.85065080835204, 0., -1.1135163644116068}, {-1.1135163644116068, -0.8090169943749475, -0.2628655560595668}, {-1.1135163644116068, 0.8090169943749475, -0.2628655560595668}, {-0.8506508083520399, 0., 1.1135163644116066}, {0.2628655560595668, -0.8090169943749475, -1.1135163644116068}, {0.2628655560595668, 0.8090169943749475, -1.1135163644116068}, {0.42532540417601994, -1.3090169943749475, -0.2628655560595668}, {0.42532540417601994, 1.3090169943749475, -0.2628655560595668}};
dodecahedronTriangleData[args___] :=
Block[{center, angles, l, dcoords, dcells},
{center, angles, l} = platonicSpecs[args];
dcoords = Transpose[Transpose[l*$dodecacoords] + center];
If[angles =!= {0, 0},
dcoords = rotatePolyhedronCoordinates[dcoords, angles, center];
];
dcells = {{15,10,9},{15,9,14},{15,14,1},{2,6,12},{2,12,11},{2,11,5},{5,11,7},
{5,7,3},{5,3,19},{11,12,8},{11,8,16},{11,16,7},{12,6,20},{12,20,4},{12,4,8},
{6,2,13},{6,13,18},{6,18,20},{2,5,19},{2,19,17},{2,17,13},{4,20,18},{4,18,10},
{4,10,15},{18,13,17},{18,17,9},{18,9,10},{17,19,3},{17,3,14},{17,14,9},{3,7,16},
{3,16,1},{3,1,14},{16,8,4},{16,4,15},{16,15,1}};
{dcoords, dcells}
]
hexahedronTriangleData[pts_] := {pts, {{1,3,2},{1,4,3},{1,6,5},{1,2,6},{1,5,8},{1,8,4},{3,4,8},{3,8,7},{2,3,7},{2,7,6},{5,6,8},{6,7,8}}}
$icosacoords = {{0., 0., -0.9510565162951536}, {0., 0., 0.9510565162951536}, {-0.85065080835204, 0., -0.42532540417601994}, {0.85065080835204, 0., 0.42532540417601994}, {0.6881909602355868, -0.5, -0.42532540417601994}, {0.6881909602355868, 0.5, -0.42532540417601994}, {-0.6881909602355868, -0.5, 0.42532540417601994}, {-0.6881909602355868, 0.5, 0.42532540417601994}, {-0.2628655560595668, -0.8090169943749475, -0.42532540417601994}, {-0.2628655560595668, 0.8090169943749475, -0.42532540417601994}, {0.2628655560595668, -0.8090169943749475, 0.42532540417601994}, {0.2628655560595668, 0.8090169943749475, 0.42532540417601994}};
icosahedronTriangleData[args___] :=
Block[{center, angles, l, icoords, icells},
{center, angles, l} = platonicSpecs[args];
icoords = Transpose[Transpose[l*$icosacoords] + center];
If[angles =!= {0, 0},
icoords = rotatePolyhedronCoordinates[icoords, angles, center];
];
icells = {{2,12,8},{2,8,7},{2,7,11},{2,11,4},{2,4,12},{5,9,1},{6,5,1},{10,6,1},
{3,10,1},{9,3,1},{12,10,8},{8,3,7},{7,9,11},{11,5,4},{4,6,12},{5,11,9},
{6,4,5},{10,12,6},{3,8,10},{9,7,3}};
{icoords, icells}
]
$octacoords = {{0., 0.7071067811865475, 0.}, {0.7071067811865475, 0., 0.}, {0., -0.7071067811865475, 0.}, {-0.7071067811865475, 0., 0.}, {0., 0., 0.7071067811865475}, {0., 0., -0.7071067811865475}};
octahedronTriangleData[args___] :=
Block[{center, angles, l, ocoords, ocells},
{center, angles, l} = platonicSpecs[args];
ocoords = Transpose[Transpose[l*$octacoords] + center];
If[angles =!= {0, 0},
ocoords = rotatePolyhedronCoordinates[ocoords, angles, center];
];
ocells = {{5,2,1},{5,3,2},{5,4,3},{4,5,1},{2,6,1},{2,3,6},{4,6,3},{1,6,4}};
{ocoords, ocells}
]
parallelepipedTriangleData[center_, {v1_, v2_, v3_}] :=
{
Transpose[Transpose[{{0,0,0}, v1, v2, v1+v2, v3, v1+v3, v2+v3, v1+v2+v3}] + center],
{{1,2,4},{1,4,3},{1,5,6},{1,6,2},{1,7,5},{1,3,7},{2,8,4},{2,6,8},{3,4,8},{3,8,7},{5,7,6},{6,7,8}}
}
prismTriangleData[pts_] := {pts, {{1,3,2},{4,5,6},{2,3,6},{2,6,5},{1,2,5},{1,5,4},{1,6,3},{1,4,6}}}
pyramidTriangleData[pts_] := {pts, {{1,2,5},{2,3,5},{3,4,5},{4,1,5},{1,3,2},{1,4,3}}}
simplexTriangleData[3] = simplexTriangleData[{{0,0,0},{1,0,0},{0,1,0},{0,0,1}}]
simplexTriangleData[pts_] := tetrahedronTriangleData[pts]
$tetcoords = {{0., 0., 0.6123724356957945}, {-0.2886751345948129, -0.5, -0.20412414523193154}, {-0.2886751345948129, 0.5, -0.20412414523193154}, {0.5773502691896258, 0., -0.20412414523193154}};
tetrahedronTriangleData[pts_?MatrixQ] := {pts, {{1,2,4},{1,3,2},{1,4,3},{2,3,4}}}
tetrahedronTriangleData[args___] :=
Block[{center, angles, l, tetres},
{center, angles, l} = platonicSpecs[args];
tetres = tetrahedronTriangleData[Transpose[Transpose[l*$tetcoords] + center]];
If[angles =!= {0, 0},
tetres[[1]] = rotatePolyhedronCoordinates[tetres[[1]], angles, center];
];
tetres
]
(* ::Subsection::Closed:: *)
(*triangleSurfaceComplexSignedDistanceField*)
triangleSurfaceComplexSignedDistanceField[coords_, cells_, C12_, spacing_, width_, type_, signedQ_, nestingQ_:True] :=
Block[{vdb, nestedcells, nestedvdb},
vdb = OpenVDBCreateGrid[spacing, type];
nestedcells = If[TrueQ[nestingQ] && ArrayQ[C12],
nestedComponentHierarchy[coords, cells, C12],
{cells}
];
vdb["meshLevelSet"[coords, nestedcells[[1]] - 1, spacing, width, signedQ]];
Do[
nestedvdb = OpenVDBCreateGrid[spacing, type];
nestedvdb["meshLevelSet"[coords, nestedcells[[i]] - 1, spacing, width, signedQ]];
If[EvenQ[i],
OpenVDBDifferenceFrom[vdb, nestedvdb],
OpenVDBUnionTo[vdb, nestedvdb]
],
{i, 2, Length[nestedcells]}
];
vdb
]
nestedComponentHierarchy[coords_, cells_, C12_] :=
Block[{C22, comps, conncells, n, adj, depths, depthmembers},
C22 = triangleTriangleConnectivity[coords, cells, C12];
comps = SparseArray`StronglyConnectedComponents[C22];
(* only one component *)
If[Length[comps] == 1, Return[{cells}]];
conncells = cells[[#]]& /@ comps;
n = Length[conncells];
adj = boundaryNestingAdjacency[coords, Polygon /@ conncells];
depths = nestingDepths[n, adj];
(* multiple components, but none nested *)
If[Max[depths] == 0, Return[{cells}]];
depthmembers = GatherBy[SortBy[Transpose[{depths, Range[n]}], First], First][[All, All, 2]];
(Join @@ conncells[[#]])& /@ depthmembers
]
triangleTriangleConnectivity[_, _, C12_SparseArray] := Transpose[C12] . C12
triangleTriangleConnectivity[coords_, cells_, _] :=
With[{C12 = edgeTriangleAdjacencyMatrix[coords, cells]},
Transpose[C12] . C12
]
(* ::Text:: *)
(*https://mathematica.stackexchange.com/a/160444/4346*)
getEdgesFromTriangles = Compile[{{f, _Integer, 1}},
{
Sort[{Compile`GetElement[f, 1], Compile`GetElement[f, 2]}],
Sort[{Compile`GetElement[f, 2], Compile`GetElement[f, 3]}],
Sort[{Compile`GetElement[f, 3], Compile`GetElement[f, 1]}]
},
RuntimeAttributes -> {Listable},
Parallelization -> True
];
takeSortedThread = Compile[{{data, _Integer, 1}, {ran, _Integer, 1}},
Sort[Part[data, ran[[1]] ;; ran[[2]]]],
RuntimeAttributes -> {Listable},
Parallelization -> True
];
extractIntegerFromSparseMatrix = Compile[
{{vals, _Integer, 1}, {rp, _Integer, 1}, {ci, _Integer,
1}, {background, _Integer},
{i, _Integer}, {j, _Integer}},
Block[{k},
k = rp[[i]] + 1;
While[k < rp[[i + 1]] + 1 && ci[[k]] != j, ++k];
If[k == rp[[i + 1]] + 1, background, vals[[k]]]
],
RuntimeAttributes -> {Listable},
Parallelization -> True
];
edgeTriangleAdjacencyMatrix[coords_, cells_] :=
Module[{edgesfrompolygons, edges, edgelookupcontainer,
polyranges, polygonsneighedges, edgepolygonadjacencymatrix, acc},
edgesfrompolygons = Flatten[getEdgesFromTriangles[cells], 1];
edges = DeleteDuplicates[edgesfrompolygons];
edgelookupcontainer =
SparseArray[
Rule[Join[edges, Transpose[Transpose[edges][[{2, 1}]]]],
Join[Range[1, Length[edges]], Range[1, Length[edges]]]], {Length[coords], Length[coords]}];
acc = Range[0, 3Length[cells], 3];
polyranges = Transpose[{Most[acc] + 1, Rest[acc]}];
polygonsneighedges = takeSortedThread[extractIntegerFromSparseMatrix[
edgelookupcontainer["NonzeroValues"],
edgelookupcontainer["RowPointers"],
Flatten@edgelookupcontainer["ColumnIndices"],
edgelookupcontainer["Background"],
edgesfrompolygons[[All, 1]],
edgesfrompolygons[[All, 2]]],
polyranges];
Transpose@With[{
n = Length[edges], m = Length[cells],
data = Flatten[polygonsneighedges]
},
SparseArray @@ {Automatic, {m, n},
0, {1, {acc, Transpose[{data}]}, ConstantArray[1, Length[data]]}}
]
]
(* ::Subsection::Closed:: *)
(*Mesh utilities*)
(* ::Subsubsection::Closed:: *)
(*Q functions*)
meshQ[expr_] := MeshRegionQ[expr] || BoundaryMeshRegionQ[expr]
mesh3DQ[expr_] := (MeshRegionQ[expr] || BoundaryMeshRegionQ[expr]) && RegionEmbeddingDimension[expr] === 3
surfaceMesh3DQ[mr_] :=
And[
mesh3DQ[mr],
BoundaryMeshRegionQ[mr] || RegionDimension[mr] === 2,
(* has faces and all faces are triangles -- this allows for meshes with points, lines, etc, which will all be ignored *)
!FreeQ[mr["MeshCellTypes"], {Polygon, {_, _}}]
]
triangleSurfaceMeshQ[mr_] := surfaceMesh3DQ[mr] && FreeQ[mr["MeshCellTypes"], {Polygon, {_, Except[3]}}]
lineMesh3DQ[mr_] := mesh3DQ[mr] && RegionDimension[mr] === 1
(* ::Subsubsection::Closed:: *)
(*laxMeshBlock*)
SetAttributes[laxMeshBlock, HoldFirst];
laxMeshBlock[code_] :=
Block[{bmethod},
Internal`WithLocalSettings[
bmethod = OptionValue[BoundaryMeshRegion, Method];
SetOptions[BoundaryMeshRegion, Method -> Join[{"CheckIntersections" -> False}, Replace[bmethod, Except[_List] -> {}, {0}]]];,
code,
SetOptions[BoundaryMeshRegion, Method -> bmethod];
]
]
(* ::Subsubsection::Closed:: *)
(*Nesting*)
(* ::Text:: *)
(*Uses the same idea as Region`Mesh`BoundaryNestingArrays, but only tests one point for crossing count instead of all points. This assumes no intersecting facets.*)
polygonBoundingBox[Polygon[coords_]] := CoordinateBoundingBox[coords]
polygonBoundingBox[data_List] := CoordinateBoundingBox[polygonBoundingBox /@ data]
polygonCoordinate[Polygon[data_]] := iPolygonCoordinate[data];
polygonCoordinate[data_List] := polygonCoordinate[First[data]];
iPolygonCoordinate[lis_List] :=
If[Length[lis] == 3 && VectorQ[lis, NumericQ],
lis,
iPolygonCoordinate[lis[[1]]]
]
boundingBoxNesting[{min1_, max1_}, {min2_, max2_}] :=
Module[{minless, maxless},
If[Or @@ MapThread[Less, {max1, min2}],
Return["Disjoint"]
];
If[Or @@ MapThread[Less, {max2, min1}],
Return["Disjoint"]
];
minless = Union[MapThread[Less, {min1, min2}]];
maxless = Union[MapThread[Less, {max1, max2}]];
If[Length[minless] > 1 || Length[maxless] > 1 || minless === maxless,
Return[Indeterminate]
];
If[TrueQ[First[minless]],
{"Inside", 2, 1},
{"Inside", 1, 2}
]
]
pointInsideQ[polys_, pt_] := OddQ[Region`Mesh`CrossingCount[polys, pt]]
(* ::Text:: *)
(*Returns {{i1, j1}, {i2, j2}, ...} where the i1 component contains the j1 component, etc.*)
boundaryNestingAdjacency[coords_, cells_] :=
Block[{np, polycomps, bb, pts, nesting},
np = Length[cells];
polycomps = Region`Mesh`ToCoordinates[cells, coords];
bb = polygonBoundingBox /@ polycomps;
pts = polygonCoordinate /@ polycomps;
nesting = Reap[
Do[
Switch[
boundingBoxNesting[bb[[j]], bb[[i]]],
Indeterminate,
If[pointInsideQ[polycomps[[i]], pts[[j]]],
Sow[{i, j}],
If[pointInsideQ[polycomps[[j]], pts[[i]]],
Sow[{j, i}]
]
],
{"Inside", 1, 2},
If[pointInsideQ[polycomps[[i]], pts[[j]]],
Sow[{i, j}]
],
{"Inside", 2, 1},
If[pointInsideQ[polycomps[[j]], pts[[i]]],
Sow[{j, i}]
],
"Disjoint",
Null,
_,
Throw[0]
],
{i, 1, np - 1},
{j, i + 1, np}
]
][[-1]];
Sort[Flatten[nesting, 1]]
]
nestingLevels[np_Integer, adj_] :=
Block[{depths, roots, depthlist},
(* The number of times a component appears in the second location is its depth in the inclusion tree. *)
depths = SplitBy[SortBy[Tally[adj[[All, 2]]], Last], Last];
roots = Complement[Range[np], adj[[All, 2]]];
(* creates {{i01, i02, i03, ...}, {i11, i12, i13, ...}, {i21, i22, i23, ...}, ...}, where idj means the index has depth d. *)
Prepend[depths[[All, All, 1]], roots]
]
nestingDepths[np_Integer, adj_] :=
Block[{depthlist, df},
depthlist = nestingLevels[np, adj];
df[_] = 0;
Do[Scan[(df[#] = i)&, depthlist[[i+1]]], {i, 0, Length[depthlist]-1}];
df /@ Range[np]
]
(* ::Subsection::Closed:: *)
(*validToLevelSetQ*)
validToLevelSetQ[reg_?RegionQ] := ConstantRegionQ[reg] && RegionEmbeddingDimension[reg] === 3
validToLevelSetQ[{coords_?coordinatesQ, ocells:_List|_Polygon}] :=
With[{cells = stripPolygonCells[ocells]},
validTriangleCellsQ[cells, Length[coords]]
]
validToLevelSetQ[{coords_?coordinatesQ, ocells:_List|_Polygon|_Line, r_?Positive}] :=
With[{cells = stripLineCells[stripPolygonCells[ocells]]},
validTriangleCellsQ[cells, Length[coords]] || validLineCellsQ[cells, Length[coords]]
]
validToLevelSetQ[___] = False;
(* ::Subsection::Closed:: *)
(*validScalarTypeQ*)
validScalarTypeQ[type_] := KeyExistsQ[$GridClassData[$scalarType], type]
validScalarTypeQ[___] = $Failed;