Plot Animation in Shiny mit rgl

Question

Ich habe gerade angefangen Shiny zu verwenden und ich versuche, eine "Animation" mit Hilfe von Plopp oder For-Schleife in Shiny zu plotten, aber ich kann nicht scheinen, die richtige Ausgabe zu bekommen. Wenn Sie Base R verwenden, funktioniert mein Code.

Meine Daten sind nicht als Zeitreihe festgelegt, aber jede Zeile repräsentiert eine Beobachtung in der Zeit.

Auch ich bin bereit, ein anderes Paket (außer rgl) zu verwenden, wenn nötig.

Und ich mache Gebrauch von einigen der Code beschrieben here, einschließlich der JavaScript-Datei rglwidgetaux.js.

global.R

library(rgl) 

# MAIN FUNCTION 

movement.points<-function(DATA,time.point,CONNECTOR){ 

    DATA.time<-DATA[time.point,] 

    DATA.time<-matrix(DATA.time,c(3,4),byrow = TRUE) 

    x<-unlist(DATA.time[,1]) 
    y<-unlist(DATA.time[,2]) 
    z<-unlist(DATA.time[,3]) 

    next3d(reuse=FALSE) 
    points3d(x=x,y=y,z=z,size=6,col="blue") 
    segments3d(x=c(x,x[CONNECTOR]),y=c(y,y[CONNECTOR]),z=c(z,z[CONNECTOR]),col="red") 
    Sys.sleep(0.05) 
} 

############################################################################ 

Mit der Funktion oben, das funktioniert:

# INITIAL POSITION 
    rgl.viewpoint(userMatrix=rotationMatrix(0,2,0,0)) 
    U <- par3d("userMatrix") 
    par3d(userMatrix = rotate3d(U, pi, 1,1,2)) 
    movement.points(DATA=DATA.position,time.point=1,CONNECTOR=CONNECTOR) 


    # # ANIMATION (THIS IS WHAT I WANT TO RUN IN SHINY) 
lapply(1:dim(DATA.position),movement.points,DATA=DATA.position,CONNECTOR=CONNECTOR) 

Aber ich kann die "Animation" (die lapply) arbeiten in Shiny nicht bekommen. Dies ist, was ich getan habe:

ui.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'), 
    rglwidgetOutput("plot3d"), 
    actionButton("queryumat", "Select initial position"), 
    tableOutput("usermatrix"), 
    actionButton("regen", "Visualize sequence with new position") 
    ,rglwidgetOutput("plot3d2") 
) 

server.R

source('global.R', local=TRUE) 
library(shiny) 
library(rgl) 
library(jsonlite) 
library(htmlwidgets) 

options(shiny.trace=TRUE) 

