I am trying to create a Shiny app that displays an RGL visualisation (which is nothing else than a set of polished sticks and spheres). Please have a look at the code for the visualisation below
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 × 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
ll <- LETTERS[1:nrow(agg)]
text3d(x=agg$X1, y = agg$X2, z = agg$X3, ll,
adj = c(0,-1.6)
,
## pos = 3, offset = 1.7,
cex=0.8, usePlotmath = T,
, fixedSize = FALSE)
## text3d(agg, texts = LETTERS[1:11], ## adj = -2,
## pos=3, offset = 1.5, cex=2,
## usePlotmath = TRUE, fixedSize = FALSE)
segments3d(bond_segments, lwd=8, color="black")
## rgl.close()
Created on 2022-02-28 by the reprex package (v2.0.1)
How can I display this in a Shiny app? I googled a bit and I found this package
https://www.r-project.org/nosvn/pandoc/shinyRGL.html
and I also saw the existence of renderRglwidget, see e.g.
R shiny and rgl : 3D points disappear when axes displayed
I am after something rather simple: a fluid page with some controls I will add on the left and the visualisation on the right. Anyone can give me an example of that with my already existing code for RGL?
Many thanks
Well, the code below is at the moment good enough for me and gets the job done. It works and it can be deployed online.
library(rgl)
library(tidyverse)
library(shiny)
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, ...)
}
## app <- shinyApp(
ui <- bootstrapPage(
inputPanel(
sliderInput("n", label = "n", min = 10, max = 100, value = 10, step = 10)
),
mainPanel(
({
rglwidgetOutput("myplot", width = "1280px", height = "1280px")
})
)
)
server <- function(input, output) {
output$myplot <- renderRglwidget({
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"))
try(close3d())
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"
))
ll <- LETTERS[1:nrow(agg)]
text3d(x=agg$X1, y = agg$X2, z = agg$X3, ll,
adj = c(0,-1.6)
,
## pos = 3, offset = 1.7,
cex=0.8, usePlotmath = T,
, fixedSize = FALSE)
segments3d(bond_segments, lwd=8, color="black")
rglwidget()
})
}
shinyApp(ui = ui, server = server)