Search code examples
rshinyreactive

R Shiny reactivePoll inside observeEvent doesnt execute valueFunc


I want to have a valueFun executed when a button is clicked, so that a plot arises...however only checkFunc is executed (the time is being printed in the console....but data_poll is not being updated via valueFunc of generate_data function. Why?

library(shiny)

# Function to generate random data
generate_data <- function() {
  data <- data.frame(
    x = rnorm(10),
    y = rnorm(10)
  )
  return(data)
}

# Define UI
ui <- fluidPage(
  titlePanel("ReactivePoll Example"),
  mainPanel(
    actionButton("btn", "Click Me!"),
    uiOutput('uioutput')
  )
)

# Define server logic
server <- function(input, output, session) {
  
  data_poll <- reactiveVal(NULL)
  
  # Observing the button click event
  observeEvent(input$btn, {
    # Display a message when the button is clicked
    output$eventText <- renderText({
      "Button Clicked!"
    })
    
    # Function to poll for updated data every 10 seconds
    data_poll <- reactivePoll(
      intervalMillis = 10000,
      session = session,
      checkFunc = function() {
        # Return a timestamp to trigger polling
        Sys.time()
        print(Sys.time())
      },
      valueFunc = function() {
        # Generate new data
        generate_data()
      }
    )
  })
  
  output$uioutput = renderUI({
    if (!is.null(data_poll()) && nrow(data_poll()) > 0) {
      plotOutput("scatterPlot")
    }
  })
  
  # Render the scatter plot
  output$scatterPlot <- renderPlot({
    data <- data_poll()
    plot(data$x, data$y, main = "Scatter Plot", xlab = "X", ylab = "Y")
  })
  
}

# Run the application
shinyApp(ui, server)

ReactivePoll code:

ui <- fluidPage(
  titlePanel("ReactivePoll Example"),
  mainPanel(
    actionButton("btn", "Click Me!"),
    uiOutput('uioutput'),
    textOutput("eventText")
  )
)

server <- function(input, output, session) {
  
  data_poll <- reactiveVal(NULL)
  ready <- reactiveVal(FALSE)
  
  # Display a message when the button is clicked
  observeEvent(input$btn, {
    
    ready(TRUE)
    
  })
  
  data_poll <- reactivePoll(
    intervalMillis = 10000,
    session = session,
    checkFunc = function() {
      # Return a timestamp to trigger polling
      
      Sys.Date()
      
      print(Sys.Date())
    },
    valueFunc = function() {
      # Generate new data
      req(ready())
      generate_data()
    }
  )
  
  output$uioutput = renderUI({
    req(data_poll(), ready())
    plotOutput("scatterPlot")
  })
  
  # Render the scatter plot
  output$scatterPlot <- renderPlot({
    req(ready())
    data <- data_poll()
    plot(data$x, data$y, main = "Scatter Plot", xlab = "X", ylab = "Y")
  })
  
}

# Run the application
shinyApp(ui, server)

Solution

  • I've never seen an instance where nested reactive/observe blocks added any value, more often nesting them causes problems with flow.

    1. Remove the nesting.
    2. Add input$btn to the output$eventText.
    3. Add textOutput("eventText"), likely just an oversight in your example.
    4. Changed from reactivePoll to invalidateLater(10000) within a reactive(..).
    ui <- fluidPage(
      titlePanel("ReactivePoll Example"),
      mainPanel(
        actionButton("btn", "Click Me!"),
        uiOutput('uioutput'),
        textOutput("eventText")
      )
    )
    
    server <- function(input, output, session) {
      
      data_poll <- reactiveVal(NULL)
      ready <- reactiveVal(FALSE)
      
      # Display a message when the button is clicked
      output$eventText <- renderText({
        req(input$btn)
        ready(TRUE)
        "Button Clicked!"
      })
      
      data_poll <- reactive({
        req(ready())
        print(Sys.time())
        invalidateLater(10000, session)
        generate_data()
      })
      
      output$uioutput = renderUI({
        req(data_poll(), ready())
        plotOutput("scatterPlot")
      })
      
      # Render the scatter plot
      output$scatterPlot <- renderPlot({
        req(ready())
        data <- data_poll()
        plot(data$x, data$y, main = "Scatter Plot", xlab = "X", ylab = "Y")
      })
      
    }
    

    Edited so that the 10-second data generation doesn't start until the button is pressed.

    If you need it, the "true" value of ready() can be toggled, which means you can choose to "stop/pause" the every-10-second poll.