使用misc3d绘制平滑的隐式曲面

Question

misc3d软件包提供了行进立方体算法的出色实现，允许绘制隐式曲面。

例如，让我们绘制一个Dupin环化物：

a = 0.94; mu = 0.56; c = 0.34 # cyclide parameters
f <- function(x, y, z, a, c, mu){ # implicit equation f(x,y,z)=0
  b <- sqrt(a^2-c^2)
  (x^2+y^2+z^2-mu^2+b^2)^2 - 4*(a*x-c*mu)^2 - 4*b^2*y^2
}
# define the "voxel"
nx <- 50; ny <- 50; nz <- 25
x <- seq(-c-mu-a, abs(mu-c)+a, length=nx) 
y <- seq(-mu-a, mu+a, length=ny)
z <- seq(-mu-c, mu+c, length=nz) 
g <- expand.grid(x=x, y=y, z=z)
voxel <- array(with(g, f(x,y,z,a,c,mu)), c(nx,ny,nz))
# plot the surface
library(misc3d)
surf <- computeContour3d(voxel, level=0, x=x, y=y, z=z)
drawScene.rgl(makeTriangles(surf))

很好，除了表面不光滑。 drawScene.rgl的文档中说：“特定于对象的渲染功能（例如，平滑度和材质是通过在对象中进行设置来控制的。” ）我不知道这是什么意思。如何获得光滑的表面？

我有一个解决方案，但不是一个简单的解决方案：该解决方案包括根据mesh3d的输出构建一个computeContour3d对象，并将表面法线包括在此mesh3d中。

由f(x,y,z)=0定义的隐式表面的表面法线仅由f的梯度给出。对于这个例子，不难得出梯度。

gradient <- function(xyz,a,c,mu){
  x <- xyz[1]; y <- xyz[2]; z <- xyz[3]
  b <- sqrt(a^2-c^2)
  c(
    2*(2*x)*(x^2+y^2+z^2-mu^2+b^2) - 8*a*(a*x-c*mu),
    2*(2*y)*(x^2+y^2+z^2-mu^2+b^2) - 8*b^2*y,
    2*(2*z)*(x^2+y^2+z^2-mu^2+b^2)
  )
}

然后，法线计算如下：

normals <- apply(surf, 1, function(xyz){
  gradient(xyz,a,c,mu)
})

现在我们准备制作mesh3d对象：

mesh <- list(vb = rbind(t(surf),1),
             it = matrix(1:nrow(surf), nrow=3),
             primitivetype = "triangle", 
             normals = rbind(-normals,1))
class(mesh) <- c("mesh3d", "shape3d")

最后使用rgl进行绘制：

library(rgl)
shade3d(mesh, color="red")

很好，现在表面很光滑。

但是，有没有更直接的方法来获得光滑的表面，而无需构建mesh3d对象？它们在文档中是什么意思：“特定于对象的渲染功能，例如平滑和材质是通过在对象中进行设置来控制的。”

Answer 1

我不知道文档的建议。但是，使用addNormals()函数自动计算法线，而不是通过公式计算，可以比使用网格对象稍微容易一些（尽管结果不太理想）。

以下是步骤：

像您一样计算表面。

创建不包含法线的网格。基本上就是您要做的，但是使用tmesh3d()：

mesh <- tmesh3d(t(surf), matrix(1:nrow(surf), nrow=3), homogeneous = FALSE)

计算哪些顶点与其他顶点重复：

verts <- apply(mesh$vb, 2, function(column) paste(column, collapse = " "))
firstcopy <- match(verts, verts)

重写索引以使用第一个副本。这是必要的，因为misc3d函数提供了一系列断开的三角形；我们需要找出哪些连接。

it <- as.numeric(mesh$it)
it <- firstcopy[it]
dim(it) <- dim(mesh$it)
mesh$it <- it

这时，网格中有许多未使用的顶点。如果内存有问题，您可能需要添加一个步骤将其删除。我要跳过它。

添加法线

mesh <- addNormals(mesh)

这里是镜头前后。左没有法线，右与他们同在。

这不像使用计算法线的解决方案那么平滑，但是要找到它们并不总是那么容易。

Answer 2

smooth函数中有一个选项makeTriangles：

drawScene.rgl(makeTriangles(surf, smooth=TRUE))

我认为结果等同于@ user2554330的解决方案，但这更简单。