Forum: help

RE: rgl/Shiny bug fixes [ Reply ] By: Duncan Murdoch on 2021-01-25 17:51	[forum:48668]
I've just added a bit of code at the start of shinySetPar3d to accept a list as returned by input$par3d as an argument. It should be committed soon.

RE: rgl/Shiny bug fixes [ Reply ]
By: Yohann Demont on 2021-01-25 16:11

[forum:48667]

Sorry, I mis-read the note in help: `The browser version of parameters will be returned by shinyGetPar3d and should be supplied to shinySetPar3d`

And alike in par3d, I was expected that parameters retrieved in input$par3d when shinyGetPar3d is called could be used as-is in shinySetPar3d (with the exception of session, subscene and tag)

But with the e.g. of 'mouseMode' input$par3d returns a (at first, if we don't modify it) named character vector whereas shinySetPar3d expects a named list unique character string.

My bad, indeed, the note does not mention something like 'as-is'

Yohann

RE: rgl/Shiny bug fixes [ Reply ]
By: Duncan Murdoch on 2021-01-25 15:06

[forum:48666]

Sorry, could you be more specific about what you see as a problem?

I wouldn't expect the result received after shinyGetPar3d to be usable as an input to shinySetPar3d. They are documented to be different: shinyGetPar3d will return a list, and shinySetPar3d requires individual parameters for input. Is that not what you're seeing? (par3d() is different: it does a bunch of stuff so you can send a whole list of changes at once.)

shinySetPar3d doesn't do that, but even if it did, I wouldn't expect to be able to send the list you get from shinyGetPar3d, because it includes "tag", which isn't acceptable to shinySetPar3d.

RE: rgl/Shiny bug fixes [ Reply ]
By: Yohann Demont on 2021-01-25 11:18

[forum:48665]

Hi,

I recently observed that mouseMode parameter is retrieved/handled differently by shinyGetPar3d / shinySetPar3d

See below

require(rgl, quietly = TRUE, warn.conflicts = FALSE)
require(shiny, quietly = TRUE, warn.conflicts = FALSE)

ui <- fluidPage(
sidebarLayout(
mainPanel(tags$div(id = "plot_3D_loc",
rglwidgetOutput("plot_3D"),
verbatimTextOutput("mouse_mode_info"))),
sidebarPanel(selectInput("plot_x", label = "x feature", choices = colnames(iris)[-5], selected = colnames(iris)[1]),
selectInput("plot_y", label = "y feature", choices = colnames(iris)[-5], selected = colnames(iris)[2]),
selectInput("plot_z", label = "z feature", choices = colnames(iris)[-5], selected = colnames(iris)[3]),
selectInput(inputId = "mouse_mode", label = "left btn mouse mode", choices = c("trackball", "zoom", "none"), selected = "trackball", multiple = FALSE),
radioButtons(inputId = "convert", label = "convert to list", choices = c("no", "list", "unname"), selected = "list", inline = TRUE))
))

server <- function(input, output, session) {
devs = rgl.dev.list()
if(!any(names(devs) == "null")) open3d(useNULL = TRUE)

output$plot_3D <- renderRglwidget({
dat <- iris[, c(input$plot_x, input$plot_y, input$plot_z, "Species")]
plot3d(x = dat[, 1:3], type = "s", size = 1, col = as.integer(iris[, "Species"]), aspect = TRUE)
rglwidget()
})
observeEvent(input$mouse_mode, {
shinyGetPar3d(parameter = "mouseMode", tag = "mouse_mode_chg", session = session)
# initially, we get a named vector whose structure is:
# structure(c("trackball", "zoom", "fov", "pull"), names = c("left", "right", "middle", "wheel"))
})
observeEvent({input$par3d; input$convert}, {
if(length(input$par3d$tag) == 0) return(NULL)
if(input$par3d$tag == "mouse_mode_chg") {
mode <- input$par3d$mouseMode
mode[1] <- input$mouse_mode
names(mode) = c("left", "right", "middle", "wheel")
mode = switch(input$convert, "list" = as.list(mode), "unname" = unname(mode), "no" = mode)
# there is a difference between value retrieved by shinyGetPar3d
# and the value expected by shinySetPar3d
# we need to convert this value toa list to prevent shinySetPar3d from generating a message
# it seems that use of unname (to please asJSON) on the vector is not suitable
# it did not recently check but I think that that directly passing
# shinySetPar3d(mouseMode = input$par3d$mouseMode,...) was working in previous rgl versio
tryCatch({
shinySetPar3d(mouseMode = mode, session = session, subscene = input$par3d$subscene)
output$mouse_mode_info = renderPrint(str(list(mess = "done", "pass to shinySetPar3d" = mode), nchar.max = 500))
}, message = function(m) {
output$mouse_mode_info = renderPrint(str(list(type="message", mess = m$message, "pass to shinySetPar3d" = mode), nchar.max = 500))
}, warning = function(w) {
output$mouse_mode_info = renderPrint(str(list(type="warning", mess = w$message, "pass to shinySetPar3d" = mode), nchar.max = 500))
}, error = function(e) {
output$mouse_mode_info = renderPrint(str(list(type="error", mess = e$message, "pass to shinySetPar3d" = mode), nchar.max = 500))
})
}
})
}

shinyApp(ui, server)

RE: rgl/Shiny bug fixes [ Reply ] By: Duncan Murdoch on 2021-01-06 18:03	[forum:48588]
I've fixed another bug in convertShinyMouse3d that caused the selection issues, and added shinyMouse.R as a new demo to the package.

RE: rgl/Shiny bug fixes [ Reply ]
By: Duncan Murdoch on 2021-01-06 16:17

[forum:48587]

1. Yes, there are mods to the demo code that will prevent the glitch. I think that's not an rgl issue.
2. For determining whether a point is selected, there are two cases:

If it is one of the points included in the sharedData object, then use sharedData$selection() to return a logical vector indicating what is selected.

If it is some unrelated point, the way you were doing it is the right way, but it appears something has gone wrong, so it isn't selecting properly. I'll see if I can spot what it is.

3. I think a change to the mouse status is reasonable, but it's something your app should do, not shinyResetBrush. The reset is done in Javascript code, and it has no idea how the brush got set, so it wouldn't know what to do to reset it.

RE: rgl/Shiny bug fixes [ Reply ]
By: Yohann Demont on 2021-01-06 15:43

[forum:48586]

Thanks for your time and your help
It works like a charm

Maybe code about par3d can be removed from the example to prevent glitch, see below:
However, this implies userMatrix is lost(reinit) on axis change

In addition, I tried to determine whether a point is selected or not.
But I may not have used selectionFunction3d prperly, see below.

Finally, I am wondering if it could be nice or not to reset rglMouse to its default value when shinyResetBrush() is called ?

library(rgl, quietly = TRUE, warn.conflicts = FALSE)
library(shiny, quietly = TRUE, warn.conflicts = FALSE)

ui <- fluidPage(
sidebarLayout(
mainPanel(tabsetPanel(id = "navbar",
selected = "3D",
tabPanel(title = "2D",
plotOutput("plot_2D", brush = brushOpts(id = "plot_2D_brush",
resetOnNew = TRUE,
direction = "xy")),
verbatimTextOutput("brush_info_2D")),
tabPanel(title = "3D",
uiOutput("plot_3D_mousemode"),
rglwidgetOutput("plot_3D"),
verbatimTextOutput("brush_info_3D"),
verbatimTextOutput("selected"))
)),
sidebarPanel(selectInput("plot_x", label = "x feature", choices = colnames(iris)[-5], selected = colnames(iris)[1]),
selectInput("plot_y", label = "y feature", choices = colnames(iris)[-5], selected = colnames(iris)[2]),
selectInput("plot_z", label = "z feature", choices = colnames(iris)[-5], selected = colnames(iris)[3]),
actionButton(inputId = "reset_brush", label = "reset brush"))
))

server <- function(input, output, session) {
# 2D
output$plot_2D <- renderPlot({
plot(x = iris[, input$plot_x],
y = iris[, input$plot_y],
col = as.integer(iris[, "Species"]))
})
output$brush_info_2D <- renderPrint(str(input$plot_2D_brush))

# 3D
output$brush_info_3D <- renderPrint(print(input$rgl_3D_brush, verbose = TRUE))

# How to use selectionFunction3d ?
output$selected <- renderPrint({
if(length(input$rgl_3D_brush) == 0 || input$rgl_3D_brush$state == "inactive") return(NULL)
f <- selectionFunction3d(input$rgl_3D_brush)
which(f(iris[, c(input$plot_x, input$plot_y, input$plot_z)]))
})

output$plot_3D_mousemode <-
renderUI({
rglMouse( default = "trackball",
stayActive = FALSE,
choices = c("trackball", "selecting"),
sceneId = "plot_3D")
})
open3d(useNULL = TRUE)
sharedData <- NULL
output$plot_3D <- renderRglwidget({
clear3d()
dat <- iris[, c(input$plot_x, input$plot_y, input$plot_z, "Species")]
dat$id <-as.character(seq_len(nrow(iris)))
plot3d(x = dat[, 1:3], type = "s", size = 1, col = as.integer(iris[, "Species"]), aspect = TRUE)
sharedData <<- rglShared(id = text3d(dat[, 1:3], text = dat[, "id"], adj = -0.5),
group = "SharedData_plot_3D_ids",
deselectedFade = 0,
selectedIgnoreNone = FALSE)
shinyResetBrush(session, "rgl_3D_brush")
rglwidget(shared = sharedData,
shinyBrush = "rgl_3D_brush")
})
observeEvent(input$reset_brush, {
session$resetBrush("plot_2D_brush")
shinyResetBrush(session, "rgl_3D_brush")
})
}

shinyApp(ui, server)

Yohann Demont

RE: rgl/Shiny bug fixes [ Reply ] By: Duncan Murdoch on 2021-01-01 21:47	[forum:48574] shinymouse.R (10) downloads
I have just committed additions and bug fixes related to mouse selection. I've attached a variation on the previously posted script and it appears to work for me, other than one minor glitch (changing axes causes the plot to be done twice). I think there are ways to avoid that, but I don't think they require rgl changes, just someone who knows Shiny better.

rgl/Shiny bug fixes [ Reply ]
By: Duncan Murdoch on 2020-12-29 21:11

[forum:48572]

I spent some time today tracking down issues with Shiny. I have fixed a couple of bugs, and redone the Shiny demos in the more modern single-file style.

I haven't had a chance yet to work through your mouse selection example; I'll do that next.

In the meantime, I recommend updating to 0.104.10. I'm planning on sending a new update to CRAN after they re-open next week, so this would be a good time to let me know of anything I've missed.

RE: Mouse Selection in Shiny [ Reply ]
By: Yohann Demont on 2020-12-04 10:41

[forum:48519]

Fantastic !

I have just installed 0.104.0 rgl version from svn

I took me some time to figure out how to do it but it was very informative

For what it worth, on windows, I got it using:

devtools::install_svn("svn://svn.r-forge.r-project.org/svnroot/rgl/", subdir = "pkg/rgl", configure.args = "--merge-multiarch", dependencies = FALSE)

The README from https://cran.r-project.org/web/packages/rgl/README was also really helpful, it is said:

BUILDING ON MICROSOFT WINDOWS
-----------------------------

Install Rtools40 or newer.

Install Freetype via

pacman -S mingw-w64-{i686,x86_64}-freetype

(pacman.exe can be found in usr/bin subdeirectory of your rtools path installation)

Thanks for this very quick fix !

RE: Mouse Selection in Shiny [ Reply ] By: Duncan Murdoch on 2020-12-03 17:51	[forum:48503]
Yes, a simple off-by-one bug in the display code. rglwidget draws each text string into a big bitmap, shared between all elements in the object. Bitmaps have a maximum of 4096 pixels in each dimension, so once that was exceeded on the 160th string, it drew on a new line, but miscalculated the location of the first line. Version 0.104.0, soon to be committed here on R-forge, will fix this.

RE: Mouse Selection in Shiny [ Reply ] By: Duncan Murdoch on 2020-12-02 18:57	[forum:48496]
Yes, that's definitely weird. It doesn't seem to have anything to do with Shiny, it's a bug in rglwidget(). This is enough to show the bug: library(rgl) n <- 160 x <- rnorm(n) y <- rnorm(n) z <- rnorm(n) + atan2(x, y) plot3d(x, y, z, col = rainbow(n), aspect = TRUE) text3d(x, y, z, text = 1:n, adj = -0.5) rglwidget() Shouldn't be too hard to track down with a simple example like this.

RE: Mouse Selection in Shiny [ Reply ]
By: Yohann Demont on 2020-12-02 17:28

[forum:48495]

Hi,

Playing more with selection in shiny,
I got something weird with text3d()

It seems that text3d() allows to display 1 to 159 values correctly
However if more values are to shown only the other 160 to ... (I did not determine to up) are displayed but 1 to 159 are not anymore

Here is how I discover it:
require(rgl, quietly = TRUE, warn.conflicts = FALSE)
require(shiny, quietly = TRUE, warn.conflicts = FALSE)

ui <- fluidPage(
tags$head(tags$script(paste(sep = ";\n",
"Shiny.addCustomMessageHandler('R_get_brush', JS_get_brush )",
"function JS_get_brush(message) {",
"var ele = document.getElementById(message)",
"if(ele == null) return Shiny.onInputChange('JS_get_brush_ret', [])",
"if(ele.rglinstance == null) return Shiny.onInputChange('JS_get_brush_ret', [])",
"var brush = ele.rglinstance.select",
"var selection = ele.rglinstance.scene.crosstalk.selection",
"return Shiny.onInputChange('JS_get_brush_ret', {brushId: ele.rglinstance.brushId, state:brush.state, region:brush.region, selection: selection})",
"}"))),
sidebarLayout(
mainPanel(tags$div(id = "plot_3D_loc",
rglwidgetOutput("plot_3D_1"),
rglwidgetOutput("plot_3D_2")),
verbatimTextOutput("brush_info_3D")),
sidebarPanel(radioButtons(inputId = "n_points", label = "number of points", choices = c(159, 160, 200, 800), selected = 159),
actionButton(inputId = "get_brush", label = "get brush"))
))

server <- function(input, output, session) {
open3d(useNULL = TRUE)

insertUI(selector = "#plot_3D_loc", where = "afterBegin", immediate = TRUE,
ui = rglMouse(id = "plot_3D_mouse_ctrl",
stayActive = FALSE,
choices = c("trackball", "selecting"),
sceneId = "plot_3D_1"))

observeEvent(input$get_brush, {
req(input$get_brush)
session$sendCustomMessage("R_get_brush", "plot_3D")
})

output$brush_info_3D <- renderPrint({
foo = input$JS_get_brush_ret
foo$selection = unlist(foo$selection)
str(foo)
})

observeEvent(input$n_points, {
n = input$n_points
x <- rnorm(n)
y <- rnorm(n)
z <- rnorm(n) + atan2(x, y)
output$plot_3D_1 <- renderRglwidget({
plot3d(x, y, z, col = rainbow(n), aspect = TRUE)
ids <- text3d(x, y, z, text = 1:n, adj = -0.5)
observer3d(x = 0, y = 0, z = 1, auto = TRUE)
rglwidget(shared = rglShared(id = ids,
group = "SharedData_plot_3D_ids",
deselectedFade = 0,
selectedColor = "red",
selectedIgnoreNone = FALSE) )
})
output$plot_3D_2 <- renderRglwidget({
plot3d(x, y, z, col = rainbow(n), aspect = TRUE)
text3d(x, y, z, text = 1:n, adj = -0.5)
observer3d(x = 0, y = 0, z = 1, auto = TRUE)
rglwidget()
})
})
}

shinyApp(ui, server)

Nonetheless, selection seems to operate correctly meaning that even if text3d() are not well displayed they are here

In addition, if we replace text = 1:n by paste("a", 1:n, sep = "_") then some are well displayed other none.

This happens using Rstudio viewer but also with browsers

Finally, I also check what I can have with wgl with this small example:
library(rgl)

n = 160
x <- rnorm(n)
y <- rnorm(n)
z <- rnorm(n) + atan2(x, y)

# on window gl
wgl_dev = open3d(useNULL = FALSE, windowRect = c(20, 30, 600, 600))
rgl.set(wgl_dev, silent = FALSE)
plot3d(x, y, z, col = rainbow(n), )
text3d(x, y, z, text = 1:n, adj = -0.5) # all the 160 texts are displayed
observer3d(x = 0, y = 0, z = 1, auto = TRUE)

# on widget
if(interactive()) {
nul_dev = open3d(useNULL = TRUE)
rgl.set(nul_dev, silent = FALSE)
plot3d(x, y, z, col = rainbow(n))
text3d(x, y, z, text = 1:n, adj = -0.5) # only one text is diplayed
observer3d(x = 0, y = 0, z = 1, auto = TRUE)
rglwidget()
}

And it turns out that this weird behaviour only appears with rglwidget

HTH,
Yohann

All was done with:
R version 4.0.2 (2020-06-22)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19041)
rgl_0.103.5 shiny_1.5.0

RE: Mouse Selection in Shiny [ Reply ]
By: Duncan Murdoch on 2020-11-26 12:16

[forum:48489]

One thing I forgot to mention: the organization of the Javascript code used by rglwidget() has changed substantially in the latest release. Some bugs in it were also fixed. The release was just accepted by CRAN a few days ago; I recommend updating.

Regarding your question about get_brush: I think you are safe. If you are putting this in a CRAN package, adding some kind of test for the presence of the rgl code you need will make it very safe: then when I run reverse dependency checks, if I've changed that, I'll be informed.

RE: Mouse Selection in Shiny [ Reply ]
By: Yohann Demont on 2020-11-26 10:12

[forum:48488]

Thanks for your very quick reply !

Hereunder, a minimal example including the changes operated with your advices

1/
shinySetPar3d() was indeed very helpful to achieve what I needed.

2/
In addition, inspection of rglClass.src.js was also very informative to search for elements to send back to shiny.
Please tell me if you think that I should retrieve values extracted by get_brush elsewhere because some locations might change in the future.

3/
This is indeed what I observed: rglMouse() can not be used if rgl window is not opened yet because it requires 'dev' and 'subscene'.
So, we need to create it from the server after a rgl window has been opened.

4/
Having this warning is not that annoying. It does not prevent rglwidget from being rendered.
So, I prefer to wait for the next release because I don't want to hide other possible warnings.

# this option should be applied before loading rgl package
options(rgl.useNULL = TRUE)
require(rgl, quietly = TRUE, warn.conflicts = FALSE)
require(shiny, quietly = TRUE, warn.conflicts = FALSE)

ui <- fluidPage(
tags$head(tags$script(paste(sep = ";\n",
# add a handler to retrieve selected ids
# check value stored in rglinstance.scene.crosstalk.selection
"Shiny.addCustomMessageHandler('R_get_brush', JS_get_brush )",
# @param { string } message - elementId of the rgl plot
"function JS_get_brush(message) {",
"var ele = document.getElementById(message)",
"if(ele == null) return Shiny.onInputChange('JS_get_brush_ret', [])",
"if(ele.rglinstance == null) return Shiny.onInputChange('JS_get_brush_ret', [])",
# send brush info back to R
"var brush = ele.rglinstance.select",
"var selection = ele.rglinstance.scene.crosstalk.selection",
"return Shiny.onInputChange('JS_get_brush_ret', {brushId: ele.rglinstance.brushId, state:brush.state, region:brush.region, selection: selection})",
"}",

# add a handler to clear brush
# use rglinstance.prototype.clearBrush()
"Shiny.addCustomMessageHandler('R_clear_brush', JS_clear_brush)",
# @param { string } message - elementId of the rgl plot
"function JS_clear_brush(message) {",
"var ele = document.getElementById(message)",
"if(ele == null) return null",
"if(ele.rglinstance == null) return null",
"ele.rglinstance.clearBrush()",
"}"))),
sidebarLayout(
mainPanel(tags$div(id = "plot_3D_loc",
selectInput("mouse_mode", label = "Mouse Mode", choices = c("trackball", "selecting"), selected = "trackball", multiple = FALSE),
rglwidgetOutput("plot_3D"),
verbatimTextOutput("brush_info_3D"))),
sidebarPanel(selectInput("plot_x", label = "x feature", choices = colnames(iris)[-5], selected = colnames(iris)[1]),
selectInput("plot_y", label = "y feature", choices = colnames(iris)[-5], selected = colnames(iris)[2]),
selectInput("plot_z", label = "z feature", choices = colnames(iris)[-5], selected = colnames(iris)[3]),
actionButton(inputId = "get_brush", label = "get brush"),
actionButton(inputId = "reset_brush", label = "reset brush"))
))

server <- function(input, output, session) {
output$plot_3D <- renderRglwidget({
updateSelectInput(session = session, inputId = "mouse_mode", selected = "trackball")
session$sendCustomMessage("R_clear_brush", "plot_3D")
dat <- iris[, c(input$plot_x, input$plot_y, input$plot_z, "Species")]
dat$id <-as.character(seq_len(nrow(iris)))
plot3d(x = dat[, 1:3], type = "s", size = 1, , col = as.integer(iris[, "Species"]), aspect = TRUE)
rglwidget(shared = rglShared(id = text3d(dat[, 1:3], text = dat[, "id"], adj = -0.5),
group = "SharedData_plot_3D_ids",
deselectedFade = 0,
selectedIgnoreNone = FALSE))
})
output$brush_info_3D <- renderPrint({
foo = input$JS_get_brush_ret
foo$selection = unlist(foo$selection)
str(foo)
})

# Here the reset_brush only removes the brush rectangle from the canvas
# and sets brush state to inactive. This is enough for what I need.
# But maybe for the completeness, readers may also be interested in
# removing text ids from the canvas and resetting crosstalk selection
# though I did not investigate a lot on how to do it
observeEvent(input$reset_brush, {
req(input$reset_brush)
session$sendCustomMessage("R_clear_brush", "plot_3D")
})

# Here get_brush retrieves what I need on demand.
# This is what I wanted to do.
# But others may want to trigger this every time brush is changed
# so maybe it could be nice to add JS_get_brush to canvas mouse listeners
observeEvent(input$get_brush, {
req(input$get_brush)
session$sendCustomMessage("R_get_brush", "plot_3D")
})
observeEvent(input$mouse_mode, {
req(input$mouse_mode)
session$sendCustomMessage("R_clear_brush", "plot_3D")
shinyGetPar3d(parameter = "mouseMode", tag = "mouse_mode_chg", session = session)
})
observeEvent(input$par3d, {
req(input$par3d)
if(input$par3d$tag == "mouse_mode_chg") {
mode <- input$par3d$mouseMode
mode[1] <- input$mouse_mode
shinySetPar3d(mouseMode = mode, session = session, subscene = input$par3d$subscene)
}
})
session$sendCustomMessage("R_set_brush_chg_listener", "plot_3D")
}

