闪亮的应用程序 rglwidget 获取 userMatrix 以生成另一个具有相同旋转的图
shiny app rglwidget get userMatrix to generate another plot with same rotation
我有一个闪亮的应用程序并在其中集成了一个 rgl 3d-plot。我正在使用 rglwidget
包中的 renderRglwidget
将使用 webgl 的 rgl 图形插入到我闪亮的应用程序中。
在应用程序中,用户可以旋转图形。现在我想保存旋转状态,因此 userMatrix 或 modelMatrix 稍后会生成一个类似的图,其旋转与用户离开上一个图形时的旋转相同。
Here 我读了一些关于 java 存储 userMatrix 和其他参数的变量。我可以从我闪亮的应用程序中访问它们吗(在 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
似乎return什么都没有。
rgl:par3d()
没有 return 任何东西的原因是 rgl
包实际上并没有管理闪亮的场景。利用 WebGL
的基于 javascript 的 rglwidget
库正在管理它,您正在将场景复制到另一个非常兼容的 GL 库(也许他们甚至使用相同的编译库,但我怀疑它)并以闪亮的方式显示。所以rgl.dev()
帮不了你。
AFAIK,获取这些值并不容易,因为它们隐藏在 rglwidget
javascript 中,但我想获取它们,所以我构建了一个闪亮的自定义输入控件可以做到。这是一项相当大的工作量,而且可能有更简单的方法,但我没有看到它,至少我现在知道如何为 shiny 构建自定义输入控件。如果有人知道更简单的方法,请赐教。
这是 javascript,它进入一个 www
子文件夹,您将其保存在与闪亮代码相同的目录中。
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
并将其显示在 table 中。我使用了 userMatrix
而不是 modelMatrix
因为前者很容易用鼠标改变,所以你可以看到你得到的是最新的值。
请注意名称 "app.R" 并不是可选的。要么你必须使用它,要么将文件拆分为 "ui.R" 和 "server.R",否则它不会导入上面的 javascript 文件。
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)
最后是它的样子:
请注意,我对其进行了设置,以便您可以向其中添加命令,您可以(可能)更改参数以及基于此控件的控件的任何其他内容。
还要注意这里的par3d
结构(转换为json然后从rglwidget
javascript转换为R)和rgl
中的结构不是完全相同,所以例如我不得不展平 userMatrix
因为 WebGL 似乎更喜欢它作为名称列表而不是按预期出现的其他矩阵。
我有一个闪亮的应用程序并在其中集成了一个 rgl 3d-plot。我正在使用 rglwidget
包中的 renderRglwidget
将使用 webgl 的 rgl 图形插入到我闪亮的应用程序中。
在应用程序中,用户可以旋转图形。现在我想保存旋转状态,因此 userMatrix 或 modelMatrix 稍后会生成一个类似的图,其旋转与用户离开上一个图形时的旋转相同。
Here 我读了一些关于 java 存储 userMatrix 和其他参数的变量。我可以从我闪亮的应用程序中访问它们吗(在 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
似乎return什么都没有。
rgl:par3d()
没有 return 任何东西的原因是 rgl
包实际上并没有管理闪亮的场景。利用 WebGL
的基于 javascript 的 rglwidget
库正在管理它,您正在将场景复制到另一个非常兼容的 GL 库(也许他们甚至使用相同的编译库,但我怀疑它)并以闪亮的方式显示。所以rgl.dev()
帮不了你。
AFAIK,获取这些值并不容易,因为它们隐藏在 rglwidget
javascript 中,但我想获取它们,所以我构建了一个闪亮的自定义输入控件可以做到。这是一项相当大的工作量,而且可能有更简单的方法,但我没有看到它,至少我现在知道如何为 shiny 构建自定义输入控件。如果有人知道更简单的方法,请赐教。
这是 javascript,它进入一个 www
子文件夹,您将其保存在与闪亮代码相同的目录中。
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
并将其显示在 table 中。我使用了 userMatrix
而不是 modelMatrix
因为前者很容易用鼠标改变,所以你可以看到你得到的是最新的值。
请注意名称 "app.R" 并不是可选的。要么你必须使用它,要么将文件拆分为 "ui.R" 和 "server.R",否则它不会导入上面的 javascript 文件。
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)
最后是它的样子:
请注意,我对其进行了设置,以便您可以向其中添加命令,您可以(可能)更改参数以及基于此控件的控件的任何其他内容。
还要注意这里的par3d
结构(转换为json然后从rglwidget
javascript转换为R)和rgl
中的结构不是完全相同,所以例如我不得不展平 userMatrix
因为 WebGL 似乎更喜欢它作为名称列表而不是按预期出现的其他矩阵。