У меня есть функция r(x), что я хочу вращаться вокруг x оси, чтобы получить тело вращения, что я хотел бы добавить к существующему plot_ly участка с использованием add_surface (окрасили x).
Вот пример:
library(dplyr)
library(plotly)
# radius depends on x
r <- function(x) x^2
# interval of interest
int <- c(1, 3)
# number of points along the x-axis
nx <- 20
# number of points along the rotation
ntheta <- 36
# set x points and get corresponding radii
coords <- data_frame(x = seq(int[1], int[2], length.out = nx), r = r(x))
# for each x: rotate r to get y and z coordinates
# edit: ensure 0 and pi are both amongst the angles used
coords %<>%
rowwise() %>%
do(data_frame(x = .$x, r = .$r,
theta = seq(0, pi, length.out = ntheta / 2 + 1) %>%
c(pi + .[-c(1, length(.))]))) %>%
ungroup %>%
mutate(y = r * cos(theta), z = r * sin(theta))
# plot points to make sure the coordinates define the desired shape
coords %>%
plot_ly(x = ~x, y = ~y, z = ~z, color = ~x) %>%
add_markers()
Как я могу сформировать фигуру, указанную выше, как поверхность plotly (идеально открытую с обоих концов)?
Редактировать (1):
Вот моя лучшая попытка:
# get all x & y values used (sort to connect halves on the side)
xs <-
unique(coords$x) %>%
sort
ys <-
unique(coords$y) %>%
sort
# for each possible x/y pair: get z^2 value
coords <-
expand.grid(x = xs, y = ys) %>%
as_data_frame %>%
mutate(r = r(x), z2 = r^2 - y^2)
# format z coordinates above x/y plane as matrix where columns
# represent x and rows y
zs <- matrix(sqrt(coords$z2), ncol = length(xs), byrow = TRUE)
# format x coordiantes as matrix as above (for color gradient)
gradient <-
rep(xs, length(ys)) %>%
matrix(ncol = length(xs), byrow = TRUE)
# plot upper half of shape as surface
p <- plot_ly(x = xs, y = ys, z = zs, surfacecolor = gradient,
type = "surface", colorbar = list(title = 'x'))
# plot lower have of shape as second surface
p %>%
add_surface(z = -zs, showscale = FALSE)
Хотя это дает желаемую форму,
- Он имеет "зубы бритвы" близко к плоскости
x/y. -
Части половины не касаются.(разрешен путем включения0иpiвthetaвекторы) -
Я не понял, как покрасить его вместо(разрешеноxвместоz(хотя я пока не очень разбираюсь в этом).gradientматрицей)
edit (2):
Вот попытка использовать одну поверхность:
# close circle in y-direction
ys <- c(ys, rev(ys), ys[1])
# get corresponding z-values
zs <- rbind(zs, -zs[nrow(zs):1, ], zs[1, ])
# as above, but for color gradient
gradient <-
rbind(gradient, gradient[nrow(gradient):1, ], gradient[1, ])
# plot single surface
plot_ly(x = xs, y = ys, z = zs, surfacecolor = gradient,
type = "surface", colorbar = list(title = 'x'))
Удивительно, но в то время как это должно соединить две половины, ортогональные плоскости x/y две создают полную форму, она по-прежнему страдает от того же эффекта "бритвенных зубов", что и выше:
edit (3):
Оказывается, недостающие части возникают из-за того, что z -values является NaN когда он близок к 0:
# color points 'outside' the solid purple
gradient[is.nan(zs)] <- -1
# show those previously hidden points
zs[is.nan(zs)] <- 0
# plot exactly as before
plot_ly(x = xs, y = ys, z = zs, surfacecolor = gradient,
type = "surface", colorbar = list(title = 'x'))
Это может быть вызвано численной неустойчивостью подстановки, когда r^2 и y слишком близки, что приводит к отрицательному вводу для sqrt где фактический ввод все еще неотрицателен.
Эти швы не связаны с численными проблемами, так как даже при рассмотрении +-4 "близко" к нулю эффект "бритвенных зубов" нельзя полностью исключить:
# re-calculate z-values rounding to zero if 'close'
eps <- 4
zs <- with(coords, ifelse(abs(z2) < eps, 0, sqrt(z2))) %>%
matrix(ncol = length(xs), byrow = TRUE) %>%
rbind(-.[nrow(.):1, ], .[1, ])
# plot exactly as before
plot_ly(x = xs, y = ys, z = zs, surfacecolor = gradient,
type = "surface", colorbar = list(title = 'x'))
