R中使用rgl绘制大量3D箭头效率低 有无更高效实现方式？

卡顿核心原因 #

• 逐根循环调用arrow3d()：每次调用arrow3d()都会生成一个独立的rgl三角网格对象，500个箭头就对应500个独立渲染对象。OpenGL渲染大量独立小网格的开销极高，同时Shiny端每次渲染都需要把所有对象序列化传输到前端，对象数量越多延迟越高。
• 全场景重复重建：原有代码在复选框状态变化时，会重新打开rgl设备、重绘所有固定不变的散点、重绘所有箭头，完全没有复用已经生成的场景资源，进一步拉长了卡顿时间。

优化实现 #

1. 批量合并箭头网格，替代逐根循环绘制 #

arrow3d()的返回值本质是单个箭头的三角网格数据，完全可以预先把所有箭头的网格顶点、面索引合并成单个大网格对象，只调用一次绘制函数即可完成所有箭头渲染，性能可以提升两个数量级。
批量箭头生成函数：

library(rgl)
# 批量生成多起点、多方向箭头的合并网格
# start_mat、end_mat均为n行3列矩阵，每行对应一个箭头的起点、终点坐标
arrows3d_batched <- function(start_mat, end_mat, type = "rotation", ...) {
  n_arrows <- nrow(start_mat)
  all_verts <- NULL
  all_faces <- NULL
  vert_offset <- 0
  
  for (i in seq_len(n_arrows)) {
    arrow_mesh <- arrow3d(start_mat[i, ], end_mat[i, ], type = type, ...)
    # 转成笛卡尔坐标
    verts <- t(arrow_mesh$vb[1:3, ] / arrow_mesh$vb[4, ])
    all_verts <- rbind(all_verts, verts)
    # 面索引偏移，避免顶点重复
    faces <- arrow_mesh$ib + vert_offset
    all_faces <- cbind(all_faces, faces)
    vert_offset <- vert_offset + nrow(verts)
  }
  # 构建单一mesh对象
  tmesh3d(
    vertices = t(cbind(all_verts, 1)),
    indices = all_faces,
    material = list(...)
  )
}

非Shiny环境下单次调用即可完成全部箭头绘制，无需循环：

# 500个箭头测试数据
mat0 <- matrix(rep(1:500, 3), ncol = 3)
mat1 <- cbind(
  mat0[,1]*cos(seq(0, 2*pi, length.out = 500)) - mat0[,2]*sin(seq(0, 2*pi, length.out = 500)),
  mat0[,1]*sin(seq(0, 2*pi, length.out = 500)) + mat0[,2]*cos(seq(0, 2*pi, length.out = 500)),
  mat0[,3]
)
mat1 <- mat1 + 0.5

open3d()
plot3d(mat0, aspect = FALSE, axes = FALSE, xlab = "", ylab = "", zlab = "", col = 1)
plot3d(mat1, add = TRUE, col = 2)
# 单次调用绘制全部500个箭头
shade3d(arrows3d_batched(mat0, mat1, type = "rotation", col = "gray30"))

2. Shiny场景优化：增量更新替代全场景重建 #

不要每次输入变化都重建整个rgl场景，把固定不变的散点、箭头网格在应用启动时就预先生成好，复选框切换时只控制箭头的显隐状态，不需要重绘任何内容，切换延迟可以降到毫秒级。
优化后的Shiny代码：

library(shiny)
library(rgl)

# 全局预计算所有数据和箭头网格，应用启动时仅计算一次
mat0 <- matrix(rep(1:500, 3), ncol = 3)
mat1 <- cbind(
  mat0[,1]*cos(seq(0, 2*pi, length.out = 500)) - mat0[,2]*sin(seq(0, 2*pi, length.out = 500)),
  mat0[,1]*sin(seq(0, 2*pi, length.out = 500)) + mat0[,2]*cos(seq(0, 2*pi, length.out = 500)),
  mat0[,3]
)
mat1 <- mat1 + 0.5
precomputed_arrows <- arrows3d_batched(mat0, mat1, type = "rotation", col = "gray30")

ui <- fluidPage(
  titlePanel("Test"),
  sidebarLayout(
    sidebarPanel(
      checkboxInput("cb", "Show Arrows", value = FALSE)
    ),
    mainPanel(
      rglwidgetOutput("threeDPlot", width = "1200px", height = "800px")
    )
  )
)

server <- function(input, output, session) {
  # 初始化rgl场景，仅执行一次
  rgl.open(useNULL = TRUE)
  rgl.bg(color = "white")
  # 绘制固定散点
  points3d(mat0, col = 1)
  points3d(mat1, col = 2)
  arrow_id <- NULL
  
  # 监听复选框状态，仅切换箭头显隐，不重绘场景
  observeEvent(input$cb, {
    if (isTRUE(input$cb)) {
      arrow_id <<- shade3d(precomputed_arrows)
    } else {
      if (!is.null(arrow_id)) pop3d(id = arrow_id)
    }
  })
  
  output$threeDPlot <- renderRglwidget({
    rglwidget()
  })
}

shinyApp(ui = ui, server = server)

相关疑问说明 #

• 关于spriteOrigin参数：该参数服务于sprites3d函数，用于生成始终面向相机的2D精灵贴图，无法渲染不同朝向、不同长度的真3D箭头，确实不适用于当前场景。
• matlib包vectors3d函数：该函数设计目标是绘制共原点的向量集合，不支持每个向量独立设置起点，无法满足需求。
• 性能对比：原有循环绘制+全场景重建方案，500个箭头的切换卡顿约3~5秒；优化后批量网格+增量显隐方案，切换状态延迟小于100ms，无明显卡顿。

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