如何在plotly R中向mesh3d添加网格线

Question

我无法使用 R 中的plotly 包将线框外观添加到mesh3d 图（x 轴和y 轴上的网格线）。

在制作 mesh3d 图时，plotly 表面图的

contours = list(y = list(show = TRUE), x = list(show = TRUE))

参数不起作用（请参阅我的示例代码）。我想使用 mesh3d 图而不是曲面图，因为它更容易跟踪 x 和 y 变量。

具有可重现数据的示例

library(plotly)
library(viridis)

# Define the data
df1 <-data.frame(
  v1 = c(7000, 13000, 19000, 25000, 7000, 13000, 19000, 25000, 7000, 13000, 19000, 25000, 7000, 13000, 19000, 25000),
  v2 = c(10, 10, 10, 10, 66, 66, 66, 66, 178, 178, 178, 178, 312, 312, 312, 312),
  v3 = c(1200.123, 2500.567, 2400.789, 2300.456, 1650.789, 3700.123, 4200.345, 4300.567, 3300.456, 4000.789, 6800.123, 7810.345, 2300.789, 4200.567, 4900.123, 5200.567))


#Surface plot - nice gridlines on x and y axes
Matrix <- xtabs(df1$v3 ~ df1$v1 + df1$v2)

plot_ly(z=~Matrix,
        type = "surface", opacity = .45,
        contours = list(y = list(show = TRUE),
                        x = list(show = TRUE)))

使用plotly输出曲面图

#mesh3d plot - no gridlines, the contours argument does not work!
plot_ly(z = df1$v3, x = df1$v1, y = df1$v2,
        type = "mesh3d", opacity = .45,
        colorscale = "Viridis", intensity = df1$v3,
        contours = list(y = list(show = TRUE),
                        x = list(show = TRUE)))

使用plotly 进行mesh3d 绘图输出

Answer 1

---

Plotly 中没有任何参数可以为您提供所需的内容。不过，您可以手动添加行。

例如，您可以只绘制数据中每组点的线段。

# your plot as depicted in your question
plt <- plot_ly(data = df1, z = ~v3, x = ~v1, y = ~v2, type = "mesh3d", opacity = .45,
               intensity = ~v3)
# the traces for the lines
map2(1:2, 2:1, \(j, k) { 
  plt <<- plt %>%                # add lines for x rows, then add lines for y rows
    add_trace(inherit = F, type = "scatter3d", mode = "lines", 
              data = group2NA(df1, names(df3)[j], ordered = names(df1)[k]), # make them segments
              x = ~v1, y = ~v2, z = ~v3, line = list(color = "black"), showlegend = F)
})

plt %>% colorbar(title = "v3") # fix the colorbar title

如果您希望网格有更多的 x-y 网格线，描绘更多细节，您可以使用每个 x 和 y 组的每条线内每组点的中点。

# your plot as depicted in your question
plt <- plot_ly(data = df1, z = ~v3, x = ~v1, y = ~v2, type = "mesh3d", opacity = .45,
               intensity = ~v3)

# collect line segment midpoints
df3 <- df1
map2(1:2, 2:1, \(j, k) {                # midpoints for x rows, then for y rows
  d1 <- group2NA(df3, names(df3)[j], ordered = names(df3)[k])  # NAs split line segments
  map(1:(nrow(d1) - 1), \(l) {                                 # for each group of 2 rows
    mps <- d1[l:(l + 1), ] %>% map(., mean) %>% unlist()       # find midpoint
    df3 <<- bind_rows(df3, mps) %>% filter(!if_any(everything(), is.na)) %>% distinct() 
  })                                                           # remove NA & any duplicates
})

# plot new line segment data
map2(1:2, 2:1, \(j, k) { 
  plt <<- plt %>%                # add lines for x rows, then add lines for y rows
    add_trace(inherit = F, type = "scatter3d", mode = "lines", 
              data = group2NA(df3, names(df3)[j], ordered = names(df3)[k]), # make them segments
              x = ~v1, y = ~v2, z = ~v3, line = list(color = "black"), showlegend = F)
})

plt %>% colorbar(title = "v3") # fix the colorbar title

如果您有疑问或者这不是您想要的，请告诉我。