请参阅文章末尾的reprex。这是基于的讨论
Dply和RGL：取代sapply
下面的脚本生成一个HTML文件，我一直可以在浏览器(例如Firefox或chrome(中打开它。现在，我总是在浏览器中收到这条消息
"您必须启用Javascript才能正确查看此页面">
即使没有任何阻止javascript的东西！你有同样的问题吗？我需要了解是浏览器问题还是RGL问题。谢谢
rm(list=ls())
library(tidyverse)
library(rgl)
## See https://stackoverflow.com/questions/39778093/how-to-increase-smoothness-of-spheres3d-in-rgl/
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, ...)
}
## Improved version where I use only 3d functions
spheres = data.frame(x = c(1,2,3), y = c(1,3,1), z=c(0,0,0) )
open3d()
#> glX
#> 1
material3d(ambient = "black", specular = "grey60", emission = "black", shininess = 30.0)
## rgl.clear(type = "lights")
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)
## Old fashioned approach
## sapply(1:NROW(spheres), function(i)
## sphere1.f( spheres$x[i], spheres$y[i], spheres$z[i], r=0.5, col = "pink") )
## and dplyr solution
spheres %>%
rowwise() %>%
mutate(spheres = sphere1.f(x, y, z, r=0.5, col = "pink"))
#> # A tibble: 3 x 4
#> # Rowwise:
#> x y z spheres
#> <dbl> <dbl> <dbl> <rglLwlvl>
#> 1 1 1 0 15
#> 2 2 3 0 16
#> 3 3 1 0 17
writeWebGL(filename = "test.html", width=1000,
height=1000)
#> Warning in snapshot3d(scene = x, width = width, height = height): webshot = TRUE
#> requires the webshot2 package; using rgl.snapshot() instead
rgl.close()
sessionInfo()
#> R version 4.1.0 (2021-05-18)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Debian GNU/Linux 10 (buster)
#>
#> Matrix products: default
#> BLAS: /usr/lib/x86_64-linux-gnu/openblas/libblas.so.3
#> LAPACK: /usr/lib/x86_64-linux-gnu/libopenblasp-r0.3.5.so
#>
#> 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] rgl_0.106.8 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.6
#> [5] purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2
#> [9] ggplot2_3.3.5 tidyverse_1.3.1
#>
#> loaded via a namespace (and not attached):
#> [1] Rcpp_1.0.7 lubridate_1.7.10 assertthat_0.2.1
#> [4] digest_0.6.27 utf8_1.2.1 mime_0.11
#> [7] R6_2.5.0 cellranger_1.1.0 backports_1.2.1
#> [10] reprex_2.0.0 evaluate_0.14 httr_1.4.2
#> [13] highr_0.9 pillar_1.6.1 rlang_0.4.11
#> [16] readxl_1.3.1 miniUI_0.1.1.1 extrafontdb_1.0
#> [19] rmarkdown_2.8 styler_1.4.1 extrafont_0.17
#> [22] webshot_0.5.2 htmlwidgets_1.5.3 munsell_0.5.0
#> [25] shiny_1.6.0 broom_0.7.6 compiler_4.1.0
#> [28] httpuv_1.6.1 modelr_0.1.8 xfun_0.24
#> [31] pkgconfig_2.0.3 htmltools_0.5.1.1 tidyselect_1.1.1
#> [34] fansi_0.5.0 crayon_1.4.1 dbplyr_2.1.1
#> [37] withr_2.4.2 later_1.2.0 grid_4.1.0
#> [40] Rttf2pt1_1.3.8 xtable_1.8-4 jsonlite_1.7.2
#> [43] gtable_0.3.0 lifecycle_1.0.0 DBI_1.1.1
#> [46] magrittr_2.0.1 scales_1.1.1 cli_3.0.0
#> [49] stringi_1.6.2 fs_1.5.0 promises_1.2.0.1
#> [52] xml2_1.3.2 ellipsis_0.3.2 generics_0.1.0
#> [55] vctrs_0.3.8 tools_4.1.0 manipulateWidget_0.10.1
#> [58] glue_1.4.2 hms_1.1.0 crosstalk_1.1.1
#> [61] fastmap_1.1.0 yaml_2.2.1 colorspace_2.0-2
#> [64] rvest_1.0.0 knitr_1.33 haven_2.4.1
创建于2021-07-21由reprex包(v2.0.0(
这一切似乎都是由于writeWebGL已经过时，应该求助于rglwidget。
请看下面修改后的reprex。这一次test.html正常打开。
rm(list=ls())
library(tidyverse)
library(rgl)
## See https://stackoverflow.com/questions/39778093/how-to-increase-smoothness-of-spheres3d-in-rgl/
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, ...)
}
## Improved version where I use only 3d functions
spheres = data.frame(x = c(1,2,3), y = c(1,3,1), z=c(0,0,0) )
open3d()
#> glX
#> 1
material3d(ambient = "black", specular = "grey60", emission = "black", shininess = 30.0)
## rgl.clear(type = "lights")
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)
## Old fashoned approach
## sapply(1:NROW(spheres), function(i)
## sphere1.f( spheres$x[i], spheres$y[i], spheres$z[i], r=0.5, col = "pink") )
## and dplyr solution
spheres %>%
rowwise() %>%
mutate(spheres = sphere1.f(x, y, z, r=0.5, col = "pink"))
#> # A tibble: 3 x 4
#> # Rowwise:
#> x y z spheres
#> <dbl> <dbl> <dbl> <rglLwlvl>
#> 1 1 1 0 15
#> 2 2 3 0 16
#> 3 3 1 0 17
## The one below is an old method no longer supported
## writeWebGL(filename = "test.html", width=1000,
## height=1000)
## Use this one instead
HTML <- rglwidget( width=1000,
height=1000)
# Exporting HTML file
htmlwidgets::saveWidget(HTML, "./test.html")
rgl.close()
print("So far so good")
#> [1] "So far so good"
创建于2021-07-21由reprex包(v2.0.0(