简体   繁体   中英

R and RGL: how to add labels to spheres?

Please have a look at the reprex below. I use RGL to create a set of spheres linked by segments. I would like to be able to add a label to each sphere (eg a number or a letter) to able to address them individually (for instance, if I talk about sphere "4" or sphere "D" it should be clear which sphere I am talking about).

Any idea about how to achieve that?

Thanks!

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(), class = c("collector_double", 
    "collector")), X3 = structure(list(), class = c("collector_double", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
    "collector")), skip = 0), class = "col_spec"))


bond_segments <- structure(list(X1 = c(-1.42503395393061, -0.308421860438279, 
1.10667871416591, -0.308421860438279, 0.523721760757519, -0.308421860438279, 
-0.41759848570565, -1.42503395393061, 0.520653825151111, 1.10667871416591, 
2.96469370222004, 1.10667871416591, 2.96469370222004, 4.54213267745731, 
6.32495200153492, 4.54213267745731, 3.78715565912871, 2.96469370222004, 
5.35968114482443, 3.78715565912871), X2 = c(1.69719822686475, 
0.183223776337368, -0.992839275466541, 0.183223776337368, -0.705817674534376, 
0.183223776337368, 2.22182475540691, 1.69719822686475, -2.40358980860811, 
-0.992839275466541, -0.362260309907445, -0.992839275466541, -0.362260309907445, 
-0.565561169031234, 0.326094711744554, -0.565561169031234, 0.60340188259578, 
-0.362260309907445, -0.00167511540165435, 0.60340188259578), 
    X3 = c(-0.0336746884947792, -0.712687792799106, 0.0711272759107127, 
    -0.712687792799106, -2.29999319137504, -0.712687792799106, 
    1.6126544944538, -0.0336746884947792, 1.36257390230441, 0.0711272759107127, 
    -0.316841449239697, 0.0711272759107127, -0.316841449239697, 
    -1.52942342176029, -1.69222713171002, -1.52942342176029, 
    1.23000775530984, -0.316841449239697, 2.30848424740017, 1.23000775530984
    )), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"
), row.names = c(NA, -20L), spec = structure(list(cols = list(
    X1 = structure(list(), class = c("collector_double", "collector"
    )), X2 = structure(list(), class = c("collector_double", 
    "collector")), X3 = structure(list(), class = c("collector_double", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
"collector")), skip = 0), 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, viewpoint.rel = TRUE,  diffuse = "gray20", specular = "gray25", ambient = "gray80", x = NULL, y = NULL, 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")

Created on 2021-07-21 by the reprex package (v2.0.0)

There are a few ways to do this. The simplest is just to plot text next to each sphere:

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

The problem with this simple approach is that the spheres resize with the plot but the text and spacing doesn't, so if you make the plot larger, the labels are hidden. To get resizeable labels, you need to use the plotmath3d plotting, eg

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

This produces

在此处输入图片说明

It's still not perfect, because the rightmost label is missing; that looks like a bug. If you use a different value for adj , eg c(0.5, 2) it works.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM