Vincent Guyader
Vincent Guyader

Reputation: 3199

how to synchronize a shiny progress bar with a llply progress bar

I would like to find a way to show a llply progress bar inside the shiny UI. please have a look to the code bellow. Do you have any idea ?

library(shiny)
library(plyr)
function_I_cant_edit <- function(){plyr::llply(LETTERS ,.fun=function(x){Sys.sleep(0.2)},.progress = "text")}

server<-shinyServer(function(input, output,session) {


  observeEvent(input$go, {

    progress <- shiny::Progress$new(session, min=1, max=15)
    on.exit(progress$close())
    progress$set(message = 'Calculation in progress')
    function_I_cant_edit()

    for (i in 1:15) {
      progress$set(value = i)
      Sys.sleep(0.1)
    }

  })

  output$plot <- renderPlot({
    plot(cars)
  })
})

ui <- basicPage(
  actionButton("go","PUSH ME"),
  plotOutput("plot")

)
shinyApp(ui = ui, server = server)

An idea is to use progress="tk" inside the llply, but is there a sexiest way ?

Another idea will be to show the console output in the shiny app... but I didn't manage this.

Regards

EDIT :

the llpy function use progress_tk() or progress_text() or progress_time()

So I created a progress_shiny() function

    progress_shiny <-function (title = "plyr progress", label = "Working...", ...) 
{
  n <- 0
  tk <- NULL
  list(init = function(x) {
    tk    <<- shiny::Progress$new(session,min=1, max=15)

    tk$set(message = 'Calculation in progress')
  }, step = function() {
    n <<- n + 1
    tk$set(value = n)
  }, term = function() print("fin"))
}

And I tried :

server<-shinyServer(function(input, output,session) {

  # session <<- session
  observeEvent(input$go, {


    # function_I_cant_edit()
    llply(LETTERS ,.fun=function(x){Sys.sleep(0.2)},.progress = "shiny")


  })

  output$plot <- renderPlot({
    plot(cars)
  })
})

ui <- basicPage(
  actionButton("go","PUSH ME"),
  plotOutput("plot")

)
shinyApp(ui = ui, server = server)

But the error message is 'Error in public_bind_env$initialize(...) : objet 'session' introuvable' ...

I think i m on the way to find something ;)

Upvotes: 2

Views: 843

Answers (2)

pmallot
pmallot

Reputation: 1

Following the code from the plyr package you can also put the initialization and termination of the progress dialogue into the function as well. That, together with some sensible defaults, makes for a rather clean call.

progress_shiny <- function(session, min=0, value=min, step=1, message="Working...") {
  p<-NULL
  list(
    init = function(max) {
      p<<-shiny::Progress$new(session, min=min, max=max)
      p$set(value=value, message=message)
    },
    step = function() {
      p$inc(step)
    },
    term = function(){
      p$close()  
    }
  )
}

Usage becomes much shorter:

observeEvent(input$go, {
  # no additional setup needed
  llply(LETTERS ,.fun=function(x){
    Sys.sleep(0.2)
  }, .progress = progress_shiny(session))
})

Upvotes: 0

Romain Francois
Romain Francois

Reputation: 17642

You can create a custom progress handler that takes a progress object from shiny, e.g.

progress_shiny <-function (progress, step = 1){
  list(
    init = function(n){},
    step = function() {
      progress$set( progress$getValue() + step )
    }, 
    term = function(){}
  )
}

And use it something like this in your server code.

observeEvent(input$go, {
  progress <- shiny::Progress$new(session, min=0, max=50)
  on.exit(progress$close())

  # use the main progress outside of llply 
  progress$set( value = 1)
  Sys.sleep( 1 )
  progress$set( value = 20 )

  # then pass it along so that llply steps 
  # contribute to the main progress
  llply(LETTERS ,.fun=function(x){
    Sys.sleep(0.2)
  }, .progress = progress_shiny(progress))

})

This way the progress bar inside llply contributes to the main progress bar

Upvotes: 2

Related Questions