jml*_*pez 9 plot wolfram-mathematica wireframe mathematica-8
Mathematica是否支持线框图像的隐藏线移除?如果情况并非如此,那么有没有人遇到过这样的方法呢?让我们从这开始:
Plot3D[Sin[x+y^2], {x, -3, 3}, {y, -2, 2}, Boxed -> False]
Run Code Online (Sandbox Code Playgroud)
要创建线框,我们可以:
Plot3D[Sin[x+y^2], {x, -3, 3}, {y, -2, 2}, Boxed -> False, PlotStyle -> None]
Run Code Online (Sandbox Code Playgroud)
我们可以做的一件事就是将所有表面着色为白色.然而,这是不希望的.原因是因为如果我们将这个隐藏的线框架模型导出为pdf,我们将拥有Mathematica用于渲染图像的所有白色多边形.我希望能够以pdf和/或eps格式获得隐藏线移除的线框.
我已经发布了这个问题的解决方案.问题是代码运行速度很慢.在当前状态下,它无法在此问题中为图像生成线框.随意玩我的代码.我在帖子的末尾添加了一个链接.您也可以在此链接中找到代码
在这里我提出一个解决方案 首先,我将展示如何使用生成线框的函数,然后我将详细解释构成算法的其余函数.
wireFrame
wireFrame[g_] := Module[{figInfo, opt, pts},
{figInfo, opt} = G3ToG2Info[g];
pts = getHiddenLines[figInfo];
Graphics[Map[setPoints[#] &, getFrame[figInfo, pts]], opt]
]
Run Code Online (Sandbox Code Playgroud)
该功能的输入是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]]
]
Run Code Online (Sandbox Code Playgroud)
现在我们应用该功能wireFrame
.
wireFrame[fig]
Run Code Online (Sandbox Code Playgroud)
如您所见,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}
]
Run Code Online (Sandbox Code Playgroud)
此代码是数学8版本7中您将要替换JoinedCurve
的功能getPoints
的Line
.该函数getPoints
假定您正在提供原始Graphics
对象.它将看到它收到的对象类型,然后从中提取所需的信息.如果是多边形,则获得3个点的列表,对于一条线,它获得2个点的列表,如果它是一个颜色,则它获得包含3个点的单个列表的列表.这样做是为了保持与列表的一致性.
该功能setPoints
与此相反getPoints
.您输入一个点列表,它将确定它是否应返回多边形,线条或颜色.
获取我们使用的三角形,线条和颜色的列表G3ToG2Info
.此函数将使用
ExportString
和从版本ImportString
获取Graphics
对象Graphics3D
.此信息存储在obj
.我们需要进行一些清理工作,首先我们可以选择obj
.这部分是必要的,因为它可能包含PlotRange
图像.然后,我们得到的所有Polygon
,JoinedCurve
并RGBColor
作为描述对象获得基本图形和指令.最后,我们将函数getPoints
应用于所有这些对象,以获得三角形,线条和颜色的列表.这部分涵盖了这一行{figInfo, opt} = G3ToG2Info[g]
.
getHiddenLines
我们希望能够知道线条的哪个部分不会显示.为此,我们需要知道两个线段之间的交点.我可以在这里找到我用来找到交集的算法.
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]];
]
Run Code Online (Sandbox Code Playgroud)
lineInt
假定线L
和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"}
]
Run Code Online (Sandbox Code Playgroud)
现在我们已经知道如何到达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]];
]
Run Code Online (Sandbox Code Playgroud)
此函数返回L
需要删除的行部分.例如,如果它返回,则{.5, 1}
意味着您将删除该行的50%,从段的一半开始到段的结束点.如果L = {A, B}
和函数返回{u, v}
则这意味着线段{A+(B-A)u, A+(B-A)v}
是包含在三角形中的线的部分T
.
在实现时,lineInTri
你需要注意线条L
不是边缘之一T
,如果是这种情况,则线条不在三角形内.这就是舍入错误可能很糟糕的地方.当Mathematica导出图像时,有时一条线位于三角形的边缘,但这些坐标相差一些.由我们决定线条在边缘上的接近程度,否则函数将看到线条几乎完全位于三角形内部.这是函数第一行的原因.要查看一条线是否位于三角形的边缘,我们可以列出三角形和线条的所有点,并删除所有重复项.在这种情况下,您需要指定重复内容.最后,如果我们得到一个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"}
]
Run Code Online (Sandbox Code Playgroud)
lineInTri
将用于查看不会绘制线条的哪个部分.这条线很可能被许多三角形覆盖.出于这个原因,我们需要保留每行不会被绘制的所有部分的列表.这些清单没有订单.我们所知道的是这个列表是一维段.每个由[0,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]]]
]
Run Code Online (Sandbox Code Playgroud)
这个函数会更短但是在这里我已经包含了一些if语句来检查一个数字是接近零还是一个.如果一个数字EPS
除零,那么我们将这个数字设为零,同样适用于一个数字.我在这里讨论的另一个方面是,如果要显示的段的相对较小部分,则很可能需要删除它.例如,如果我们有{{0,.5}, {.500000000001}}
这个意味着我们需要绘制{{.5, .500000000001}}
.但是这段很小甚至特别是在一个大的线段中被注意到,因为我们知道这两个数字是相同的.在实施时需要考虑所有这些因素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]]];
]
Run Code Online (Sandbox Code Playgroud)
getSections
返回包含需要删除的部分的列表L
.我们知道这obj
是三角形,线条和颜色的列表,我们知道具有较高索引的列表中的对象将被绘制在具有较低索引的对象之上.出于这个原因,我们需要索引start
.这是我们将开始寻找三角形的索引obj
.一旦我们找到一个三角形,我们将使用该函数获得位于三角形中的片段部分lineInTri
.最后,我们将得到一个我们可以使用组合的部分列表union
.
最后,我们来了getHiddenLines
.所有这些要求是查看返回的列表中的每个对象G3ToG2Info
并应用该函数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];
]
Run Code Online (Sandbox Code Playgroud)
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]
]
Run Code Online (Sandbox Code Playgroud)
现在的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
]
Run Code Online (Sandbox Code Playgroud)
我对算法的结果感到满意.我不喜欢的是执行速度.我在C/C++/java中使用循环编写了这个.我尽力使用Reap
并Sow
创建增长列表而不是使用该功能Append
.无论如何,我仍然必须使用循环.应该注意的是,这里发布的线框图片需要63秒才能生成.我尝试为问题中的图片做一个线框,但这个3D对象包含大约32000个对象.计算需要为一条线显示的部分需要大约13秒.如果我们假设我们有32000行,则需要13秒才能完成大约116小时计算时间的所有计算.
如果我们Compile
在所有例程中使用该函数并且可能找到一种不使用Do
循环的方法,我确信这个时间可以减少.我可以在这里获得一些帮助Stack Overflow吗?
为了您的方便,我已将代码上传到网上.你可以在这里找到它.如果您可以将此代码的修改版本应用于问题中的图表并显示线框,我会将您的解决方案标记为此帖子的答案.
最好的,J Manuel Lopez