R 和 RGL：如何为球体添加标签？

问题描述

请看下面的reprex。我使用 RGL 创建一组由段链接的球体。我希望能够为每个球体添加一个标签（例如一个数字或一个字母），以便能够单独解决它们（例如，如果我谈论球体“4”或球体“D”，应该清楚哪个球体我在说）。

知道如何实现这一目标吗？

谢谢！

library(rgl)
library(tidyverse)


sphere1.f <- function(x0 = 0,y0 = 0,z0 = 0,r = 1,n = 101,...){
  f <- function(s,t){ 
    cbind(   r * cos(t)*cos(s) + x0,r *        sin(s) + y0,r * sin(t)*cos(s) + z0)
  }
  persp3d(f,slim = c(-pi/2,pi/2),tlim = c(0,2*pi),n = n,add = T,...)
}




agg <- structure(list(X1 = c(-0.308421860438279,-1.42503395393061,1.10667871416591,-0.41759848570565,0.523721760757519,0.520653825151111,4.54213267745731,2.96469370222004,6.32495200153492,3.78715565912871,5.35968114482443),X2 = c(0.183223776337368,1.69719822686475,-0.992839275466541,2.22182475540691,-0.705817674534376,-2.40358980860811,-0.565561169031234,-0.362260309907445,0.326094711744554,0.60340188259578,-0.00167511540165435),X3 = c(-0.712687792799106,-0.0336746884947792,0.0711272759107127,1.6126544944538,-2.29999319137504,1.36257390230441,-1.52942342176029,-0.316841449239697,-1.69222713171002,1.23000775530984,2.30848424740017)),class = c("spec_tbl_df","tbl_df","tbl","data.frame"),row.names = c(NA,-11L),spec = structure(list(
    cols = list(X1 = structure(list(),class = c("collector_double","collector")),X2 = structure(list(),X3 = structure(list(),"collector"))),default = structure(list(),class = c("collector_guess",skip = 0),class = "col_spec"))


bond_segments <- structure(list(X1 = c(-1.42503395393061,-0.308421860438279,5.35968114482443,3.78715565912871),X2 = c(1.69719822686475,0.183223776337368,-0.00167511540165435,0.60340188259578),X3 = c(-0.0336746884947792,-0.712687792799106,2.30848424740017,1.23000775530984
    )),"data.frame"
),-20L),spec = structure(list(cols = list(
    X1 = structure(list(),"collector"
    )),class = "col_spec"))


open3d()
#> glX 
#>   1

material3d(ambient = "black",specular = "grey60",emission = "black",shininess = 30.0)
clear3d(type = "lights")
light3d(theta = -30,phi = 60,viewpoint.rel = TRUE,ambient = "#FFFFFF",diffuse = "#FFFFFF",specular = "#FFFFFF",x = NULL,y = NULL,z = NULL)
light3d(theta = -0,phi = 0,diffuse = "gray20",specular = "gray25",ambient = "gray80",z = NULL)


agg %>%
  rowwise() %>%
  mutate(spheres = sphere1.f(X1,X2,X3,r=0.5##,col = "pink"
                             ))
#> # A tibble: 11 x 4
#> # Rowwise: 
#>        X1       X2      X3 spheres   
#>     <dbl>    <dbl>   <dbl> <rglLwlvl>
#>  1 -0.308  0.183   -0.713  15        
#>  2 -1.43   1.70    -0.0337 16        
#>  3  1.11  -0.993    0.0711 17        
#>  4 -0.418  2.22     1.61   18        
#>  5  0.524 -0.706   -2.30   19        
#>  6  0.521 -2.40     1.36   20        
#>  7  4.54  -0.566   -1.53   21        
#>  8  2.96  -0.362   -0.317  22        
#>  9  6.32   0.326   -1.69   23        
#> 10  3.79   0.603    1.23   24        
#> 11  5.36  -0.00168  2.31   25


segments3d(bond_segments,lwd=8,color="black")

^{由 reprex package (v2.0.0) 于 2021 年 7 月 21 日创建}

解决方法

有几种方法可以做到这一点。最简单的就是在旁边绘制文本 每个球体：

text3d(agg,texts = LETTERS[1:11],adj = -2)

这种简单方法的问题在于球体会随着绘图调整大小，但文本和间距不会，因此如果您将绘图放大，标签将被隐藏。要获得可调整大小的标签，您需要使用 plotmath3d 绘图，例如

text3d(agg,adj = -2,usePlotmath = TRUE,fixedSize = FALSE)

这会产生

它仍然不完美，因为最右边的标签丢失了；这看起来像一个错误。如果您为 adj 使用不同的值，例如c(0.5,2) 有效。