如何在R的Plotly中绘制mesh3d对象？RGL可绘但Plotly无输出

我尝试在Plotly中绘制一个在RGL里能正常显示的三角网格，因偏好Plotly的数据悬停交互功能，优先选择Plotly方案，也接受RGL的替代方案。

复现数据与依赖库 #

library(rgl)
library(plotly)
library(SurfaceReconstruction)
library(dplyr)

plot_issue_dat <- structure(c(-2.058, -3.02, 4.437, -3.02, 5.8, 4.985, -0.715, 
4.985, 5.8, -0.715, -2.058, 5.458, 5.061, 12.443, 4.943, 4.471, 
6.809, 6.809, -3.024, -3.024, -116.181, -115.799, -116.153, -115.799, 
-115.493, -107.238, -115.701, -107.238, -115.493, -115.701, -116.181, 
-107.907, -115.557, -105.538, -111.077, -114.791, -114.172, -114.172, 
-114.397, -114.397, 203.556, 203.187, 205.384, 203.187, 205.988, 
192.985, 202.444, 192.985, 205.988, 202.444, 203.556, 193.987, 
207.515, 198.121, 198.177, 210.117, 208.797, 208.797, 201.275, 
201.275), dim = c(20L, 3L), dimnames = list(NULL, c("surf_x", 
"surf_y", "surf_z")))

我通过点云数据，使用Advancing Front Reconstruction算法生成了mesh3d对象：

plot_issue_mesh <- SurfaceReconstruction::AFSreconstruction(plot_issue_dat)

> class(plot_issue_mesh)
[1] "mesh3d"

该对象可在RGL中正常绘制：

mfrow3d(1, 2, sharedMouse = TRUE)
wire3d(plot_issue_mesh) 
axes3d()  
next3d()
points3d(x=plot_issue_dat[,1], 
       y=plot_issue_dat[,2], 
       z=plot_issue_dat[,3])
axes3d()  

但将顶点和面数据转换后传入Plotly时，无任何图形输出：

plot_ly_dat_vert <- plot_issue_mesh$vb |> t()
plot_ly_dat_face <- plot_issue_mesh$it |> t()

plot_ly()|>
  add_trace(
    type="mesh3d",
    x = plot_ly_dat_vert[,1],
    y = plot_ly_dat_vert[,2],
    z = plot_ly_dat_vert[,3],
    i = plot_ly_dat_face[,1],
    j = plot_ly_dat_face[,2],
    k = plot_ly_dat_face[,3]
  )

仅单独绘制顶点时Plotly可正常显示：

plot_ly()|>
  add_trace(
    x = plot_ly_dat_vert[,1],
    y = plot_ly_dat_vert[,2],
    z = plot_ly_dat_vert[,3]
  )

版本信息 #

## [1] "R version 4.2.2 Patched (2022-11-10 r83330) Innocent and Trusting"

## [1] "RStudio Version 2022.12.0.353 Elsbeth Geranium"

    package     loadedversion
dplyr   dplyr   1.0.10
ggplot2     ggplot2     3.4.0
knitr   knitr   1.41
plotly  plotly  4.10.1
rgl     rgl     0.110.2
SurfaceReconstruction   SurfaceReconstruction   0.1.0

mesh3d对象详情 #

> plot_issue_mesh$vb
         [,1]     [,2]     [,3]     [,4]     [,5]     [,6]     [,7]     [,8]     [,9]    [,10]    [,11]
[1,]   -0.715   -3.020   -3.024   -2.058    4.437    4.471   12.443    4.985    5.458    5.061    6.809
[2,] -115.701 -115.799 -114.397 -116.181 -116.153 -114.791 -105.538 -107.238 -107.907 -115.557 -114.172
[3,]  202.444  203.187  201.275  203.556  205.384  210.117  198.121  192.985  193.987  207.515  208.797
[4,]    1.000    1.000    1.000    1.000    1.000    1.000    1.000    1.000    1.000    1.000    1.000
        [,12]    [,13]
[1,]    5.800    4.943
[2,] -115.493 -111.077
[3,]  205.988  198.177
[4,]    1.000    1.000

> plot_issue_mesh$it
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16] [,17] [,18]
[1,]    1    4    2    6    8    8    6   12    7     7     9    12    11     1     8     3     6     4
[2,]    2    1    1    3    7    3    2   11    3     6     7     7     6     3     9     8     4     5
[3,]    3    5    4    2    9    7    4   10    6    11    13    11    10    13    13    13    10    10
     [,19] [,20] [,21] [,22]
[1,]    13    10     5     5
[2,]     7     5    13     1
[3,]    12    12    12    13

> plot_issue_mesh$normals
            [,1]       [,2]        [,3]        [,4]       [,5]       [,6]       [,7]       [,8]       [,9]
[1,]  0.04487982 -0.9289559 -0.89572966 -0.29054707  0.2498839 -0.1312339  0.7863605 -0.2423399  0.3724951
[2,] -0.83876795 -0.3494553  0.08686093 -0.95390713 -0.9588761 -0.1204796  0.5823910  0.3784624 -0.7133183
[3,] -0.54263622  0.1221557 -0.43603158  0.07512296 -0.1345901  0.9840032 -0.2060528 -0.8933295 -0.5936534
[4,]  1.00000000  1.0000000  1.00000000  1.00000000  1.0000000  1.0000000  1.0000000  1.0000000  1.0000000
          [,10]      [,11]      [,12]      [,13]
[1,]  0.2388872  0.7250958  0.6054552  0.3288626
[2,] -0.9349205 -0.1093559 -0.7894580 -0.7705457
[3,]  0.2624054  0.6799098 -0.1008973 -0.5459933
[4,]  1.0000000  1.0000000  1.0000000  1.0000000

> plot_issue_mesh$remvert
 [1] 0 0 0 0 0 1 1 1 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[53] 1 1 1 1 1 1 1 1 1 1 1 1 1 1

> plot_issue_mesh$remface
 [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

Plotly方案：修正顶点索引 #

Plotly的mesh3d使用0起始索引，但RGL的mesh3d对象中it矩阵存储的是1起始索引，这是导致渲染失败的核心原因。只需将面索引全部减1即可：

plot_ly_dat_vert <- plot_issue_mesh$vb[1:3,] |> t()  # 只取x/y/z坐标，去掉齐次坐标的第4行
plot_ly_dat_face <- plot_issue_mesh$it |> t() - 1    # 索引从1转0

plot_ly()|>
  add_trace(
    type="mesh3d",
    x = plot_ly_dat_vert[,1],
    y = plot_ly_dat_vert[,2],
    z = plot_ly_dat_vert[,3],
    i = plot_ly_dat_face[,1],
    j = plot_ly_dat_face[,2],
    k = plot_ly_dat_face[,3],
    hoverinfo = "x+y+z"  # 开启悬停显示坐标
  )

补充说明 #

• 转换顶点时可去掉vb矩阵的第4行（齐次坐标的w值，固定为1），不影响渲染
• 加上hoverinfo参数可明确指定悬停时显示的内容，满足交互需求

RGL增强交互方案（备选） #

如果Plotly方案仍有问题，可在RGL中添加悬停交互，使用rglwidget()将RGL图形转为HTML交互式组件：

library(rglwidget)

mfrow3d(1, 1)
wire3d(plot_issue_mesh)
axes3d()
# 添加顶点悬停提示
plot3d(plot_issue_dat, type="s", size=1, col="red", hover=TRUE)

# 导出为可交互的HTML组件
rglwidget()

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