shinyApp(ui, server)

RE: Mouse Selection in Shiny [ Reply ]
By: Duncan Murdoch on 2020-11-25 12:35

[forum:48487]

I don't really know Shiny all that well, so I can't comment on whether your code makes sense or not. I suspect what you are trying to do requires good knowledge of both Shiny and rgl.

One issue is that there are two separate display systems in rgl. One does the displays while running R, one (rglwidget()) does the displays in a web page. Since Shiny interacts with the user through a web page, you have to use rglwidget() displays in a Shiny app. However, Shiny apps mainly run in R, so things are complicated.

You should be able to use the shinyGetPar3d() and shinySetPar3d() functions to query and change par3d() settings from a Shiny app.

For your specific questions:

- mouse mode is a par3d() property, so shinySetPar3d() should be able to change it.

- I don't remember putting in a documented way to get brush info. Crosstalk may document one, and rglwidgets work with Crosstalk, so you could look there. You can see how things are handled internally by looking at the file inst/htmlwidgets/lib/rglClass/selection.src.js in the rgl tarball. I wouldn't expect this to change, but if you want to make sure it's stable, send me some code and documentation to retrieve what you need.

- I don't understand your first minor question. What do you mean by "directly in UI"? Generally speaking, par3d() properties belong to a particular rgl window, so if you don't have one open, you can't set them.

