Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
326 views
in Technique[技术] by (71.8m points)

r - Update plot within observer loop in shiny application

I have written a simulation in R that I want to visualize with shiny now. I have put the main part of the simulation into an observe block in order to be evaluated. During this evaluation process, i.e. for every iteration I want to plot the current status. The question is how do I achive this, since in my actual code the rendering of the plot is just executed after the main observer has been evaluated. Is there a way to, for instance, suspend the execution of the observe block and resume it after the plot has been updated?

Shouldn't there be some more functionality from shiny to address such a case, since I could imagine that I'm not the only one who would like to do something like this?!

It would be nice if you can help me with this :)

Below is some skeleton code for the server and ui.

ui.R:

library(shiny)

shinyUI(pageWithSidebar(

  headerPanel("... Simulation"),

  sidebarPanel(
    sliderInput("epochs", 
                "Number of Epochs:", 
                min = 1,
                max = 100, 
                value = 10),
    verbatimTextOutput("curr.iter"),
    actionButton("actionB", "Action!")
  ),

  mainPanel(
    plotOutput("distPlot")
  )
))

server.R:

library(shiny)

sinus <- data.frame()

shinyServer(function(input, output) {

  dummy <- reactiveValues(iter=0)

  obsMain <- observe({
    for (i in 1:input$epochs) {
      cat(i, " ")
      x <- seq(1:input$epochs)
      y <- sin(x)
      sinus <<- data.frame(x, y)
      dummy$iter <- i
      #
      # At this time I want distPlot & curr.iter to be evaluated/updated!
      #
      Sys.sleep(1)

    }

  }, suspended=TRUE)


  obsAction <- observe({ if(input$actionB > 0) obsMain$resume() })  # Helps to avoid initial evaluation of obsMain...

  output$curr.iter <- renderText({ as.numeric(dummy$iter) })

  output$distPlot <- renderPlot({ if (dummy$iter > 1) plot(sinus, type="l") })

})
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

I've been doing a little more thinking about this. I think the proper solution is to use invalidateLater to schedule work to occur in small chunks but allow other reactive dependencies to interrupt our long-running process to do things like updating graphs.

I put together a quick example at https://gist.github.com/trestletech/8608815 . You can run this with

runGist(8608815)

The basic premise is that we're doing some long-running iterative computing like what's done in your simulation, but we do it in smaller chunks to allow other reactives to run in between. My code is really simple to execute, so I can handle 100,000 iterations of my loop in ~1 second, which is about how long I'm willing to wait for my app to update interactively. I want to do 5 million iterations, so I schedule 50 chunks to occur.

Each time I run a chunk of 100,000 iterations, I'm updating a couple of reactive values that spawn some other updates that end up getting sent to my UI in a renderText (though a renderPlot like yours would work the exact same). If you run the app, you'll see that those reactives are updated in between each chunk I run before the next chunk gets scheduled to run.

There is a bit of overhead with this method, so your computation may slow down just a bit. But on my machine, 5 million iterations took 21 seconds when run all at once on the console, and took 23 seconds in this delayed-dispatch model. You could drive that down further by doing bigger chunks, of course.

Let me know what you think. I'm thinking it might make sense to wrap this up and either include pieces of it in Shiny or as an extension package.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...