How do I use an actionButton to delay a defined function?

Steven Ouellette 0
Viewed 32

I can see how to use actionButton to delay an output, but I haven't seen an example relevant to what I am trying to do, which is delay the start of a defined function that is called within another output.

Simplified for the MRE, let's say I have an output to create the mean of a data set. I have three ways to calculate the mean. One of those ways takes a long time though (simulated here by Method 2). Here is the way it is structured now.

How can I get algo(x) to wait until the button is pressed, then start the calculation and return the value?


library(shiny)

# Define UI 
ui <- fluidPage(

    # Application title
    titlePanel("Old Faithful Geyser Data"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30),
            radioButtons(inputId = "calc_t",label = "Select Calculation",choices = c("Method 1"=1,"Method 2 (long)"=2,"Method 3"=3)),
            actionButton(inputId = "go_algo",label = "Start Algo")
        ),

        # Show a plot of the generated distribution
        mainPanel(
           plotOutput("distPlot"),
           textOutput("analyze")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

    output$distPlot <- renderPlot({
        # generate bins based on input$bins from ui.R
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = input$bins + 1)

        # draw the histogram with the specified number of bins
        hist(x, breaks = bins, col = 'darkgray', border = 'white',
             xlab = 'Waiting time to next eruption (in mins)',
             main = 'Histogram of waiting times')
    })
    
    output$analyze <- renderText({
      calc_type<-input$calc_t
      x    <- faithful[, 2]
      if(calc_type==1){
        output<-paste("Mean 1 = ",mean(x))
      } else if (calc_type==2){
        output<-paste("Mean 2 = ",algo(x))
      } else if(calc_type==3){
        output<-paste("Mean 3 = ",sum(x)/length(x))
      }
    })
    
    algo<-function(x){
      mean_x<-mean(x)
      #stuff that would take a long time
      output<-mean_x+100
      return(output)
    }
    
}

# Run the application 
shinyApp(ui = ui, server = server)
shiny r
1 Answers

I would suggest using an observeEvent for the action button for the function that needs to wait for the button. For this observeEvent a req is required to limit the button to work only for this choice. Then you can use another observeEvent for the the other choices and again limit what is allowed to run without a button click with req. Here's the updated server code:

server <- function(input, output) {
  
  output$distPlot <- renderPlot({
    # generate bins based on input$bins from ui.R
    x <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    
    # draw the histogram with the specified number of bins
    hist(x, breaks = bins, col = 'darkgray', border = 'white',
         xlab = 'Waiting time to next eruption (in mins)',
         main = 'Histogram of waiting times')
  })
  
  observeEvent(input$calc_t, {
    req(input$calc_t!=2)
    output$analyze <- renderText({
      
      calc_type<-input$calc_t
      x <- faithful[, 2]
      if(calc_type==1){
        output<-paste("Mean 1 = ",mean(x))
      } else if(calc_type==3){
        output<-paste("Mean 3 = ",sum(x)/length(x))
      }
    })
  })
  
  observeEvent(input$go_algo, {
    req(input$calc_t==2)
    output$analyze <- renderText({
      
      isolate(calc_type<-input$calc_t)
      x <- faithful[, 2]
      output<-paste("Mean 2 = ",algo(x))
    })
  })
  
  
  algo<-function(x){
    mean_x<-mean(x)
    #stuff that would take a long time
    output<-mean_x+100
    return(output)
  }
  
}
ekolima0
Related