- For the warning message, you can always wrap the bad command in suppressWarnings(). I notice that the Shiny demo code isn't working as well as it used to; it's old, and Shiny has probably changed since it was written. I may look into updating that for the next release.

Mouse Selection in Shiny [ Reply ]
By: Yohann Demont on 2020-11-25 08:48

[forum:48486]

Hi,

I would like to get some help / advices on how to best use Rgl Mouse Selection within shiny

Hereunder, you will find a commented example of a shiny app that describes what I am trying to achieve.
The main questions are:
- Is it possible to reset the brushing on plot redraw (for example with axis feature change) or on rglMouse change back to trackball ?
- Is there an official way to retrieve brush information ?

Minor ones:
- would it be possible to place rglMouse directly in ui even if rgl.dev.list() is empty ?
- would it be possible to prevent rglwidget from throwing warning message stating that widget ID is ignored ?

Best,
Yohann

# The minimal reproducible example
# this option should be applied before loading rgl package
options(rgl.useNULL = TRUE)
require(rgl, quietly = TRUE, warn.conflicts = FALSE)
require(shiny, quietly = TRUE, warn.conflicts = FALSE)

ui <- fluidPage(
sidebarLayout(
mainPanel(tabsetPanel(id = "navbar",
tabPanel(title = "2D",
plotOutput("plot_2D", brush = brushOpts(id = "plot_2D_brush",
resetOnNew = TRUE,
direction = "xy")),
verbatimTextOutput("brush_info_2D")),
tabPanel(title = "3D",
tags$div(id = "plot_3D_loc",
# rglMouse can not be added here since plot_3D is not created yet
# is there a way to do something alike brushOpts ?
rglwidgetOutput("plot_3D")),
verbatimTextOutput("brush_info_3D"))
)),
sidebarPanel(selectInput("plot_x", label = "x feature", choices = colnames(iris)[-5], selected = colnames(iris)[1]),
selectInput("plot_y", label = "y feature", choices = colnames(iris)[-5], selected = colnames(iris)[2]),
selectInput("plot_z", label = "z feature", choices = colnames(iris)[-5], selected = colnames(iris)[3]),
actionButton(inputId = "reset_brush", label = "reset brush"))
))

