R +情节：革命的坚实

Question

我有一个函数/etc/stack/config.yaml，我希望围绕r(x)轴旋转，以获得solid of revolution我想要使用{{{{}}}添加到现有x图1}}（由plot_ly着色。）

以下是一个例子：

add_surface

如何将上述点指示的形状生成为x曲面（理想情况下两端都打开）？

编辑（1）：

到目前为止，这是我最好的尝试：

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

虽然这会产生所需的形状，但

1. 它有剃刀牙齿＆＃39;靠近plotly / # 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) 飞机。
2. 两半部分不接触。（通过在x向量中加入y和0来解决 ）
3. 我没有弄清楚如何通过pi而不是theta给它着色（尽管到目前为止我还没有看到它）。（由x矩阵解析）

编辑（2）：

以下是使用单个表面的尝试：

z

令人惊讶的是，虽然这应该连接与gradient / # 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')) 平面正交的两半，但是要创建完整的形状， 它仍然患有同样的剃刀牙齿＆＃39;影响如上所述：



编辑（3）：

事实证明，x产生的缺失部分 - 当接近0时，值为y：

z



当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的负输入，其中实际输入仍为非负

即使考虑到+ -4＆＃39;关闭＆零，剃刀牙齿＆＃39;效果无法完全避免：

y

Answer 1

有趣的问题是，我一直在努力使用表面密度来改进您的解决方案。你可以通过分层多行进行黑客攻击，这对于这种情况很有用。只对原始版本所做的更改是使用更多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()

最佳， 强尼

Answer 2

我已经有了另一个裂缝并且有一个更接近的解决方案，使用＆＃34;表面＆＃34;类型。有用的是查看第一个表面图的结果，其中nx = 5和ntheta = 18.它的jaggardy是因为它连接zs中的列的方式（跨越x点）。它必须从它周围的较大环的一部分向上连接，这导致密度达到峰值以满足这一点。

我无法100％摆脱这种庸俗的行为。我做了这些改变：

1. 在边缘周围添加一些小点：两个密度连接在一起。这减少了jaggardy部分的大小，因为有更多的点靠近边界
2. 计算mod zs到zs2：通过添加0来确保每个环与外环的尺寸相等。
3. 将nx增加到40并将ntheta减少到18 - 更多的x使步长更小。减少ntheta的运行时间，因为我已添加了更多的点

步骤来自于它如何尝试连接x环。从理论上讲，如果你有更多的x环，它应该消除这种不稳定性，但运行起来非常耗时。

我不认为这回答Q 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)

Answer 3

这不会回答您的问题，但会提供您可以在网页中进行互动的结果：请勿使用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)来设置颜色的函数，而不是像我那样重复颜色。< / p>

结果如下：

Answer 4

一种解决方案是翻转轴，使其围绕z轴而不是x轴旋转。我不知道这是否可行，给定现有图表你要添加这个数字，但它确实很容易解决'牙齿'问题。

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

nuget