R/plotly：如何在曲面上投影任意线？

Question

在许多在线资源中，我们知道如何投影表面的轮廓。 例如，在 https://plotly.com/r/3d-surface-plots/ 的“带轮廓的曲面图”部分中。 方法是在

contours

中使用参数

plotly::add_surface

并指定

project=list(z=TRUE)

。

我的问题是，如何在表面上投影任意线（在

x

、

y

或

z

方向）？ 该任意线使用

plotly::add_paths

定义。

一个愚蠢的解决方案是在

(x,y)

平面上绘制投影曲线，其中

z=0

。

是否有更智能的解决方案，就像轮廓的情况一样，当我更改

(x,y)

时，投影曲线保持在

plotly::layout(scene = ...)

网格上？

library(plotly)

f1 = plot_ly(z = ~volcano)
add_surface(
  p = f1,
  contours = list(z = list(show = TRUE, usecolormap = TRUE, project = list(z = TRUE)))
) # projection of contours, great!

(f2 = plot_ly(z = ~volcano) |> add_surface(colorscale = list(c(0, 1), c('beige', 'lightgreen'))))

x = seq.int(from = 1L, to = dim(volcano)[2L], length.out = 101L)
y = seq.int(from = 1L, to = dim(volcano)[1L], length.out = 101L)
z = volcano[cbind(y,x)]
add_paths(f2, x = x, y = y, z = z) # add an arbitrary line

# now how do I project this arbitrary line to (x,y), (x,z) or (y,z) plane ?

Answer 1

这适用于绘制一条线，即使是您随机选择的一条线。但是，我不完全确定您正在尝试为

add_paths

创建数据。

我确信有不止一种方法可以做到这一点，但这对我有用。

首先，我将数据设置为x、y、z。由于这是一个高程矩阵，我需要知道网格是什么，然后我使用该构建 x 和 y，然后折叠 z。

dim(volcano)
# [1] 87 61 

volc <- data.frame(x = rep(seq(0, 60, by = 1), 87),        # grid is 61 x 87
                   y = rep(seq(0, 86, by = 1), each = 61),
                   z = as.vector(t(volcano)))

现在我可以使用这些数据在表面上构建任何我想要的东西。直线非常简单，过滤

x == ...

或

y == ...

。

我可以使用

add_paths

或

add_trace(type = "scatter3d", mode =...

add_trace(f2, type = "scatter3d", mode = "lines",  # with trace, where y = 50
          data = volc[volc$y == 50, ], x = ~x, y = ~y, z = ~z)
                                                   # with paths, where y = 50
add_paths(f2,  data = volc[volc$y == 50, ], x = ~x, y = ~y, z = ~z)

如果想要 (0, 70) 和 (50, 20) 之间的直线，我可以使用直线公式来实现。

首先是一个 UDF，为了使其更容易一些 - 使用往返坐标和数据框（如

dfa

）。坐标可以是任何顺序，只要是 x, y, x, y 顺序即可。

在此处的图像中看清线条可能有点困难，因此我添加了标记以使其更明显。

cords <- function(x0, y0, x1, y1, dfa) {
  mx <- ifelse(x0 != x1, which(c(x0, x1) == max(c(x0, x1))), 2)
  dx <- c(x0, x1)[mx] - c(x0, x1)[-mx]  # change in X
  dy <- c(y0, y1)[mx] - c(y0, y1)[-mx]  # change in Y                          
  intc <- dy/dx * x0 - y0               # y-intercept     
              # find the relevant rows, using Ax - By + C = 0
 with(dfa, which(dy * x - dx * y - dx * intc == 0))
}     # returns row indices in dfa


add_trace(f2, type = "scatter3d", mode = "lines+markers", # use both for hi-vis
          marker = list(size = 2),                        # but a bit smaller...sheesh
          data = volc[cords(0, 70, 50, 20, volc), ],      # call the line maker for coords
          x = ~x, y = ~y, z = ~z)