如何提升R Shiny中Plotly多3D曲面图的渲染速度？

问题背景 #

在Shiny应用中，基于n×m矩阵列表生成多个Plotly 3D曲面图时，当m作为可配置输入变量，渲染速度会随曲面数量增加急剧下降。尝试toWebGL()优化无效，因为Plotly的WebGL渲染暂不支持曲面类型。以下是可接受画质损失前提下的优化方案：

1. 降低网格分辨率 #

减少每个曲面的顶点数量是最直接的性能优化手段。通过对原始矩阵进行降采样，每隔k个点保留一个数据点，大幅降低渲染计算量。

示例降采样函数：

downsample_mat <- function(mat, k) {
  # 每隔k行/列取一个点
  mat[seq(1, nrow(mat), by = k), seq(1, ncol(mat), by = k)]
}

# 应用到整个矩阵列表
mat_list_downsampled <- lapply(mat_list, downsample_mat, k = 2) # k=2表示保留50%的点

使用降采样后的矩阵列表渲染曲面，可显著提升速度，画质损失可控。

2. 禁用冗余渲染特性 #

关闭所有非必需的视觉效果，减少浏览器的渲染计算：

• 关闭光照效果（默认开启会增加计算）
• 禁用轮廓线（contours）
• 关闭场景背景

修改后的绘图代码片段：

fig <- plot_ly(
  x = t(seq(0, 1, length.out = n) %*% t(rep(1, n))),
  y = (seq(0, 1, length.out = n) %*% t(rep(1, n))),
  z = mat_list_downsampled[[1]],
  type = "surface",
  cauto = FALSE, cmin = -1.5, cmax = 1.5,
  showscale = FALSE,
  hoverinfo = "none",
  lighting = list(enabled = FALSE), # 关闭光照
  contours = list(x = list(enabled = FALSE), y = list(enabled = FALSE), z = list(enabled = FALSE)) # 禁用轮廓线
)

for (s in 2:length(mat_list_downsampled)) {
  fig <- add_surface(fig, z = mat_list_downsampled[[s]], 
                     showscale = FALSE, hoverinfo = "none",
                     lighting = list(enabled = FALSE),
                     contours = list(x = list(enabled = FALSE), y = list(enabled = FALSE), z = list(enabled = FALSE)))
}

# 布局中关闭场景背景
fig <- layout(fig, scene = list(
  camera = list(eye = list(x = -1.5, y = -1.5, z = .8)),
  xaxis = list(title = 'x<sub>1</sub>', showspikes = FALSE),
  yaxis = list(title = 'x<sub>2</sub>', showspikes = FALSE),
  zaxis = list(title = 'B<sub>k</sub>(x<sub>1</sub>, x<sub>2</sub>)', showspikes = FALSE, range = list(-1.5, 1.5)),
  showbackground = FALSE # 关闭背景
))

3. 缓存预计算数据 #

在Shiny中，避免每次输入m变化都重新生成矩阵列表和渲染曲面。使用bindCache缓存反应式计算结果：

# 在Shiny的server函数中
mat_list_reactive <- reactive({
  n <- 15
  m <- input$m
  mat <- matrix(runif(n*m), nrow = n, ncol = m)
  mat_list <- list()
  for (t in 1:m) {
    for (s in 1:m) {
      mat_list[[length(mat_list) + 1]] <- (mat [, t] %*% t(mat [, s]))
    }
  }
  # 同时应用降采样
  lapply(mat_list, downsample_mat, k = 2)
}) %>% bindCache(input$m) # 缓存基于input$m的结果

# 渲染图表时使用缓存后的结果
output$plot <- renderPlotly({
  mat_list <- mat_list_reactive()
  # 后续绘图代码...
})

4. 合并相似曲面（可选） #

如果部分曲面的z值差异极小，可将它们合并为一个曲面，减少总曲面数量。例如设置阈值，当两个曲面的最大绝对差小于阈值时合并：

merge_similar_surfaces <- function(mat_list, threshold = 0.01) {
  merged_list <- list(mat_list[[1]])
  for (mat in mat_list[-1]) {
    # 检查是否与已合并的曲面相似
    similar <- any(sapply(merged_list, function(m) max(abs(m - mat)) < threshold))
    if (!similar) {
      merged_list <- c(merged_list, list(mat))
    }
  }
  merged_list
}

# 应用合并
mat_list_merged <- merge_similar_surfaces(mat_list_downsampled)

此方法需根据业务场景调整阈值，确保合并后的曲面仍能满足可视化需求。

内容的提问来源于stack exchange，提问作者kruze