r - Shiny 的应用程序 rglwidget 让 userMatrix 生成另一个具有相同旋转的图

Question

我有一个 Shiny 的应用程序，并将 rgl 3d 绘图集成到其中。我正在使用renderRglwidget来自rglwidget包使用 webgl 将 rgl 图形插入到我 Shiny 的应用程序中。

在应用程序中，用户可以旋转图形。现在我想保存旋转状态，因此 userMatrix 或 modelMatrix 稍后会生成一个具有与用户离开上一个图形相同的旋转的类似图。

Here我读过一些关于存储 userMatrix 和其他参数的 java 变量的内容。我可以从我的 Shiny 应用程序(R 代码)中访问它们吗？

在 rgl 本身中，我可以使用 rotationMatrix <- rgl.projection()$model或rotationMatrix <- par3d()$modelMatrix存储模型的旋转。但因为在我的例子中，图形本身没有在 rgl 中旋转，所以这些函数对我没有帮助。

我尝试的是这样的:

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)

但是par3d()$modelMatrix似乎没有返回任何东西。

Answer 1

原因rgl:par3d()不返回任何内容是因为 rgl包实际上并没有管理 Shiny 的场景。基于javascript rglwidget利用 WebGL 的库正在管理它，并且您正在将场景复制到另一个非常兼容的 GL 库(也许他们甚至使用相同的编译库，但我对此表示怀疑)并以 Shiny 的方式显示它。所以rgl.dev()不会帮助你。

据我所知，获取这些值并不容易，因为它们隐藏在 rglwidget 中javascript，但我想得到它们，所以我构建了一个 Shiny 的自定义输入控件来做到这一点。这是相当大量的工作，并且可能有一种更简单的方法，但我没有看到它，至少我现在知道如何为 Shiny 构建自定义输入控件。如果有人知道更简单的方法，请赐教。

这是 javascript，它进入 www您保存在与 Shiny 代码相同的目录中的子文件夹。

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

这是 R/shiny 代码。它使用通常的测试场景，并有一个查询场景的按钮userMatrix并将其显示在表格中。我用了userMatrix而不是 modelMatrix因为前者很容易用鼠标更改，所以您可以看到您正在获得最新的值。

请注意，名称“app.R”并不是真正可选的。要么你必须使用它，要么将文件拆分为“ui.R”和“server.R”，否则它不会导入上面的javascript文件。

应用程序.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)

最后是这样的:

请注意，我对其进行了设置，以便您可以向其中添加命令，您可以(可能)使用基于此的控件更改参数和其他任何内容。

另请注意 par3d此处的结构(转换为 json，然后从 rglwidget javascript 转换为 R)以及 rgl 中的结构并不完全相同，所以例如我必须展平 userMatrix因为 WebGL 似乎更喜欢将其作为名称列表，而不是按预期出现的其他矩阵。