简体   繁体   中英

ObserveEvent not Triggering in R Shiny

I have a shiny app where I am using observeEvent to watch for a particular action (a radiobutton selection from one of three choices: "year", "quarter", and "month"). Depending on this selection, a selectInput dropdown is populated in the UI with a year vector (eg 2012, 2013, etc.), a quarter vector (2012-4, 2013-1, etc.) or a month vector (2012-11, 2012-12, 2013-1, etc).

This code works when the app starts up. For whichever radiobutton value is selected all the code works properly.

However, if I change the radiobutton selection (the observeEvent trigger), the correct vector for the new selection isn't generated and populated in the UI selectInput(for example, if the default radiobutton was "year" and I select "quarter", I find that the proper vector for quarter isn't generated and populated in the UI SelectInput). This causes a crash and downstream errors.

Can anyone advise why this doesn't work?

Code is below.

ui <- fluidPage(
    selectInput(inputId = "date_range_reg_univ_cohorts_from",
                label = "Select Registration Range From",
                "")

   )

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

  observeEvent(
    
    input$ui_button_period_2D_conv,{
    
    if(input$ui_button_period_2D_conv == 'year'){
      
      conv_dates <- date_slicing$cohort_year_from_vec
      
      conv_dates <- paste0(year(conv_dates))

      updateSelectInput(
        session,
        "date_range_reg_univ_cohorts_from",
        choices = conv_dates)
      
    }else if(input$ui_button_period_2D_conv == 'quarter'){
      
      conv_dates <- date_slicing$cohort_quarter_from_vec

      conv_dates <- paste0(year(conv_dates)," - ",quarter(conv_dates))
      
      updateSelectInput(
        session,
        "date_range_reg_univ_cohorts_from",
        choices = conv_dates)
      
      
    }else if(input$ui_button_period_2D_conv == 'month'){
      
      conv_dates <- date_slicing$cohort_month_from_vec
   
      conv_dates <- paste0(year(conv_dates)," - ",month(conv_dates))
      
      updateSelectInput(
        session,
        "date_range_reg_univ_cohorts_from",
        choices = conv_dates)
      
      
    }
    
    }
    
  )

}  

Perhaps you should use eventReative() first and then use observeEvent() as shown below.

year <- c(2010:2015)
month <- c(1:12)
quarter <- c(1:4)

ui <- fluidPage(

  radioButtons("ui_button_period_2D_conv", "Choose", choices = c("Year" = "year", "Month" = "month", "Quarter" =  "quarter") ),
  selectInput(inputId = "date_range_reg_univ_cohorts_from",
              label = "Select Registration Range From",
              "")

)

server <- function(input, output, session) {
  
  conv_dates <- eventReactive(input$ui_button_period_2D_conv, {
    if(input$ui_button_period_2D_conv == 'year'){
      
      conv_dates <- paste0(year)
      
    }else if(input$ui_button_period_2D_conv == 'quarter'){
      
      conv_dates <- paste0(rep(year, each=max(quarter)),"-",quarter)
      
    }else if(input$ui_button_period_2D_conv == 'month'){
      
      conv_dates <- paste0(rep(year, each=max(month)),"-",month)
      
    }
    conv_dates
  })

  observeEvent(input$ui_button_period_2D_conv, {
    req(conv_dates())
    updateSelectInput(session, "date_range_reg_univ_cohorts_from", choices = conv_dates())
  })

}

shinyApp(ui = ui, server = server)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM