sunburst - shiny widgets

aplicación brillante rglwidget obtener userMatrix para generar otra gráfica con la misma rotación

Question

Tengo una aplicación brillante e integro un rgl 3d-plot en ella. Estoy usando renderRglwidget del paquete rglwidget para insertar los gráficos rgl usando webgl en mi brillante aplicación.

En la aplicación, el usuario puede rotar el gráfico. Ahora quiero guardar el estado de rotación, de ahí el userMatrix o modelMatrix para luego generar un diagrama similar con la misma rotación que el usuario dejó el gráfico anterior.

Aquí leo algo sobre las variables de Java que almacenan el userMatrix y otros parámetros. ¿Puedo acceder a ellos desde mi brillante aplicación (en código R)?

En rgl mismo, puedo usar rotationMatrix <- rgl.projection()$model o rotationMatrix <- par3d()$modelMatrix para almacenar la rotación del modelo. Pero como en mi caso el gráfico no gira en sí mismo, estas funciones no me ayudan.

Lo que probé es esto:

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)

Pero par3d()$modelMatrix no parece devolver nada.

Answer 1

La razón por la que rgl:par3d() no devuelve nada es porque los paquetes rgl no están realmente administrando la escena para brillar. La biblioteca rglwidget basada en rglwidget que aprovecha WebGL está administrando, y está copiando sobre la escena a otra biblioteca GL muy compatible (tal vez incluso usan la misma biblioteca compilada, pero lo dudo) y mostrando eso en brillante. Entonces rgl.dev() no te ayudará.

AFAIK, no es fácil obtener estos valores, ya que están ocultos en rglwidget javascript, pero quería llegar a ellos, así que construí un control de entrada personalizado brillante que puede hacerlo. Fue una buena cantidad de trabajo, y podría haber una manera más fácil, pero no lo vi y al menos sé cómo crear controles de entrada personalizados para brillantes ahora. Si alguien conoce un camino más fácil, por favor ilumíname.

Aquí está el javascript, entra en una subcarpeta www que guarda en el mismo directorio que su código brillante.

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);

Aquí está el código R / brillante. Utiliza la escena de prueba habitual y tiene un botón para consultar las escenas userMatrix y lo muestra en una tabla. userMatrix el userMatrix y no el modelMatrix porque el primero es fácil de cambiar con el mouse, por lo que puede ver que está obteniendo los valores más frescos.

Tenga en cuenta que el nombre "app.R" no es realmente opcional. O tiene que usar eso, o dividir el archivo en "ui.R" y "server.R", de lo contrario no importará el archivo javascript anterior.

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)

Y finalmente aquí está lo que parece:

Tenga en cuenta que lo configuro para que pueda agregarle comandos, puede (probablemente) cambiar los parámetros y cualquier otra cosa con un control basado en este.

También tenga en cuenta que la estructura de par3d aquí (convertida a json y luego a R desde el javascript de rglwidget ) y la que está en rgl no son del todo idénticas, así que por ejemplo tuve que aplanar el userMatrix ya que WebGL parece preferirlo como una lista de nombres como opuesto a las otras matrices que surgieron como se esperaba.