在 R Plotly 中用曲面椭圆绘制 Ellipse3d

Question

与此处的问题类似，但这并没有完全满足我的需求，我无法弄清楚：Plot ellipse3d in R plotly?。我想在情节中重新创建 rgl 的 ellipse3d 和表面椭球。我知道有一个允许绘制椭圆的anwer，但作为单独的不透明标记，我需要将其作为一个稍微不透明的表面椭圆体，这样我仍然可以看到椭圆体中的数据点。

我试图弄清楚 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"))