根据另一列

时间:2015-08-28 20:27:06

标签: r shiny dt

我创建了一个数据表,其中一个列中包含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]&lt;&lt; - 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”]&lt; - test()时,我在数据表的第二列中得到21,并且当它没有改变时selectInputs已更改。

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

             output$test1 <- DT::renderDataTable({
               test()
             })
当且仅当第二个sapply在renderDataTable中被注释掉时,

test1才会按预期运行。如果没有注释掉,两个表都有一列无响应的21s。

这一直让我感到沮丧,所以任何想法都会大大改善我的生活!

1 个答案:

答案 0 :(得分:2)

您过早使用选择输入值:

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

当您使用这些值时,尚未在页面上呈现选择输入,因此毫不奇怪,您得到NULL。您无法将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$fooinput['foo']都会为您提供ID为foo的输入值。在这种情况下,后一种形式更合适。