shiny app rglwidget get userMatrix to generate another plot with same rotation

Question

I have a shiny app and integrate an rgl 3d-plot into it. I am using renderRglwidget from the rglwidget package to insert the rgl graphics using webgl into my shiny app.

In the app the user can rotate the graphic. Now I want to save the rotation state, hence the userMatrix or modelMatrix to later generate a similar plot with the same rotation as the user left the previous graph.

Here I read something about java variables storing the userMatrix and other parameters. Can I access them from within my shiny app (in R code)?

In rgl itself I can use rotationMatrix <- rgl.projection()$model or rotationMatrix <- par3d()$modelMatrix to store the rotation of the model. But since in my case the graphic is not rotated in rgl itself these functions don't help me.

What I tried is this:

library(shiny)
library(rgl)
library(rglwidget)

ui <- fluidPage(
  rglwidgetOutput("3D-plot"),
  actionButton("showMatrix", "show rotation Matrix")
)

server <- function(input, output, session){
  open3d(useNULL = T)
  x <- sort(rnorm(1000))
  y <- rnorm(1000)
  z <- rnorm(1000) + atan2(x, y)
  plot3d(x, y, z, col = rainbow(1000))
  scene1 <- scene3d()
  rgl.close()

  output$"3D-plot" <- renderRglwidget({
    rglwidget(scene1)
  })
  observe({
    input$showMatrix
    par3d()$modelMatrix
  })
}


shinyApp(ui=ui, server=server)

But par3d()$modelMatrix does not seem to return anything.

Answer 1

The reason rgl:par3d() does not return anything is because the rgl packages is not actually managing the scene for shiny. The javascript based rglwidget library that leverages WebGL is managing it, and you are copying over the scene to another very compatible GL library (maybe they even use the same compiled library, but I doubt it) and displaying that in shiny. So rgl.dev() will not help you.

AFAIK, it is not easy to get at these values as they are hidden away in rglwidget javascript, but I wanted to get at them, so I built a shiny custom input control that can do it. It was a fair amount of work, and there might be an easier way, but I didn't see it and at least I know how to build custom input controls for shiny now. If someone knows an easier way, please enlighten me.

Here is the javascript, it goes into a www subfolder that you save in the same directory as your shiny code.

rglwidgetaux.js

// rglwidgetaux control for querying shiny rglwiget

var rglwidgetauxBinding = new Shiny.InputBinding();
$.extend(rglwidgetauxBinding, {
  find: function(scope) {
    return $(scope).find(".rglWidgetAux");
  },
  getValue: function(el) {
    return el.value;
  },
  setValue: function(el, value) {
  //  $(el).text(value);
     el.value = value;
  },
  getState: function(el) {
    return { value: this.getValue(el) };
  },
   receiveMessage: function(el, data) {
    var $el = $(el);

    switch (data.cmd) {
       case "test":alert("Recieved Message");
                    break;
       case "getpar3d":
                    var rglel = $("#"+data.rglwidgetId);
                    if (rglel.length===0){
                       alert("bad rglwidgetId:"+ data.rglwidgetId);
                       return null;
                    }
                    var rglinst = rglel[0].rglinstance;
                    var sid = rglinst.scene.rootSubscene;
                    var par3d = rglinst.getObj(sid).par3d;
                    this.setValue(el,JSON.stringify(par3d));
                    $el.trigger("change"); // tell myself that I have changed
                    break;
    }
  },  
  subscribe: function(el, callback) {
    $(el).on("change.rglwidgetauxBinding", function(e) {
      callback();
    });
  },
  unsubscribe: function(el) {
    $(el).off(".rglwidgetauxBinding");
  }
});
Shiny.inputBindings.register(rglwidgetauxBinding);

Here is the R/shiny code. It uses the usual test scene and has a button to query the scenes userMatrix and displays it in a table. I used the userMatrix and not the modelMatrix because the former is easy to change with the mouse, so you can see that you are getting the freshest values.

Note that the name "app.R" is not really optional. Either you have to use that, or split the file into "ui.R" and "server.R", otherwise it will not import the javascript file above.

app.R

library(shiny)
library(rgl)
library(htmlwidgets)
library(jsonlite)

rglwgtctrl <- function(inputId, value="", nrows, ncols) {
  # This code includes the javascript that we need and defines the html
  tagList(
    singleton(tags$head(tags$script(src = "rglwidgetaux.js"))),
    tags$div(id = inputId,class = "rglWidgetAux",as.character(value))
  )
}

ui <- fluidPage(
    rglwgtctrl('ctrlplot3d'),
    actionButton("regen", "Regen Scene"),
    actionButton("queryumat", "Query User Matrix"),
    rglwidgetOutput("plot3d"),
    tableOutput("usermatrix")
)

server <- function(input, output, session) 
{
  observe({
    # tell our rglWidgetAux to query the plot3d for its par3d
    input$queryumat
    session$sendInputMessage("ctrlplot3d",list("cmd"="getpar3d","rglwidgetId"="plot3d"))
  })

  output$usermatrix <- renderTable({
    # grab the user matrix from the par3d stored in our rglWidgetAux
    # note we are using two different "validate"s here, which is quite the pain if you 
    # don't notice that it is declared in two different libraries
    shiny::validate(need(!is.null(input$ctrlplot3d),"User Matrix not yet queried"))
    umat <- matrix(0,4,4)
    jsonpar3d <- input$ctrlplot3d
    if (jsonlite::validate(jsonpar3d)){
      par3dout <- fromJSON(jsonpar3d)
      umat <- matrix(unlist(par3dout$userMatrix),4,4) # make list into matrix
    }
    return(umat)
  })

  scenegen <- reactive({
     # make a random scene
     input$regen
     n <- 1000
     x <- sort(rnorm(n))
     y <- rnorm(n)
     z <- rnorm(n) + atan2(x, y)
     plot3d(x, y, z, col = rainbow(n))
     scene1 <- scene3d()
     rgl.close() # make the app window go away
     return(scene1)
  })
  output$plot3d <- renderRglwidget({ rglwidget(scenegen()) })
}

shinyApp(ui=ui, server=server)

And finally here is what it looks like:

Note that I set it up so you can add commands to it, you could (probably) change parameters and anything else with a control based on this one.

Also note that the par3d structure here (converted to json and then to R from the rglwidget javascript) and the one in rgl are not quite identical, so for example I had to flatten the userMatrix as WebGL seems to prefer it as a names list as opposed to the other matrices which came over as expected.