ここで解決策を提示します。最初にワイヤーフレームを生成する関数の使い方を示し、次にアルゴリズムを構成する残りの関数について詳しく説明します。
wireFrame
wireFrame[g_] := Module[{figInfo, opt, pts},
{figInfo, opt} = G3ToG2Info[g];
pts = getHiddenLines[figInfo];
Graphics[Map[setPoints[#] &, getFrame[figInfo, pts]], opt]
]
この関数の入力は、Graphics3Dできれば軸のないオブジェクトです。
fig = ListPlot3D[
{{0, -1, 0}, {0, 1, 0}, {-1, 0, 1}, {1, 0, 1}, {-1, 1, 1}},
Mesh -> {10, 10},
Boxed -> False,
Axes -> False,
ViewPoint -> {2, -2, 1},
ViewVertical -> {0, 0, 1},
MeshStyle -> Directive[RGBColor[0, 0.5, 0, 0.5]],
BoundaryStyle -> Directive[RGBColor[1, 0.5, 0, 0.5]]
]
関数 を適用しますwireFrame。
wireFrame[fig]
ご覧のとおりwireFrame、ほとんどの線とその色が得られました。ワイヤーフレームに含まれていなかった緑色の線があります。これは、私のしきい値設定が原因である可能性が最も高いです。
関数G3ToG2Info、getHiddenLines、getFrameの詳細を説明する前にsetPoints、隠線処理付きのワイヤー フレームが役立つ理由を説明します。
上の画像は、ここで生成されたワイヤー フレームと組み合わせた 3D グラフィックスのラスターで説明された手法を使用して生成された pdf ファイルのスクリーンショットです。これは、さまざまな点で有利になる可能性があります。カラフルなサーフェスを表示するために三角形の情報を保持する必要はありません。代わりに、表面のラスター画像を表示します。線で覆われていないラスター プロットの境界を除いて、すべての線は非常に滑らかです。また、ファイルサイズの削減も行っています。この場合、pdf ファイルのサイズは、ラスター プロットとワイヤー フレームの組み合わせを使用して 1.9mb から 78kb に縮小されました。PDFビューアで表示するのに時間がかからず、画質も素晴らしいです。
Mathematicaは、3D 画像を pdf ファイルにエクスポートするのに非常に優れています。PDF ファイルをインポートすると、線分と三角形で構成される Graphics オブジェクトが取得されます。場合によっては、このオブジェクトが重なって隠線ができてしまいます。サーフェスのないワイヤ フレーム モデルを作成するには、まずこのオーバーラップを削除してから、ポリゴンを削除する必要があります。まず、Graphics3D 画像から情報を取得する方法について説明します。
G3ToG2Info
getPoints[obj_] := Switch[Head[obj],
Polygon, obj[[1]],
JoinedCurve, obj[[2]][[1]],
RGBColor, {Table[obj[[i]], {i, 1, 3}]}
];
setPoints[obj_] := Switch[Length@obj,
3, Polygon[obj],
2, Line[obj],
1, RGBColor[obj[[1]]]
];
G3ToG2Info[g_] := Module[{obj, opt},
obj = ImportString[ExportString[g, "PDF", Background -> None], "PDF"][[1]];
opt = Options[obj];
obj = Flatten[First[obj /. Style[expr_, opts___] :> {opts, expr}], 2];
obj = Cases[obj, _Polygon | _JoinedCurve | _RGBColor, Infinity];
obj = Map[getPoints[#] &, obj];
{obj, opt}
]
このコードはバージョン 7 のMathematica 8JoinedCurve用で、関数内getPointsをで置き換えますLine。この関数は、プリミティブオブジェクトgetPointsを指定していることを前提としています。Graphics受信したオブジェクトのタイプを確認し、そこから必要な情報を抽出します。多角形の場合は 3 点のリストを取得し、線の場合は 2 点のリストを取得し、色の場合は 3 点を含む単一のリストのリストを取得します。これは、リストとの一貫性を維持するためにこのように行われました。
関数setPointsは の逆を行いgetPointsます。ポイントのリストを入力すると、ポリゴン、ライン、またはカラーを返すかどうかが決定されます。
使用する三角形、線、色のリストを取得するためにG3ToG2Info. この関数は、 と を使用
ExportStringして、バージョンからオブジェクトImportStringを取得します。この情報は に保存されます。実行する必要があるいくつかのクリーンアップがあります。最初に のオプションを取得します。この部分は、画像のが含まれている可能性があるため必要です。次に、グラフィックス プリミティブとディレクティブの取得で説明されているように、すべてのとオブジェクトを取得します。最後に、これらすべてのオブジェクトに関数を適用して、三角形、線、および色のリストを取得します。この部分はラインをカバーしています。GraphicsGraphics3DobjobjPlotRangePolygonJoinedCurveRGBColorgetPoints{figInfo, opt} = G3ToG2Info[g]
getHiddenLines
行のどの部分が表示されないかを知りたいです。これを行うには、2 つの線分の交点を知る必要があります。交差点を見つけるために使用しているアルゴリズムは、ここにあります。
lineInt[L_, M_, EPS_: 10^-6] := Module[
{x21, y21, x43, y43, x13, y13, numL, numM, den},
{x21, y21} = L[[2]] - L[[1]];
{x43, y43} = M[[2]] - M[[1]];
{x13, y13} = L[[1]] - M[[1]];
den = y43*x21 - x43*y21;
If[den*den < EPS, Return[-Infinity]];
numL = (x43*y13 - y43*x13)/den;
numM = (x21*y13 - y21*x13)/den;
If[numM < 0 || numM > 1, Return[-Infinity], Return[numL]];
]
lineIntLと が一致しMないと仮定します。-Infinity線が平行であるか、線分を含む線がL線分と交差していない場合に返されますM。を含むL線が線分と交差する場合M、スカラーを返します。このスカラーを とするとu、交点はL[[1]] + u (L[[2]]-L[[1]])です。uが任意の実数であっても問題ないことに注意してください。この操作関数をいじって、どのように機能するかをテストできますlineInt。
Manipulate[
Grid[{{
Graphics[{
Line[{p1, p2}, VertexColors -> {Red, Red}],
Line[{p3, p4}]
},
PlotRange -> 3, Axes -> True],
lineInt[{p1, p2}, {p3, p4}]
}}],
{{p1, {-1, 1}}, Locator, Appearance -> "L1"},
{{p2, {2, 1}}, Locator, Appearance -> "L2"},
{{p3, {1, -1}}, Locator, Appearance -> "M1"},
{{p4, {1, 2}}, Locator, Appearance -> "M2"}
]
L[[1]]線分までどこまで移動する必要があるかがわかったので、線分Mのどの部分が三角形内にあるかを調べることができます。
lineInTri[L_, T_] := Module[{res},
If[Length@DeleteDuplicates[Flatten[{T, L}, 1], SquaredEuclideanDistance[#1, #2] < 10^-6 &] == 3, Return[{}]];
res = Sort[Map[lineInt[L, #] &, {{T[[1]], T[[2]]}, {T[[2]], T[[3]]}, {T[[3]], T[[1]]} }]];
If[res[[3]] == Infinity || res == {-Infinity, -Infinity, -Infinity}, Return[{}]];
res = DeleteDuplicates[Cases[res, _Real | _Integer | _Rational], Chop[#1 - #2] == 0 &];
If[Length@res == 1, Return[{}]];
If[(Chop[res[[1]]] == 0 && res[[2]] > 1) || (Chop[res[[2]] - 1] == 0 && res[[1]] < 0), Return[{0, 1}]];
If[(Chop[res[[2]]] == 0 && res[[1]] < 0) || (Chop[res[[1]] - 1] == 0 && res[[2]] > 1), Return[{}]];
res = {Max[res[[1]], 0], Min[res[[2]], 1]};
If[res[[1]] > 1 || res[[1]] < 0 || res[[2]] > 1 || res[[2]] < 0, Return[{}], Return[res]];
]
Lこの関数は、削除する必要がある行の部分を返します。たとえば、これが返さ{.5, 1}れた場合は、セグメントの半分からセグメントの終点まで、行の 50% を削除することを意味します。L = {A, B}関数が返された場合{u, v}、これは、線分{A+(B-A)u, A+(B-A)v}が三角形に含まれる線のセクションであることを意味しますT。
実装するときは、線が のエッジの 1 つにならないlineInTriように注意する必要があります。この場合、線は三角形の内側にありません。これは、丸め誤差が問題になる可能性がある場所です。Mathematica のときLT画像をエクスポートすると、線が三角形の端にあることがありますが、これらの座標は多少異なります。線がエッジにどれだけ近いかを決定するのは私たち次第です。そうでない場合、関数は線がほぼ完全に三角形の内側にあることを認識します。これが関数の最初の行の理由です。線が三角形の辺にあるかどうかを確認するには、三角形と線のすべての点をリストし、すべての重複を削除します。この場合、重複とは何かを指定する必要があります。最終的に 3 つのポイントのリストが得られた場合、これは線がエッジ上にあることを意味します。次の部分は少し複雑です。私たちがしているLのは、三角形の各辺との線の交点をチェックすることですTこの結果をリストに保存します。次に、リストを並べ替えて、線のどの部分が三角形に含まれているかを調べます。いくつかのテストには、線の端点が三角形の頂点であるかどうか、線が完全に三角形の内側にあるか、部分的に内側にあるか、完全に外側にあるかのチェックが含まれます。
Manipulate[
Grid[{{
Graphics[{
RGBColor[0, .5, 0, .5], Polygon[{p3, p4, p5}],
Line[{p1, p2}, VertexColors -> {Red, Red}]
},
PlotRange -> 3, Axes -> True],
lineInTri[{p1, p2}, {p3, p4, p5}]
}}],
{{p1, {-1, -2}}, Locator, Appearance -> "L1"},
{{p2, {0, 0}}, Locator, Appearance -> "L2"},
{{p3, {-2, -2}}, Locator, Appearance -> "T1"},
{{p4, {2, -2}}, Locator, Appearance -> "T2"},
{{p5, {-1, 1}}, Locator, Appearance -> "T3"}
]
lineInTri線のどの部分が描画されないかを確認するために使用されます。この線は、多くの三角形で覆われている可能性が高いです。このため、描画されない各線のすべての部分のリストを保持する必要があります。これらのリストには順序がありません。私たちが知っているのは、このリストが 1 次元のセグメントであることだけです。それぞれが[0,1]間隔内の数字で構成されています。1 次元セグメントのユニオン関数を認識していないため、ここに私の実装を示します。
union[obj_] := Module[{p, tmp, dummy, newp, EPS = 10^-3},
p = Sort[obj];
tmp = p[[1]];
If[tmp[[1]] < EPS, tmp[[1]] = 0];
{dummy, newp} = Reap[
Do[
If[(p[[i, 1]] - tmp[[2]]) > EPS && (tmp[[2]] - tmp[[1]]) > EPS,
Sow[tmp]; tmp = p[[i]],
tmp[[2]] = Max[p[[i, 2]], tmp[[2]]]
];
, {i, 2, Length@p}
];
If[1 - tmp[[2]] < EPS, tmp[[2]] = 1];
If[(tmp[[2]] - tmp[[1]]) > EPS, Sow[tmp]];
];
If[Length@newp == 0, {}, newp[[1]]]
]
この関数はもっと短くなりますが、ここでは数値が 0 に近いか 1 に近いかを確認する if ステートメントをいくつか含めました。1 つの数値がEPS0 から離れている場合、この数値を 0 にします。同じことが 1 にも当てはまります。ここで取り上げるもう 1 つの側面は、表示するセグメントの部分が比較的小さい場合は、削除する必要がある可能性が高いということです。たとえば、{{0,.5}, {.500000000001}}これがある場合、描画する必要があることを意味し{{.5, .500000000001}}ます。しかし、この線分は非常に小さいため、大きな線分の中でも特に気付くことさえあります。なぜなら、これら 2 つの数が同じであることはわかっているからです。を実装する際には、これらすべてを考慮する必要がありますunion。
これで、ライン セグメントから何を削除する必要があるかを確認する準備が整いました。次に、 から生成されG3ToG2Infoたオブジェクトのリスト、このリストのオブジェクト、およびインデックスが必要です。
getSections[L_, obj_, start_ ] := Module[{dummy, p, seg},
{dummy, p} = Reap[
Do[
If[Length@obj[[i]] == 3,
seg = lineInTri[L, obj[[i]]];
If[Length@seg != 0, Sow[seg]];
]
, {i, start, Length@obj}
]
];
If[Length@p == 0, Return[{}], Return[union[First@p]]];
]
getSectionsから削除する必要がある部分を含むリストを返しますL。それobjが三角形、線、色のリストであることはわかっています。リスト内のインデックスが高いオブジェクトは、インデックスが低いオブジェクトの上に描画されることがわかっています。このため、 index が必要startです。これは、 で三角形の検索を開始するインデックスobjです。三角形を見つけたら、関数 を使用して三角形にあるセグメントの部分を取得しますlineInTri。最後に、 を使用して結合できるセクションのリストが完成しunionます。
最後に、 に到達しgetHiddenLinesます。これに必要なのは、 によって返されたリスト内の各オブジェクトを見てG3ToG2Info、 function を適用することだけgetSectionsです。getHiddenLinesリストのリストを返します。各要素は、削除する必要があるセクションのリストです。
getHiddenLines[obj_] := Module[{pts},
pts = Table[{}, {Length@obj}];
Do[
If[Length@obj[[j]] == 2,
pts[[j]] = getSections[obj[[j]], obj, j + 1]
];
, {j, Length@obj}
];
Return[pts];
]
getFrame
ここまでの概念をなんとか理解できたなら、次に何が行われるかを知っていると確信しています。三角形、線、色のリストと、削除する必要がある線のセクションがある場合は、表示されている色と線のセクションのみを描画する必要があります。最初にcomplement関数を作成します。これにより、何を描画するかが正確にわかります。
complement[obj_] := Module[{dummy, p},
{dummy, p} = Reap[
If[obj[[1, 1]] != 0, Sow[{0, obj[[1, 1]]}]];
Do[
Sow[{obj[[i - 1, 2]], obj[[i, 1]]}]
, {i, 2, Length@obj}
];
If[obj[[-1, 2]] != 1, Sow[{obj[[-1, 2]], 1}]];
];
If[Length@p == 0, {}, Flatten@ First@p]
]
今getFrame関数
getFrame[obj_, pts_] := Module[{dummy, lines, L, u, d},
{dummy, lines} = Reap[
Do[
L = obj[[i]];
If[Length@L == 2,
If[Length@pts[[i]] == 0, Sow[L]; Continue[]];
u = complement[pts[[i]]];
If[Length@u > 0,
Do[
d = L[[2]] - L[[1]];
Sow[{L[[1]] + u[[j - 1]] d, L[[1]] + u[[j]] d}]
, {j, 2, Length@u, 2 }]
];
];
If[Length@L == 1, Sow[L]];
, {i, Length@obj}]
];
First@lines
]
最後の言葉
アルゴリズムの結果にはやや満足しています。私が気に入らないのは実行速度です。これは、C/C++/Java でループを使用する場合と同じように記述しました。関数を使用する代わりに、成長するリストを使用Reapして作成するために最善を尽くしました。これらすべてに関係なく、ループを使用する必要がありました。なお、ここに掲載されているワイヤーフレーム画像は、生成に63秒かかりました。質問の絵をワイヤーフレームにしてみましたが、この3Dオブジェクトには約32000個のオブジェクトが含まれています。ラインに表示する必要がある部分を計算するのに約 13 秒かかりました。32000 行あり、すべての計算を実行するのに 13 秒かかると仮定すると、計算時間は約 116 時間になります。SowAppend
すべてのルーチンで関数を使用し、ループCompileを使用しない方法を見つければ、この時間を短縮できると確信しています。Doここでヘルプを得ることができますか? Stack Overflow?
ご参考までに、コードをウェブにアップロードしました。ここで見つけることができます。このコードの修正版を質問のプロットに適用し、ワイヤー フレームを表示できる場合は、この投稿への回答としてあなたのソリューションをマークします。
ベスト、J・マヌエル・ロペス
