在R Shiny应用程序中，根据另一列的selectinput动态更改列值

Question

我正在尝试创建一个表格（使用DT，不要使用rhandsontable），其中有几个现有列、一列selectinput（每行都有选择选项）和最后另一列根据用户从selectinput下拉菜单中选择的内容填充。

在我的示例中，'Feedback'列是用户下拉选择列。我无法更新'Score'列，该列将基于来自'Feedback'列下拉菜单的选择进行更新。

if(interactive()){
  library(DT)
  library(shiny)
  tbl1 <- data.frame(A = c(1:10), B = LETTERS[1:10], C = c(11:20), D = LETTERS[1:10])
  ui <- fluidPage(
    DT::dataTableOutput(outputId = 'my_table')
  )
  server <- function(input, output, session) {
    rv <- reactiveValues(tbl = tbl1)
    observe({
      for (i in 1:nrow(rv$tbl)) {
        rv$tbl$Feedback[i] <- as.character(selectInput(paste0("sel", i), "",
                                                       choices = c(1,2,3,4)
        ))
        
        if(!is.null(input[[paste0("sel", i)]])) {
          if(input[[paste0("sel", i)]] == 1) {
            rv$tbl$Score[i] <- 10
          } else if(input[[paste0("sel", i)]] == 2) {
            rv$tbl$Score[i] <- 20
          } else if(input[[paste0("sel", i)]] == 3) {
            rv$tbl$Score[i] <- 25
          } else if(input[[paste0("sel", i)]] == 4) {
            rv$tbl$Score[i] <- 30
          }
        }
      }
    })
          
          output$my_table = DT::renderDataTable({
            
            datatable(
              rv$tbl, escape = FALSE, selection = 'none', rownames = F,
              options = list( paging = FALSE, ordering = FALSE, scrollx = T, dom = "t",
                              preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                              drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
              )
            )
          }, server = FALSE)
          
          
  }
  
  shinyApp(ui = ui, server = server)
}

- Narendra Sahu

Answer 1

我建议使用dataTableProxy和replaceData来实现所需的行为。这比重新渲染datatable更快。

另外，重新渲染表格似乎会干扰selectInputs的绑定。

还要注意：为了使其工作，我需要切换到server = TRUE。

library(DT)
library(shiny)

selectInputIDs <- paste0("sel", 1:10)

initTbl <- data.frame(
  A = c(1:10),
  B = LETTERS[1:10],
  C = c(11:20),
  D = LETTERS[1:10],
  Feedback = sapply(selectInputIDs, function(x){as.character(selectInput(inputId = x, label = "", choices = c(1, 2, 3, 4), selected = 1))}),
  Score = rep(10, 10)
)

ui <- fluidPage(
  DT::dataTableOutput(outputId = 'my_table')
)

server <- function(input, output, session) {
  
  displayTbl <- reactive({
      data.frame(
        A = c(1:10),
        B = LETTERS[1:10],
        C = c(11:20),
        D = LETTERS[1:10],
        Feedback = sapply(selectInputIDs, function(x){as.character(selectInput(inputId = x, label = "", choices = c(1, 2, 3, 4), selected = input[[x]]))}),
        Score = sapply(selectInputIDs, function(x){as.integer(input[[x]])*10})
      )
  })
  
  output$my_table = DT::renderDataTable({
    DT::datatable(
      initTbl, escape = FALSE, selection = 'none', rownames = FALSE,
      options = list(paging = FALSE, ordering = FALSE, scrollx = TRUE, dom = "t",
                     preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                     drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  }, server = TRUE)
  
  my_table_proxy <- dataTableProxy(outputId = "my_table", session = session)
  
  observeEvent({sapply(selectInputIDs, function(x){input[[x]]})}, {
    replaceData(proxy = my_table_proxy, data = displayTbl(), rownames = FALSE) # must repeat rownames = FALSE see ?replaceData and ?dataTableAjax
  }, ignoreInit = TRUE)
  
}

shinyApp(ui = ui, server = server)

- ismirsehregal

---

一个相关问题。 - ismirsehregal