R + plotly：革命的坚实
R + plotly: solid of revolution
我有一个函数 r(x)，我想围绕 x 轴旋转以获得 solid of revolution，我想将其添加到现有的 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)
虽然这给出了所需的形状，
- 它有 'razor teeth' 接近
x/y 平面。
两半部分不接触。（通过在 theta 中包含 0 和 pi 来解决向量)我没有想出如何用 x 代替 z 给它上色（尽管到目前为止我没怎么研究这个）。（由gradient矩阵解析）
编辑 (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 平面的两半以创建完整的形状，
它仍然受到与上述解决方案相同的 'razor teeth' 影响：
编辑 (3):
事实证明缺少部分是由于 z-值接近 0 时 NaN:
# 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 'close' 为零，'razor teeth' 效应也无法完全避免：
# 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'))
有趣的问题，我一直在努力使用表面密度来改进您的解决方案。您可以通过对多条线进行分层来进行黑客攻击，这对此很不错，例如仅对原始版本所做的更改例如是使用更多的 x 点：nx 到 1000，并将 add_markers 更改为 add_lines。可能不可扩展，但适用于这种大小的数据:)
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 <- 1000
# 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_lines()
最好的，
强尼
我有另一个破解方法，并且有一个更接近的解决方案，使用 "surface" 类型。有用的是查看 nx = 5 和 ntheta = 18 的第一个曲面图的结果。它是锯齿状的原因是因为它 link 在 zs 中向上排列列（跨 x 点）的方式。它必须 link 从它周围较大的环的一部分向上，这会导致密度飙升以满足这一点。
我无法 100% 摆脱这种锯齿状的行为。我做了这些更改：
- 在边缘周围的 theta 上添加一些小点：两个密度连接的地方。这减少了锯齿部分的大小，因为边界附近有更多的点
- 计算 mod zs 到 zs2：通过在内部添加 0，确保每个环与外部环具有相同的尺寸。
- 将 nx 增加到 40 并将 ntheta 减少到 18 - 更多的 x 使步长更小。减少 ntheta 运行 时间，因为我添加了更多点
步骤在于它如何尝试连接 x 环。理论上，如果你有更多的 x 环，它应该消除这种锯齿状，但这对 运行.
来说很耗时
我认为这不能 100% 地回答问题，而且我不确定这个库是否最适合这项工作。如果有任何问题，请联系。
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 <- 40
# number of points along the rotation
ntheta <- 18
# set x points and get corresponding radii
coords <- data_frame(x = seq(int[1], int[2], length.out = nx), r = r(x))
# theta: add small increments at the extremities for the density plot
theta <- seq(0, pi, length.out = ntheta / 2 + 1)
theta <- c(theta, pi + theta)
theta <- theta[theta != 2*pi]
inc <- 0.00001
theta <- c(theta, inc, pi + inc, pi - inc, 2*pi - inc)
theta <- sort(theta)
coords %<>%
rowwise() %>%
do(data_frame(x = .$x, r = .$r, theta = theta)) %>%
ungroup %>%
mutate(y = r * cos(theta), z = r * sin(theta))
# 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)
zs2 <- zs
L <- ncol(zs)
for(i in (L-1):1){
w <- which(!is.na(zs[, (i+1)]) & is.na(zs[, i]))
zs2[w, i] <- 0
}
# 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 = zs2, surfacecolor = gradient,
type = "surface", colorbar = list(title = 'x'))
# plot lower have of shape as second surface
p %>%
add_surface(z = -zs2, showscale = FALSE)
这不会回答您的问题，但会给出您可以在网页中与之交互的结果：不要使用 plot_ly，请使用 rgl。例如，
library(rgl)
# Your initial values...
r <- function(x) x^2
int <- c(1, 3)
nx <- 20
ntheta <- 36
# Set up x and colours for each x
x <- seq(int[1], int[2], length.out = nx)
cols <- colorRampPalette(c("blue", "yellow"), space = "Lab")(nx)
clear3d()
shade3d(turn3d(x, r(x), n = ntheta, smooth = TRUE,
material = list(color = rep(cols, each = 4*ntheta))))
aspect3d(1,1,1)
decorate3d()
rglwidget()
你可以通过一些摆弄在颜色上做得更好：你可能想创建一个使用 x 或 r(x) 来设置颜色的函数，而不是像我那样只是重复颜色.
结果如下：
一种解决方案是翻转轴，使您围绕 z 轴而不是 x 轴旋转。我不知道这是否可行，考虑到您要将此图添加到的现有图表，但它确实很容易解决 'teeth' 问题。
xs <- seq(-9,9,length.out = 20)
ys <- seq(-9,9,length.out = 20)
coords <-
expand.grid(x = xs, y = ys) %>%
mutate(z2 = (x^2 + y^2)^(1/4))
zs <- matrix(coords$z2, ncol = length(xs), byrow = TRUE)
plot_ly(x = xs, y = ys, z = zs, surfacecolor = zs,
type = "surface", colorbar = list(title = 'x')) %>%
layout(scene = list(zaxis = list(range = c(1,3))))
我有一个函数 r(x)，我想围绕 x 轴旋转以获得 solid of revolution，我想将其添加到现有的 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)
虽然这给出了所需的形状，
- 它有 'razor teeth' 接近
x/y平面。 两半部分不接触。（通过在theta中包含0和pi来解决向量)我没有想出如何用（由x代替z给它上色（尽管到目前为止我没怎么研究这个）。gradient矩阵解析）
编辑 (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 平面的两半以创建完整的形状，
它仍然受到与上述解决方案相同的 'razor teeth' 影响：
编辑 (3):
事实证明缺少部分是由于 z-值接近 0 时 NaN:
# 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 'close' 为零，'razor teeth' 效应也无法完全避免：
# 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'))
有趣的问题，我一直在努力使用表面密度来改进您的解决方案。您可以通过对多条线进行分层来进行黑客攻击，这对此很不错，例如仅对原始版本所做的更改例如是使用更多的 x 点：nx 到 1000，并将 add_markers 更改为 add_lines。可能不可扩展，但适用于这种大小的数据:)
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 <- 1000
# 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_lines()
最好的， 强尼
我有另一个破解方法，并且有一个更接近的解决方案，使用 "surface" 类型。有用的是查看 nx = 5 和 ntheta = 18 的第一个曲面图的结果。它是锯齿状的原因是因为它 link 在 zs 中向上排列列（跨 x 点）的方式。它必须 link 从它周围较大的环的一部分向上，这会导致密度飙升以满足这一点。
我无法 100% 摆脱这种锯齿状的行为。我做了这些更改：
- 在边缘周围的 theta 上添加一些小点：两个密度连接的地方。这减少了锯齿部分的大小，因为边界附近有更多的点
- 计算 mod zs 到 zs2：通过在内部添加 0，确保每个环与外部环具有相同的尺寸。
- 将 nx 增加到 40 并将 ntheta 减少到 18 - 更多的 x 使步长更小。减少 ntheta 运行 时间，因为我添加了更多点
步骤在于它如何尝试连接 x 环。理论上，如果你有更多的 x 环，它应该消除这种锯齿状，但这对 运行.
来说很耗时我认为这不能 100% 地回答问题，而且我不确定这个库是否最适合这项工作。如果有任何问题，请联系。
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 <- 40
# number of points along the rotation
ntheta <- 18
# set x points and get corresponding radii
coords <- data_frame(x = seq(int[1], int[2], length.out = nx), r = r(x))
# theta: add small increments at the extremities for the density plot
theta <- seq(0, pi, length.out = ntheta / 2 + 1)
theta <- c(theta, pi + theta)
theta <- theta[theta != 2*pi]
inc <- 0.00001
theta <- c(theta, inc, pi + inc, pi - inc, 2*pi - inc)
theta <- sort(theta)
coords %<>%
rowwise() %>%
do(data_frame(x = .$x, r = .$r, theta = theta)) %>%
ungroup %>%
mutate(y = r * cos(theta), z = r * sin(theta))
# 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)
zs2 <- zs
L <- ncol(zs)
for(i in (L-1):1){
w <- which(!is.na(zs[, (i+1)]) & is.na(zs[, i]))
zs2[w, i] <- 0
}
# 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 = zs2, surfacecolor = gradient,
type = "surface", colorbar = list(title = 'x'))
# plot lower have of shape as second surface
p %>%
add_surface(z = -zs2, showscale = FALSE)
这不会回答您的问题，但会给出您可以在网页中与之交互的结果：不要使用 plot_ly，请使用 rgl。例如，
library(rgl)
# Your initial values...
r <- function(x) x^2
int <- c(1, 3)
nx <- 20
ntheta <- 36
# Set up x and colours for each x
x <- seq(int[1], int[2], length.out = nx)
cols <- colorRampPalette(c("blue", "yellow"), space = "Lab")(nx)
clear3d()
shade3d(turn3d(x, r(x), n = ntheta, smooth = TRUE,
material = list(color = rep(cols, each = 4*ntheta))))
aspect3d(1,1,1)
decorate3d()
rglwidget()
你可以通过一些摆弄在颜色上做得更好：你可能想创建一个使用 x 或 r(x) 来设置颜色的函数，而不是像我那样只是重复颜色.
结果如下：
一种解决方案是翻转轴，使您围绕 z 轴而不是 x 轴旋转。我不知道这是否可行，考虑到您要将此图添加到的现有图表，但它确实很容易解决 'teeth' 问题。
xs <- seq(-9,9,length.out = 20)
ys <- seq(-9,9,length.out = 20)
coords <-
expand.grid(x = xs, y = ys) %>%
mutate(z2 = (x^2 + y^2)^(1/4))
zs <- matrix(coords$z2, ncol = length(xs), byrow = TRUE)
plot_ly(x = xs, y = ys, z = zs, surfacecolor = zs,
type = "surface", colorbar = list(title = 'x')) %>%
layout(scene = list(zaxis = list(range = c(1,3))))