1

Please see the reprex at the end of the post. This is based on the discussion at

Dply and RGL: replace sapply

The script below generates an HTML file that I have always been able to open in a browser (Firefox or chrome for instance). Now, I always get this message in the browser

"You must enable Javascript to view this page properly."

Even when there is nothing blocking javascript! Do you experience the same issue? I need to understand if it is a browser or an RGL problem. Thanks!

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

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

larry77
  • 1,309
  • 14
  • 29

1 Answers1

1

It appears that it was all due to writeWebGL being obsolete and one should resort to rglwidget.

Have a look at the revised reprex below. This time the test.html opens normally.

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"

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

larry77
  • 1,309
  • 14
  • 29
  • Thanks for posting this. When I saw `writeWebGL` is obsolete on Google I didn't realize they meant the whole package, I thought there was a newer method signature. Finally I have a draggable model in my browser. – Sridhar Sarnobat Jul 01 '22 at 07:50