server <- function(input, output, session) {
# 2D
output$plot_2D <- renderPlot({
plot(x = iris[, input$plot_x],
y = iris[, input$plot_y],
col = as.integer(iris[, "Species"]))
})
output$brush_info_2D <- renderPrint(str(input$plot_2D_brush))

# 3D
# we need to use rglMouse here to insert it in the DOM
# if a rgl.dev,list() is empty, it is important to use open3d() before inserting rglMouse otherwise
# rglMouse will try to find a subscene that is not existing yet
open3d(useNULL = TRUE)
insertUI(selector = "#plot_3D_loc", where = "afterBegin", immediate = TRUE,
ui = rglMouse(id = "plot_3D_mouse_ctrl",
stayActive = FALSE,
choices = c("trackball", "selecting"),
sceneId = "plot_3D"))

output$plot_3D <- renderRglwidget({
# we can not use try(rgl.close(), silent = TRUE) and we need to use clear3d()
# otherwise rglMouse will not work anymore and an error in thrown in javascript
clear3d()
dat <- iris[, c(input$plot_x, input$plot_y, input$plot_z, "Species")]
dat$id <-as.character(seq_len(nrow(iris)))
plot3d(x = dat[, 1:3], type = "s", size = 1, , col = as.integer(iris[, "Species"]), aspect = TRUE)
rglwidget(shared = rglShared(id = text3d(dat[, 1:3], text = dat[, "id"], adj = -0.5),
group = "SharedData_plot_3D_ids",
# Is there an equivalent parameter for 3D ? resetOnNew = TRUE,
# if one of x, y, or z is changed the brush is not reset
# same if we change mouse mode back to trackball
# however the selected elements are changed
# suggesting that the brush is still here
deselectedFade = 0,
selectedIgnoreNone = FALSE),
controllers = "plot_3D_mouse_ctrl",
elementId = "plot_3D")
})
# how to suppress the warning 'Ignoring explicitly provided widget ID "rglxxxxx"; Shiny doesn't use them'
# we are in a shiny app and elementId is NULL.
# if set to 'plot_3D', we also get 'Ignoring explicitly provided widget ID "plot_3D"; Shiny doesn't use them'

output$brush_info_3D <- renderPrint(str(NULL))
# Is there an equivalent function for 3D to get brushing information ?
# Notably, it could be convenient to retrieve/recompute ids of selected points
# as a hack one can create an handler with Shiny.addCustomMessageHandler in javascript
# to send __crosstalk_groups['SharedData_plot_3D_ids']._vars.selection._value on demand
# Is there a more "official" way to do it ?

observeEvent(input$reset_brush, {
session$resetBrush("plot_1D_brush")
session$resetBrush("plot_2D_brush")
# Is there an equivalent function for 3D ? session$resetBrush("plot_3D_brush")
# Being able to clear the brush on demand within the app would be very helpfull
})
}

shinyApp(ui, server)