Plot animation in Shiny with rgl

Question

I just started using Shiny and I'm trying to plot an "animation" using lapply or a for loop in Shiny, but I can't seem to get the correct output. When using base R, my code works.

My data is not set as a time series, but each row represents an observation in time.

Also, I'm willing to use another package (other than rgl), if necessary.

And, I'm making use of some of the code described here, including the javascript file 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)
}

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

Using the function above, this works:

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

But I can't get the "animation" (the lapply) to work in Shiny. This is what I've done:

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

Thanks.

You should try the `shinyRGL` package http://trestletech.github.io/shinyRGL/ — Stéphane Laurent, Jul 14 '17 at 16:55

score 0 · Answer 1 · answered Jul 14 '17 at 13:09

I've found animations using Shiny are too slow: there's a lot of data passed from R to Javascript to show an rgl scene, and it takes too long for each frame update. You're better off using the techniques shown in the WebGL vignette based on playControl. Unfortunately these require you to precompute data for each animation frame, so aren't always available.

Plot animation in Shiny with rgl

1 Answers1