server <- function(input, output, session) 
{ 
    # DATA 

    DATA.position<-c(0.099731,-0.509277,3.092024,1,0.173340,-0.869629,3.142025,1,0.197632,-0.943848,3.099056,1, 
        0.099315,-0.509114,3.094403,1,0.173125,-0.868526,3.140778,1,0.196985,-0.943108,3.100157,1, 
        0.099075,-0.509445,3.094318,1,0.172445,-0.869610,3.138849,1,0.196448,-0.943238,3.100863,1, 
        0.097668,-0.508197,3.090442,1,0.172319,-0.869749,3.138942,1,0.195357,-0.943346,3.102253,1, 
        0.096432,-0.507724,3.087681,1,0.172151,-0.870230,3.139060,1,0.193886,-0.943752,3.103878,1, 
        0.095901,-0.508632,3.086148,1,0.172345,-0.870636,3.139181,1,0.193134,-0.943644,3.107753,1, 
        0.093076,-0.513129,3.082425,1,0.173721,-0.874329,3.139272,1,0.188041,-0.949220,3.111685,1, 
        0.092158,-0.513409,3.082376,1,0.173221,-0.876358,3.141781,1,0.188113,-0.949724,3.111405,1, 
        0.091085,-0.513667,3.082308,1,0.173626,-0.876292,3.140349,1,0.189704,-0.948493,3.108416,1, 
        0.089314,-0.514493,3.083489,1,0.173133,-0.876019,3.141443,1,0.189653,-0.947757,3.108083,1, 
        0.087756,-0.515289,3.084332,1,0.172727,-0.875819,3.141264,1,0.189452,-0.947415,3.108107,1, 
        0.085864,-0.515918,3.085951,1,0.172672,-0.876940,3.141271,1,0.190892,-0.946514,3.104689,1, 
        0.084173,-0.515356,3.087133,1,0.172681,-0.876866,3.140089,1,0.189969,-0.944275,3.100415,1, 
        0.065702,-0.518090,3.097703,1,0.172706,-0.876582,3.139876,1,0.189737,-0.944277,3.100796,1, 
        0.063853,-0.517976,3.099412,1,0.172821,-0.876308,3.139856,1,0.189682,-0.944037,3.100752,1, 
        0.062551,-0.518264,3.100512,1,0.172848,-0.874960,3.139102,1,0.190059,-0.942105,3.098919,1, 
        0.065086,-0.517151,3.098104,1,0.172814,-0.875237,3.138775,1,0.190539,-0.942204,3.098439,1, 
        0.064088,-0.517003,3.098001,1,0.172911,-0.874908,3.137694,1,0.190593,-0.942012,3.097417,1, 
        0.065648,-0.516077,3.094584,1,0.172581,-0.874648,3.137671,1,0.190480,-0.942432,3.098431,1, 
        0.068117,-0.516750,3.094343,1,0.172545,-0.874946,3.136352,1,0.190648,-0.942610,3.096850,1) 

    DATA.position<-matrix(DATA.position,c(20,12),byrow = TRUE) 

    CONNECTOR<-c(1,2,3) 

    ############################################# 
    # THIS WORKS 
    # INITIAL POSITION MATRIX 
    observe({ 
    input$queryumat 
    session$sendInputMessage("ctrlplot3d",list("cmd"="getpar3d","rglwidgetId"="plot3d")) 
    }) 


    # USER POSITION MATRIX 

    # SELECTION 
    umat <-reactive({ 
    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) 
    }) 

    ## SHOW POSITION 
    output$usermatrix <- renderTable({ 
    umat() 
    }) 

    # INITIAL IMAGE 

    scenegen <- reactive({ 
    rgl.viewpoint(userMatrix=rotationMatrix(0,2,0,0)) 
    U <- par3d("userMatrix") 
    par3d(userMatrix = rotate3d(U, pi, 1,1,2)) 
    movement.points(DATA=DATA.position,time.point=1,CONNECTOR=CONNECTOR) 
    scene1 <- scene3d() 
    rgl.close() # make the app window go away 
    return(scene1) 
    }) 
    output$plot3d <- renderRglwidget({ rglwidget(scenegen()) }) 

    ############################################################ 

    # NOT WORKING 
    # Animation after selecting position 

    # 1st TRY 
    # scenegen2 <- eventReactive(input$regen,({ 
    # par3d(userMatrix = umat()) 
    # lapply(1:dim(DATA.position)[1],movement.points,DATA=DATA.position,CONNECTOR=CONNECTOR) 
    # scene2 <- scene3d() 
    # rgl.close() # make the app window go away 
    # return(scene2) 
    # }) 
    #) 
    # output$plot3d2 <- renderRglwidget({ rglwidget(scenegen2()) }) 

    # 2nd TRY 
    # output$plot3d2 <- eventReactive(input$regen, 
         # renderRglwidget({ 
         # lapply(1:dim(DATA.position)[1],movement.points,DATA=DATA.position,CONNECTOR=CONNECTOR) 
         # scene2 <- scene3d() 
         # rgl.close() # make the app window go away 
         # return(scene2) 
         # }) 
    #     ) 

    # 3rd TRY 
    # for (i in 1:(dim(DATA.position)[1])){ 
    # scenegen2 <- eventReactive(input$regen,({ 
    # par3d(userMatrix = umat()) 
    # movement.points(DATA=DATA.position,time.point=i,CONNECTOR=CONNECTOR) 
    # scene2 <- scene3d() 
    # rgl.close() # make the app window go away 
    # return(scene2) 
    # }) 
    #) 
    # output$plot3d2 <- renderRglwidget({ rglwidget(scenegen2()) }) 
    # } 

    #4th TRY 
    observe({ 
    input$regen 
    isolate({ 
     for (i in 1:(dim(DATA.position)[1])){ 
     par3d(userMatrix = umat()) 
     movement.points(DATA=DATA.position,time.point=1,CONNECTOR=CONNECTOR) 
     scene2 <- scene3d() 
     rgl.close() 

     output$plot3d2 <- renderRglwidget({ rglwidget(scene2) }) 
     } 
    }) 
    }) 
} 

Dank.

Answer 1

Ich habe gefunden Animationen mit Shiny sind zu langsam: Es gibt eine Menge Daten von R an Javascript übergeben, um eine rgl Szene anzuzeigen, und es dauert zu lange für jedes Frame-Update. Sie sind besser dran mit den Techniken in der WebGL-Vignette basierend auf playControl. Leider müssen Sie die Daten für jeden Animationsrahmen vorab berechnen und sind daher nicht immer verfügbar.