用表面椭圆绘制R Plotly中的Ellipse3d

Question

类似于这里的问题，但这并没有让我兴奋地得到我需要的东西，我无法弄清楚：Plot ellipse3d in R plotly?。我想在剧情中重新创建rgl的ellipse3d和表面椭圆体。我知道那里有一个允许绘制椭圆的凹槽，但作为单独的不透明标记，我需要将它作为一个略微不透明的表面椭球，这样我仍然可以看到椭圆体中的数据点。

我试图弄清楚dww对“add_surface”的评论是如何起作用但却无法弄清楚....有人可以帮忙吗？

if (!require("rgl")) install.packages("rgl")
dt <- cbind(x = rnorm(100), y = rnorm(100), z = rnorm(100))
ellipse <- ellipse3d(cov(dt))
plot3d(dt)
plot3d(ellipse, add = T, color = "red", alpha = 0.5)

dww的回答是：

if (!require("plotly")) install.packages("plotly")
if (!require("rgl")) install.packages("rgl")
dt <- cbind(x = rnorm(100), y = rnorm(100), z = rnorm(100))
ellipse <- ellipse3d(cov(dt))

p <- plot_ly(mode = 'markers') %>% 
  add_trace(type = 'scatter3d', size = 1, 
  x = ellipse$vb[1,], y = ellipse$vb[2,], z = ellipse$vb[3,], 
  opacity=0.01) %>% 
  add_trace(type = 'scatter3d', x = dt[,1], y = dt[,2], z = dt[,3])
p

# shows more obviously what dww's code does to create the visual ellipsoid
w <- plot_ly(mode = 'markers') %>% 
  add_trace(type = 'scatter3d',  
  x = ellipse$vb[1,], y = ellipse$vb[2,], z = ellipse$vb[3,], 
  opacity=0.5) %>% 
  add_trace(type = 'scatter3d', x = dt[,1], y = dt[,2], z = dt[,3])
w

他们对如何使用add_surface的评论是

请注意，为简单起见，我使用标记将椭圆绘制为云。如果要使用add_surface，则必须首先将椭圆转换为不同的格式，其中x位置的矢量，y位置的矢量，z作为矩阵（尺寸等于x乘y）。您还需要将z值拆分为两个单独的表面层，一个用于椭圆体的上半部分，另一个用于底部。我现在没时间做这一切，但是如果你遇到困难我可以稍后解决

Answer 1

如果有人对此感兴趣，这是我的解决方案。这允许使用plotly中的按钮来打开和关闭椭圆体，这样您仍然可以悬停在椭圆体上并在需要时选择椭圆体内的数据点：

if (!require("rgl")) install.packages("rgl", dependencies=TRUE, repos="http://cran.rstudio.com/")
if (!require("plotly")) install.packages("plotly", dependencies=TRUE, repos="http://cran.rstudio.com/")    
dt <- cbind(x = rnorm(100), y = rnorm(100), z = rnorm(100))
ellipse <- ellipse3d(cov(dt))

updatemenus <- list(
  list(
    active = 0,
    type= 'buttons',
    buttons = list(
      list(
        label = "Ellipsoid",
        method = "update",
        args = list(list(visible = c(TRUE, TRUE)))),
      list(
        label = "No Ellipsoid",
        method = "update",
        args = list(list(visible = c(TRUE, FALSE)))))
  )
)

plot<- plot_ly()%>%
  # Plot raw scatter data points
  add_trace(data = dt, x = dt[,1], y = dt[,2], z = dt[,3],
            type = "scatter3d", mode = 'markers', marker = list(size = 3))  %>%
  # Plot ellipsoid 
  add_trace(x=ellipse$vb [1,], y=ellipse$vb [2,], z=ellipse$vb [3,], 
            type='mesh3d', alphahull = 0, opacity = 0.4)%>%
  # Axes Titles
  layout(updatemenus = updatemenus)
plot

Answer 2

这是一种可能性，使用mesh3d类型，并在misc3d包的帮助下。

pts <- cbind(x = rnorm(10), y = rnorm(10), z = rnorm(10))
C <- chol(cov(pts))
SVD <- svd(t(C))
A <- solve(t(SVD$u)) %*% diag(SVD$d)
cr <- colMeans(pts)

r <- sqrt(qchisq(0.95,3)) 

fx <- function(u,v){
  cr[1] + r*(A[1,1]*cos(u)*cos(v) + A[1,2]*cos(u)*sin(v) + A[1,3]*sin(u))
}
fy <- function(u,v){
  cr[2] + r*(A[2,1]*cos(u)*cos(v) + A[2,2]*cos(u)*sin(v) + A[2,3]*sin(u))
}
fz <- function(u,v){
  cr[3] + r*(A[3,1]*cos(u)*cos(v) + A[3,2]*cos(u)*sin(v) + A[3,3]*sin(u))
}

library(misc3d)
tris <- parametric3d(fx, fy, fz, 
                     umin=-pi/2, umax=pi/2, vmin=0, vmax=2*pi, 
                     n=100, engine="none")

n <- nrow(tris$v1)
cont <- matrix(NA_real_, ncol=3, nrow=3*n)
cont[3*(1:n)-2,] <- tris$v1
cont[3*(1:n)-1,] <- tris$v2
cont[3*(1:n),] <- tris$v3
idx <- matrix(0:(3*n-1), ncol=3, byrow=TRUE)

library(plotly)
p <- plot_ly() %>%
  add_trace(type = "mesh3d",
            x = cont[,1], y = cont[,2], z = cont[,3],
            i = idx[,1], j = idx[,2], k = idx[,3],
            opacity = 0.3) %>% 
  add_trace(type = "scatter3d", mode = "markers",
            data = as.data.frame(pts), 
            x = ~x, y = ~y, z = ~z, 
            marker = list(size = 5)) %>% 
  layout(scene = list(aspectmode = "data"))

要添加一些颜色：

midpoints <- (tris$v1 + tris$v2 + tris$v3)/3
distances <- apply(midpoints, 1, function(x) crossprod(x-cr))
intervals <- cut(distances, 256)
colorsPalette <- viridisLite::viridis(256)
colors <- colorsPalette[as.integer(intervals)]

p <- plot_ly() %>%
  add_trace(type = "mesh3d",
            x = cont[,1], y = cont[,2], z = cont[,3],
            i = idx[,1], j = idx[,2], k = idx[,3],
            facecolor = colors,
            opacity = 0.3) %>% 
  add_trace(type = "scatter3d", mode = "markers",
            data = as.data.frame(pts), 
            x = ~x, y = ~y, z = ~z, 
            marker = list(size = 5)) %>% 
  layout(scene = list(aspectmode = "data"))

---

使用Rvcg包的另一种解决方案。我们使用vcgSphere函数生成一个三角形球体。

sphr <- Rvcg::vcgSphere() # triangualted sphere
library(rgl) # to use scale3d and transform3d
ell <- scale3d(transform3d(sphr, A), r, r, r)
vs <- ell$vb[1:3,] + cr
idx <- ell$it - 1
p <- plot_ly() %>%
  add_trace(type="mesh3d",
  x = vs[1,], y = vs[2,], z = vs[3,],
  i = idx[1,], j = idx[2,], k = idx[3,],
  opacity = 0.3) %>% 
  add_trace(type = "scatter3d", mode = "markers",
            data = as.data.frame(pts), 
            x = ~x, y = ~y, z = ~z, 
            marker = list(size = 5)) %>% 
  layout(scene = list(aspectmode = "data"))