Search code examples
rshinyshinydashboardshiny-servershiny-reactivity

SelectInput (inside Table Cell) does not read input$ID value after any change in the inputs it is based on


I have SelectInputs inside cells in a table. I am able to read the value from the selectInput as long as the actionButton is clicked once. But after clicking the actionButton again, it does not read the value from the SelectInput from the table Cell.

Here is a reproducible example for my code:

master_table <- data.frame("class_col" = c("A", "A", "A", "A", "A", "B", "B", "B", "B", "B", "C", "C", "C", "C", "C"), 
                           "all_student"=c("CA1", "CA2", "CA3", "CA4", "CA5", "CB1", "CB2", "CB3", "CB4", "CB5", "CC1", "CC2", "CC3", "CC4", "CC5"))

library(shiny)

ui <- fluidPage(fluidRow(
  selectInput("class_input", label = "Class", choices= sort(c("Select Class"='', unique(master_table$class_col))), selected=NULL),
  shinyjs::hidden(tags$div(id="alert", tags$h5("* Please Select Class ", style = "color:red"))),
  actionBttn(inputId = 'go', label='Go!'),
  shinyjs::hidden(tags$div(id='hidden_table', DT::dataTableOutput('student_select_table'))),
  textOutput("text_output_for_selected_Student_at_Row1"))
 )

server <- function(input, output, session) {
  
  mod = reactiveValues(student_reactive=0)
  
  observeEvent(input$class_input, {
    student_table = data.table('student_input_col' = 1:5)
    
    mod$student_reactive <- reactive({
      for (i in 1:nrow(student_table)){
        student_table$student_input_col[i] <- as.character(selectInput(inputId = paste0("student_row", i),
                                                                       label=NULL,
                                                                       choices = sort(c("Select Student"='', master_table$all_student[master_table$class_col == input$class_input]))))
      }
      return(student_table)
      })
    })


observeEvent(input$go, {

if(nchar(input$class_input)<1){
  shinyjs::showElement("alert")
  shinyjs::hideElement("hidden_table")
} else {
shinyjs::hideElement("alert")
shinyjs::showElement("hidden_table")

output$student_select_table <- DT::renderDataTable({
  datatable(mod$student_reactive(),
            class= "cell-border",
            rownames = FALSE, width = "80%",escape = FALSE,
            selection = "single",
            options = list(dom='t', paging=FALSE, ordering=FALSE, info=FALSE,
                           rowCallback = JS("function(r,d) {$(r).attr('height', '40px')}"),
                           preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                           drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
            )
  })
}
})

output$text_output_for_selected_Student_at_Row1 <- renderText(paste0("Text for Student at Row1 = ", input$student_row1))

}

runApp(shinyApp(ui = ui, server = server))

This works fine when I run it one time. It also updates the Students in the table cell drop-down when I change class_input. But the value in the text_output_for_selected_Student_at_Row1 does not update if I change the value of class_input or if I click on the actionButton again.


Solution

  • As stated in the comment, one way to resolve your issue is to create a new ID each time a user selects a new class_col. We can attach the class and a counter to define the new inputId. Please note that the table is updated only after you click the actionButton. Try this

    master_table <- data.frame("class_col" = c("A", "A", "A", "A", "A", "B", "B", "B", "B", "B", "C", "C", "C", "C", "C"), 
                               "all_student"=c("CA1", "CA2", "CA3", "CA4", "CA5", "CB1", "CB2", "CB3", "CB4", "CB5", "CC1", "CC2", "CC3", "CC4", "CC5"))
    
    library(shiny)
    library(DT)
    library(data.table)
    
    ui <- fluidPage(fluidRow(
      selectInput("class_input", label = "Class", choices= sort(c("Select Class"='', unique(master_table$class_col))), selected=NULL),
      shinyjs::hidden(tags$div(id="alert", tags$h5("* Please Select Class ", style = "color:red"))),
      actionBttn(inputId = 'go', label='Go!'),
      shinyjs::hidden(tags$div(id='hidden_table', DT::dataTableOutput('student_select_table'))),
      textOutput("text_output_for_selected_Student_at_Row1"))
    )
    
    server <- function(input, output, session) {
      
      mod = reactiveValues(student_reactive=0, df=NULL)
      cntr <- reactiveValues(value=0)
      
      k <- eventReactive(input$class_input, {
        cntr$value <- cntr$value+1
        return(cntr$value) })
      observe({print(k())})
      
      observeEvent(input$class_input, {
        student_table = data.table('student_input_col' = 1:5)
        #req(k())
        for (i in 1:nrow(student_table)){
          student_table$student_input_col[i] <- as.character(selectInput(inputId = paste0("student_row", i, input$class_input,k()),
                                                                         label=NULL,
                                                                         choices = sort(c("Select Student"='', master_table$all_student[master_table$class_col == input$class_input]))))
        
        }
        mod$student_reactive <- student_table
          
      }, ignoreNULL = TRUE)
      
      
      observeEvent(input$go, {
        
        if(nchar(input$class_input)<1){
          shinyjs::showElement("alert")
          shinyjs::hideElement("hidden_table")
        } else {
          shinyjs::hideElement("alert")
          shinyjs::showElement("hidden_table")
          
          mod$df <- mod$student_reactive
        }
      })
      
      output$student_select_table <- DT::renderDataTable({
        datatable(mod$df,
                  class= "cell-border",
                  rownames = FALSE, width = "80%",escape = FALSE,
                  selection = "single",
                  options = list(dom='t', paging=FALSE, ordering=FALSE, info=FALSE,
                                 rowCallback = JS("function(r,d) {$(r).attr('height', '40px')}"),
                                 preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                 drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
        )
      })
      
      output$text_output_for_selected_Student_at_Row1 <- renderText(paste0("Text for Student at Row1 = ", input[[paste0("student_row1",input$class_input,k())]]))
      
    }
    
    runApp(shinyApp(ui = ui, server = server))