在 R 中的 WebGL playwidget 中绘制 3D 组动画

Question

我正在使用 R WebGL 创建一个 3D 交互式模型来绘制数据组。下面的脚本用于绘制所有数据组，每组都有单独的颜色。 input.txt中包含的数据只是整体数据的一小部分。重要的是这些是交互式的（鼠标控制缩放和旋转），因此为什么使用 plot3D 而不是其他工具。

library(rgl)
library(plot3D)

d <- ncol(read.table("./input.txt", header = F))
colClasses <- replace(rep("NULL", d), c(1,2,3,4), NA)
d.data <- lapply("./input.txt", read.table, header = F, colClasses = colClasses)
dval <- do.call("rbind", d.data)

df <- data.frame(dval)
colnames(df) <- c("id", "z", "y", "x")

summary(df)

plot3d(x=df$x, y=df$y, z=df$z, col = df$id, type = 's', radius = 2,
  xlab="X", ylab="Y", zlab="Z")

writeWebGL( filename="input.html" ,  width=600, height=600)

读入 input.txt 文件以复制此代码的一个小示例：

我想扩展它以绘制完整数据与一小部分数据。这将包括将每一帧作为每个组的交互式 3D 图 - 就像上面脚本的输出一样，而是让动画每帧只显示 1 个组，并使用播放按钮播放所有组。 https://cran.r-project.org/web/packages/rgl/vignettes/WebGL.html 显示了我想在“控件”>“子集控件”下执行的操作的示例。代码展示了他们是如何做到的：

rglwidget() %>%
playwidget(start = 0, stop = 3, interval = 1,
       subsetControl(1, subsets = list(
                 Setosa = setosa,
                 Versicolor = versicolor,
                 Virginica = virginica,
                 All = c(setosa, versicolor, virginica)
                 )))

我不希望最终图像显示所有组，而且我不能使用与他们上面的示例类似的 list，因为组数会太多。我尝试将他们的示例包含到我的下面的脚本中是行不通的，而只是在没有按钮控件的情况下同时显示 3D 图中的所有组（与原始脚本相同的结果）。

library(rgl)
library(plot3D)

d <- ncol(read.table("./input.txt", header = F))
colClasses <- replace(rep("NULL", d), c(1,2,3,4), NA)
d.data <- lapply("./input.txt", read.table, header = F, colClasses = colClasses)
dval <- do.call("rbind", d.data)

df <- data.frame(dval)
colnames(df) <- c("id", "z", "y", "x")

summary(df)

plotids <- with(df, plot3d(x=df$x, y=df$y, z=df$z, col = df$id, type = 's', radius = 2,
  xlab="X", ylab="Y", zlab="Z"))

rglwidget(elementId = "plot3drgl")

rglwidget() %>%
playwidget(start = 0, stop = 3, interval = 1,
       subsetControl(1, subsets = df$id
                 ))

writeWebGL( filename="input.html" ,  width=600, height=600)

Answer 1

我认为这段代码可以满足您的需求：

# First, plot everything, and save the ids of the objects in the plot
plotids <- with(df,
   plot3d(x=x, y=y, z=z, col = id, type = 's', radius = 2,
          xlab="X", ylab="Y", zlab="Z"))

# Now plot the different ids one at a time:
ids <- list()
for (i in unique(df$id)) 
  ids <- c(ids, list(with(subset(df, id == i), spheres3d(x,y,z,col=id,radius = 2))))

# Add the full dataset to the list of ids
ids <- c(ids, all = plotids["data"])

# Now plot the scene and add the playwidget.
rglwidget() %>%
  playwidget(start = 0, stop = length(ids) - 1, interval = 1,
             subsetControl(1, subsets = ids,
             ))

要将其保存在文件中而不是立即显示，请将其包装在 htmlwidgets::saveWidget 中，或将其包含在 R Markdown 文档中。不要使用已弃用的 writeWebGL，它对 playwidget 部分一无所知。

在 R 中的 WebGL playwidget 中绘制 3D 组动画

Plot 3D group animation in WebGL playwidget in R

r

rgl