R+RGL：球体和线段图，线段无法正确缩放
请考虑下面的代码片段。 它绘制了一组由一些线段连接的球体。 绘制平滑球体的函数来自
让我困惑的是：当我放大/缩小 RGL 图时，球体和线段的行为不同。特别是，如果我放大，这些线段相对于球体看起来相当细，而当我缩小时，它们看起来非常宽。
有没有办法纠正这种行为，以便无论缩放级别如何，球体和线段之间的比例始终得到尊重？ 非常感谢
library(rgl)
library(tidyverse)
## a function to plot good-looking spheres
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, ...)
}
## a set of 3D coordinates for my spheres
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"))
##coordinares of the segments (bonds) connecting the spheres
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
##material and light effects for the spheres
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)
## plot the spheres
agg %>%
rowwise() %>%
mutate(spheres = sphere1.f(X1, X2, X3, r=0.5))
#> # A tibble: 11 × 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
## add the segments
segments3d(bond_segments, lwd=8, color="black")
sessionInfo()
#> R version 4.1.2 (2021-11-01)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Debian GNU/Linux 11 (bullseye)
#>
#> Matrix products: default
#> BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
#> LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
#>
#> locale:
#> [1] LC_CTYPE=en_GB.UTF-8 LC_NUMERIC=C
#> [3] LC_TIME=en_GB.UTF-8 LC_COLLATE=en_GB.UTF-8
#> [5] LC_MONETARY=en_GB.UTF-8 LC_MESSAGES=en_GB.UTF-8
#> [7] LC_PAPER=en_GB.UTF-8 LC_NAME=C
#> [9] LC_ADDRESS=C LC_TELEPHONE=C
#> [11] LC_MEASUREMENT=en_GB.UTF-8 LC_IDENTIFICATION=C
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] forcats_0.5.1 stringr_1.4.0 dplyr_1.0.8 purrr_0.3.4
#> [5] readr_2.1.1 tidyr_1.2.0 tibble_3.1.6 ggplot2_3.3.5
#> [9] tidyverse_1.3.1 rgl_0.108.3
#>
#> loaded via a namespace (and not attached):
#> [1] Rcpp_1.0.7 lubridate_1.8.0 assertthat_0.2.1 digest_0.6.29
#> [5] utf8_1.2.2 R6_2.5.1 cellranger_1.1.0 backports_1.4.1
#> [9] reprex_2.0.1 evaluate_0.14 httr_1.4.2 highr_0.9
#> [13] pillar_1.6.4 rlang_1.0.1 readxl_1.3.1 R.utils_2.11.0
#> [17] R.oo_1.24.0 rmarkdown_2.11 styler_1.6.2 htmlwidgets_1.5.4
#> [21] munsell_0.5.0 broom_0.7.10 compiler_4.1.2 modelr_0.1.8
#> [25] xfun_0.29 pkgconfig_2.0.3 htmltools_0.5.2 tidyselect_1.1.1
#> [29] fansi_0.5.0 crayon_1.4.2 tzdb_0.2.0 dbplyr_2.1.1
#> [33] withr_2.4.3 R.methodsS3_1.8.1 grid_4.1.2 jsonlite_1.7.2
#> [37] gtable_0.3.0 lifecycle_1.0.1 DBI_1.1.2 magrittr_2.0.1
#> [41] scales_1.1.1 cli_3.1.0 stringi_1.7.6 fs_1.5.2
#> [45] xml2_1.3.3 ellipsis_0.3.2 generics_0.1.1 vctrs_0.3.8
#> [49] tools_4.1.2 R.cache_0.15.0 glue_1.6.0 hms_1.1.1
#> [53] fastmap_1.1.0 yaml_2.2.1 colorspace_2.0-2 rvest_1.0.2
#> [57] knitr_1.37 haven_2.4.3
由 reprex 包 (v2.0.1) 创建于 2022 年 3 月 6 日
Please consider the snippet below.
It plots a set of spheres connected by some segments.
The function to draw the smooth spheres comes from the discussion at
How to increase smoothness of spheres3d in rgl
What puzzles me is the following: when I zoom in/out the RGL plot, the spheres and the segments behave differently. In particular, if I zoom in, the segments look rather thin with respect to the spheres, whereas they look really wide when I zoom out.
Is there a way to correct this behavior, so that the proportion between the spheres and the segments is always respected regardless of the zoom level?
Thanks a lot
library(rgl)
library(tidyverse)
## a function to plot good-looking spheres
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, ...)
}
## a set of 3D coordinates for my spheres
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"))
##coordinares of the segments (bonds) connecting the spheres
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
##material and light effects for the spheres
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)
## plot the spheres
agg %>%
rowwise() %>%
mutate(spheres = sphere1.f(X1, X2, X3, r=0.5))
#> # A tibble: 11 × 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
## add the segments
segments3d(bond_segments, lwd=8, color="black")
sessionInfo()
#> R version 4.1.2 (2021-11-01)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Debian GNU/Linux 11 (bullseye)
#>
#> Matrix products: default
#> BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
#> LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
#>
#> locale:
#> [1] LC_CTYPE=en_GB.UTF-8 LC_NUMERIC=C
#> [3] LC_TIME=en_GB.UTF-8 LC_COLLATE=en_GB.UTF-8
#> [5] LC_MONETARY=en_GB.UTF-8 LC_MESSAGES=en_GB.UTF-8
#> [7] LC_PAPER=en_GB.UTF-8 LC_NAME=C
#> [9] LC_ADDRESS=C LC_TELEPHONE=C
#> [11] LC_MEASUREMENT=en_GB.UTF-8 LC_IDENTIFICATION=C
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] forcats_0.5.1 stringr_1.4.0 dplyr_1.0.8 purrr_0.3.4
#> [5] readr_2.1.1 tidyr_1.2.0 tibble_3.1.6 ggplot2_3.3.5
#> [9] tidyverse_1.3.1 rgl_0.108.3
#>
#> loaded via a namespace (and not attached):
#> [1] Rcpp_1.0.7 lubridate_1.8.0 assertthat_0.2.1 digest_0.6.29
#> [5] utf8_1.2.2 R6_2.5.1 cellranger_1.1.0 backports_1.4.1
#> [9] reprex_2.0.1 evaluate_0.14 httr_1.4.2 highr_0.9
#> [13] pillar_1.6.4 rlang_1.0.1 readxl_1.3.1 R.utils_2.11.0
#> [17] R.oo_1.24.0 rmarkdown_2.11 styler_1.6.2 htmlwidgets_1.5.4
#> [21] munsell_0.5.0 broom_0.7.10 compiler_4.1.2 modelr_0.1.8
#> [25] xfun_0.29 pkgconfig_2.0.3 htmltools_0.5.2 tidyselect_1.1.1
#> [29] fansi_0.5.0 crayon_1.4.2 tzdb_0.2.0 dbplyr_2.1.1
#> [33] withr_2.4.3 R.methodsS3_1.8.1 grid_4.1.2 jsonlite_1.7.2
#> [37] gtable_0.3.0 lifecycle_1.0.1 DBI_1.1.2 magrittr_2.0.1
#> [41] scales_1.1.1 cli_3.1.0 stringi_1.7.6 fs_1.5.2
#> [45] xml2_1.3.3 ellipsis_0.3.2 generics_0.1.1 vctrs_0.3.8
#> [49] tools_4.1.2 R.cache_0.15.0 glue_1.6.0 hms_1.1.1
#> [53] fastmap_1.1.0 yaml_2.2.1 colorspace_2.0-2 rvest_1.0.2
#> [57] knitr_1.37 haven_2.4.3
Created on 2022-03-06 by the reprex package (v2.0.1)
如果你对这篇内容有疑问，欢迎到本站社区发帖提问 参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱，如果其他用户或者作者回复了您的评论，将不能在第一时间通知您！
发布评论
评论（2）
感谢您提出的宝贵建议。
借助气缸就完成了工作。为了设置气缸，我确实复制并粘贴了部分讨论
https://r-help.stat.math.ethz.narkive.com/9X5yGnh0/r-joining-two-points-in-rgl
创建于 2022 年 3 月 7 日reprex 包 (v2.0.1)
Thanks for the valuable suggestions.
Resorting to cylinders got the job done. For the setting up the cylinders, I really made a copy and paste of part of the discussion here
https://r-help.stat.math.ethz.narkive.com/9X5yGnh0/r-joining-two-points-in-rgl
Created on 2022-03-07 by the reprex package (v2.0.1)
之前的答案 https://stackoverflow.com/a/71379091/2554330 非常接近解决问题，但是有有一些小问题：
球体之间的一些链接有些平坦，因为在
cyclone3d中指定e2参数表示旋转对称截面不垂直于圆柱体。忽略它可以解决这个问题。您可以看到圆柱体上的小面（默认情况下为 6 面）。由于这些应该被解释为随场景调整大小的线条，因此使用
lit = FALSE材质属性抑制照明使它们看起来更像粗线条。sphere1.f函数在曲面边缘连接处有明显的接缝，因为persp3d使用内部点估计法线。明确指定法线可以解决此问题。它们是用f之类的函数指定的，但给出了表面的单位法线，即由
sphere1.f绘制的每个球体都有101^2个顶点。 rgl 可以处理这个问题，但效率相当低。由于它们都是相同的，因此 sprites3d 函数可用于在所有不同位置复制单个球体。执行此操作的适当代码是在每个计算位置重新绘制以 (0, 0, 0) 为中心的单个球体。这看起来与 R 中的原始内容相同，但会使 rglwidget() 的输出小得多。 （我注意到照明代码中似乎存在错误，因此
rglwidget()中的阴影看起来错误指定的灯。注释掉照明代码可以修复它，但这不是必需的。）
The previous answer https://stackoverflow.com/a/71379091/2554330 comes very close to solving the problem, but there are some minor issues:
Some of the links between the spheres are somewhat flat, because specifying the
e2argument incylinder3dmeans the rotationally symmetric cross section is not perpendicular to the cylinder. Leaving it out fixes this.You can see the facets on the cylinders (which are 6 sided by default). Since these are supposed to be interpreted as lines which resize with the scene, suppressing the lighting using the
lit = FALSEmaterial property makes them look more like fat lines.The
sphere1.ffunction has a noticeable seam in it where the edges of the curved surface join, becausepersp3destimates the normals using interior points. Specifying the normals explicitly fixes this. They are specified with a function likef, but giving unit normals to the surface, i.e.Each of the spheres drawn by
sphere1.fhas 101^2 vertices.rglcan handle this, but it is fairly inefficient. Since they are all identical, thesprites3dfunction can be used to replicate a single sphere at all the different locations. The appropriate code to do this would bewhere a single sphere centred at (0, 0, 0) is redrawn at each of the computed locations. This looks the same as the original in R, but will make the output from
rglwidget()much smaller. (I notice there seems to be a bug in the lighting code, so the shading looks wrong inrglwidget()withthe specified lights. Commenting out the lighting code fixes it, but that shouldn't be necessary.)