-1

我创建了一个数据表，其中一列中有 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] <<- data[eval(parse(text = paste("input$Item.1.1", : 替换长度为零”) 中的错误。

我尝试将其添加到服务器：

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"] <- test() 时，我在数据表的第二列中得到 21，并且当 selectInputs 更改时它不会更改。

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

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

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

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

4

1 回答 1

2

您过早使用选择输入值：

 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。后一种形式更适合这种情况。

于 2015-09-02T02:32:09.250 回答