将带线框的 3D 表面从 R 导出到 HTML

Question

{rgl} 包中的 writeWebGL 函数可用于将交互式 3D 绘图导出到 HTML（参见下面的示例）。

    require(rgl)
    jet.colors <-colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan",
                 "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
    colorzjet <- jet.colors(100)
    data(volcano)
    z <- 5 * volcano        # Exaggerate the relief
    x <- 10 * (1:nrow(z))   # 10 meter spacing (S to N)
    y <- 10 * (1:ncol(z))  

    open3d()
    bg3d("white")
    material3d(col="black")
    persp3d(x, y, z, col = colorzjet[ findInterval(z, seq(min(z), max(z), length=100))], aspect="iso",axes = TRUE, box = FALSE, smooth=FALSE,lit=FALSE,front="fill")
    surface3d(x, y, z, front = "lines",col="black", lit=FALSE)

    browseURL(paste("file://", writeWebGL(dir=file.path("C:/", "webGL"), width=700), sep=""))

但是，它目前不支持线框或点渲染，这意味着 3D 表面将导出为没有可见边缘的多边形。

有人知道解决办法吗？我希望我的 HTML 文件显示 3D 表面上每个小平面的边缘。

Answer 1

您需要使用低级函数绘制点或边。做积分还算容易：

id <- surface3d(x, y, z, front = "lines",col="black", lit=FALSE)
vertices <- rgl.attrib(id, "vertices")
points3d(vertices)

做线框比较复杂，因为你需要加入正确的顶点。这里有几个函数可以做到这一点。

surfaceData <- function(id) {
  vertices <- rgl.attrib(id, "vertices")
  dim <- rgl.attrib(id, "dim")
  array(vertices, c(dim, 3))
}

surface2lines <- function(data, ...) {
  vertices <- NULL
  for (i in seq_len(dim(data)[1]))
    vertices <- rbind(vertices, data[i,,], c(NA, NA, NA)) 
  for (j in seq_len(dim(data)[2]))
    vertices <- rbind(vertices, data[,j,], c(NA, NA, NA))
  lines3d(vertices, ...) 
}

您调用 surfaceData(id) 来提取曲面的顶点，然后在该数组上调用 surface2lines() 来绘制线条。例如，

id <- surface3d(x, y, z, front = "lines",col="black", lit=FALSE)
d <- surfaceData(id)
open3d()
surface2lines(d)

从您的数据中给出这张图片：

你可以在表面上过度绘制它；你可能需要玩 depth_test 属性让它显示在表面之上。

将带线框的 3D 表面从 R 导出到 HTML

Export 3D surface with wireframe from R to HTML

html

3d

plot

r

rgl