根据来自另一列的输入动态生成数据表值

Question

我创建了一个数据表，其中一列中有 selectInput 小部件。数据表的另一列应采用第一列中给出的输入，并使用它们从我的数据源中查找一个数字。通过使用 preDrawCallback 和 drawCallback 函数，输入在 Shiny 中正确绑定，但是当输入更改时，查找值不会更新。奇怪的是，当我在单独的数据表中进行查找时，它们确实会更新。这里有一个可重现的例子：

library(shiny)
library(DT)

data <- data.frame(c(1:7),c(21:27))

shinyApp(
  server = shinyServer(function(input, output) {
      output$table <- DT::renderDataTable({

        Rows <- c(1:7)
        temp <- data.frame(Rows)  
        temp[,"Item"] <- ""
        temp[,"Value"] <- ""
        temp$Rows <- NULL

        sapply(1:7, FUN = function(i) {
          temp$Item[i] <<- as.character(selectInput(paste("Item.1.1",i, sep = "."), "",
                                                       choices = setNames(c(1:7),c(1:7)),
                                                       selected = 1,
                                                       multiple = FALSE))
        })

         sapply(1:7, FUN = function(i) {
           temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1",i, sep = "."))),2]
         })

        datatable(temp, escape = FALSE, rownames = FALSE,
                  options = list(sort = FALSE, paging = FALSE, searching = FALSE, dom = 't',
                                 columnDefs = list(list(className = 'dt-center', targets = 0:1)),
                                 preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                 drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                  ))
    }, server = FALSE)
  }),
  ui = fluidPage(
    dataTableOutput("table")
  )
)

这给出了错误“temp$Value[i]

我已尝试将此添加到服务器：

test <- reactive({
              data.frame(c(ifelse(is.null(input$Item.1.1.1),"",data[eval(parse(text = paste("input$Item.1.1",1, sep = "."))),2]),
                ifelse(is.null(input$Item.1.1.2),"",data[input$Item.1.1.2,2]),
                ifelse(is.null(input$Item.1.1.3),"",data[input$Item.1.1.3,2]),
                ifelse(is.null(input$Item.1.1.4),"",data[input$Item.1.1.4,2]),
                ifelse(is.null(input$Item.1.1.5),"",data[input$Item.1.1.5,2]),
                ifelse(is.null(input$Item.1.1.6),"",data[input$Item.1.1.6,2]),
                ifelse(is.null(input$Item.1.1.7),"",data[input$Item.1.1.7,2])))
            })

然后，当我在我的 renderDataTable 中注释掉适当的 sapply 并分配 temp[,"Value"]

作为测试，我尝试在我的服务中包含这个，并在我的 ui 中加上相应的 dataTableOutput()：

             output$test1 <- DT::renderDataTable({
               test()
             })

当且仅当第二个 sapply 在 renderDataTable 中被注释掉时，test1 的行为才符合预期。如果不注释掉，则两个表都有一列 unresponsive 21s。

这让我整天发疯，所以任何想法都会大大改善我的生活！

Answer 1

您过早使用选择输入值：

 sapply(1:7, FUN = function(i) {
   temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1",i, sep = "."))),2]
 })

当您使用这些值时，选择输入甚至还没有在页面上呈现，所以毫不奇怪，您会得到NULL's。您不能将NULL 分配给tmp$Value[i]。

然后关于失败：

temp[,"Value"] <- test()

我不明白这是什么意思：test() 返回一个数据框，temp[, "Value"] 是一个向量。我认为您应该在反应式中使用c() 而不是data.frame()。

---

有些题外话，因为我真的忍不住：使用eval(parse(text = ...)) 几乎总是一个坏主意。您可以只使用 input[paste("Item.1.1", i, sep = ".")] 而不是构建 R 代码和 eval() 它。 input$foo 和 input['foo'] 都为您提供 ID 为 foo 的输入值。后一种形式更适合这种情况。