在 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 x y）。您还需要将 z 值拆分为两个单独的表面层，一个用于椭球体的上半部分，一个用于底部。我现在没有时间做这一切，但如果你遇到困难，我可以稍后再解决

Answer 1

这是一种可能性，使用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"))