Построение Ellipse3d в R Plotly с эллипсом поверхности

Question

Похоже на вопрос здесь, но это не дало мне того, что мне нужно, и я не мог понять: График ellipse3d в R заговор? .Я хочу воссоздать эллипсоид rgl и поверхностный эллипсоид на графике.Я знаю, что там был ответ, который позволял построить эллипс, но как отдельные непрозрачные маркеры, мне нужно получить его как поверхностный эллипсоид, который немного непрозрачен, чтобы я мог видеть точки данных в эллипсоиде.

Iпытался выяснить, как вместо этого работает комментарий 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

* 1010Их комментарий о том, как использовать add_surface, был

Обратите внимание, что для простоты я нарисовал эллипс как облако с использованием маркеров.Если вы хотите использовать вместо него add_surface, вам сначала нужно будет преобразовать эллипс в другой формат с вектором местоположений x, вектором местоположений y, z в качестве матрицы (размеры равны x по y).Вам также нужно разделить значения z на два отдельных поверхностных слоя, один для верхней половины эллипсоида и один для нижнего.У меня сейчас нет времени делать все это, но если вы застрянете, я смогу решить это позже

Answer 1

Это мое решение, если кому-то это интересно.Это позволяет использовать кнопки на графике для включения и выключения эллипсоида, так что вы по-прежнему можете зависать и выбирать точки данных внутри эллипсоида при желании:

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"))