时间戳

首页 > 解决方案 > R：rgl 将多个图链接到单个小部件

r - R：rgl 将多个图链接到单个小部件

问题描述

我正在尝试将playwidget()滑块链接到多个绘图，以便滑块影响所有绘图。我想在 Rmarkdown 文件中使用它，而不是在 Shiny 应用程序中。

我设法将绘图附加到subsetControl并添加了subscenes控件，但它不能正常工作：第一个子集工作正常，但如果我移动滑块，我会在两个绘图中得到第一个绘图（带有黑色和红色点）。

library(rgl)

open3d() # Remove the earlier display

layout3d(matrix(c(1,2), nrow=1), sharedMouse = T)

next3d()
setosa <- with(subset(iris, Species == "setosa"), 
               spheres3d(Sepal.Length, Sepal.Width, Petal.Length, 
                         col="black",
                         radius = 0.211))
versicolor <- with(subset(iris, Species == "versicolor"), 
                   spheres3d(Sepal.Length, Sepal.Width, Petal.Length, 
                             col="red",
                             radius = 0.211))

next3d()
setosa2 <- with(subset(iris, Species == "setosa"), 
                spheres3d(Sepal.Length, Sepal.Width, Petal.Length, 
                          col="yellow",
                          radius = 0.211))
versicolor2 <- with(subset(iris, Species == "versicolor"), 
                    spheres3d(Sepal.Length, Sepal.Width, Petal.Length, 
                              col="blue",
                              radius = 0.211))


rglwidget() %>%
  playwidget(start = 0, stop = 2, interval = 1,
             subsetControl(1, subscenes = subsceneList(), subsets = list(
               All = c(setosa, setosa2, versicolor, versicolor2),
               Setosa = c(setosa, setosa2),
               Versicolor = c(versicolor, versicolor2)
             )))

标签： rrgl

解决方案

子场景中使用的模型rgl是根拥有所有对象，每个子场景显示其中的一些。您的代码首先在第一个子场景和第二个子场景中显示setosa和，但是子集控件说要在一个子集中显示和在一个子集中，在另一个子集中显示和在另一个子场景中，并在两个子场景中执行此操作。由于和具有相同的形状和位置，因此一次只出现一个：第一个绘制。versicolorsetosa2versicolor2 setosasetosa2 versicolorversicolor2setosasetosa2

为了得到你想要的，你需要两个subsetControls，都由相同的 s 控制playwidget，例如

library(rgl)

open3d() # Remove the earlier display

layout3d(matrix(c(1,2), nrow=1), sharedMouse = T)

next3d()
sub1 <- subsceneInfo()$id
setosa <- with(subset(iris, Species == "setosa"), 
                             spheres3d(Sepal.Length, Sepal.Width, Petal.Length, 
                                                col="black",
                                                radius = 0.211))
versicolor <- with(subset(iris, Species == "versicolor"), 
                                     spheres3d(Sepal.Length, Sepal.Width, Petal.Length, 
                                                        col="red",
                                                        radius = 0.211))

next3d()
sub2 <- subsceneInfo()$id
setosa2 <- with(subset(iris, Species == "setosa"), 
                                spheres3d(Sepal.Length, Sepal.Width, Petal.Length, 
                                                    col="yellow",
                                                    radius = 0.211))
versicolor2 <- with(subset(iris, Species == "versicolor"), 
                                        spheres3d(Sepal.Length, Sepal.Width, Petal.Length, 
                                                            col="blue",
                                                            radius = 0.211))


rglwidget() %>%
    playwidget(start = 0, stop = 2, interval = 1,
                         list(subsetControl(1, subscenes = sub1, subsets = list(
                            All = c(setosa, versicolor),
                            Setosa = setosa,
                            Versicolor = versicolor
                         )),
                         subsetControl(1, subscenes = sub2, subsets = list(
                            All = c(setosa2, versicolor2),
                            Setosa = setosa2,
                            Versicolor = versicolor2
                         ))))

推荐阅读