SelectInput（在 Table 单元格内）在它所基于的输入发生任何变化后不读取 input$ID 值

Question

我在 table 的单元格内有 SelectInputs。只要单击一次 actionButton，我就可以从 selectInput 中读取值。但是在再次单击 actionButton 后，它不会从 table 单元格的 SelectInput 中读取值。

这是我的代码的可重现示例：

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))

当我运行一次时，它工作正常。当我更改 class_input 时，它还会更新 table 单元格下拉列表中的学生。但是，如果我更改 class_input 的值或再次单击 actionButton，text_output_for_selected_Student_at_Row1 中的值不会更新。

Answer 1

如评论中所述，解决您的问题的一种方法是在每次用户选择新的 class_col 时创建一个新的 ID。我们可以附加 class 和 counter 来定义新的 inputId。请注意 table 只有在您点击 actionButton 后才会更新。试试这个

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))

SelectInput（在 Table 单元格内）在它所基于的输入发生任何变化后不读取 input$ID 值

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

r

shiny

shinydashboard

shiny-server

shiny-reactivity