光沢のあるアプリrglwidget同じ回転を持つ別のプロットを生成するuserMatrixを取得

Question

私は光沢のあるアプリを持っていて、それにrgl 3d-plotを統合しています。 rglwidgetパッケージのrenderRglwidgetを使用して、私の光沢のあるアプリにwebglを使用してrglグラフィックを挿入しています。

アプリでは、ユーザーはグラフィックを回転できます。今度は、回転状態を保存したいので、userMatrixまたはmodelMatrixを使用して、前回のグラフを残したときと同じ回転で同様のプロットを生成します。

Here私はuserMatrixと他のパラメータを格納するjava変数について何かお読みください。私の輝くアプリの中から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パッケージが実際に光沢のあるシーンを管理していないためです。 を活用しているjavascriptベースのrglwidgetライブラリでは、これを管理しています。別の非常に互換性のあるGLライブラリにシーンをコピーしています（おそらく、同じコンパイル済みのライブラリを使用していても疑いません）。だからrgl.dev()はあなたを助けません。

AFAIKこれらの値は、rglwidget javascriptで非表示になっているため、取得するのは容易ではありませんが、私はそれらに到達したいので、それを行うことができる光沢のあるカスタム入力コントロールを作成しました。それはかなりの量の作業でしたが、もっと簡単な方法があるかもしれませんが、私はそれを見ていませんでした。少なくとも、光沢のあるカスタム入力コントロールを構築する方法を知っています。誰かが簡単な方法を知っているなら、私に教えてください。

ここでは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 /光沢のコードです。通常のテストシーンを使用し、シーンuserMatrixを照会するボタンがあり、それをテーブルに表示します。私は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) 

そして最後に、それは次のようになります。あなたはそれにコマンドを追加することができます

私はそれを設定する注意、あなたは（可能性おそらく）は、これに基づいてコントロールを使ってパラメータやその他のものを変更します。

はまた、例えば、私はWebGLのは、としてそれを好むように見えるようuserMatrixを平らにするために持っていたので、ここでpar3d構造は（JSONに変換してからRへrglwidgetジャバスクリプトから）とrgl中1は非常に同一ではないことに注意してください期待どおりに来た他の行列とは対照的に、名前リスト。