Animation de tracé dans Shiny avec

Question

Je viens de commencer à utiliser Shiny et j'essaye de tracer une "animation" en utilisant lapply ou une boucle for dans Shiny, mais je n'arrive pas à obtenir la bonne sortie. Lorsque vous utilisez la base R, mon code fonctionne.

Mes données ne sont pas définies comme une série chronologique, mais chaque ligne représente une observation dans le temps.

De plus, je suis prêt à utiliser un autre paquet (autre que réglé), si nécessaire.

Et, je fais usage de certains du code décrit here, y compris le fichier javascript de 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) 
} 

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

En utilisant la fonction ci-dessus, cela fonctionne:

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

Mais je ne peux pas obtenir le "animation" (le lapply) pour travailler en brillant. Voilà ce que je l'ai fait:

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

Merci.

Answer 1

J'ai trouvé que les animations utilisant Shiny sont trop lentes: il y a beaucoup de données passées de R en Javascript pour montrer une scène rgl, et cela prend trop de temps pour chaque mise à jour de l'image. Vous feriez mieux d'utiliser les techniques présentées dans la vignette WebGL basée sur playControl. Malheureusement, cela nécessite que vous précalculiez les données pour chaque image d'animation, elles ne sont donc pas toujours disponibles.