r - 別の列からの入力に基づいてデータテーブル値を動的に生成する

Question

列の 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", : replacement has length zero)」というエラーが表示されます。

これをサーバーに追加しようとしました：

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() を割り当てると、データ テーブルの 2 番目の列に 21 が表示され、selectInputs が変更されても変化しません。

テストとして、UI の対応する dataTableOutput() と組み合わせて、これをサーブに含めてみました。

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

test1 は、2 番目の sapply が renderDataTable 内でコメント化されている場合にのみ、期待どおりに動作します。コメントアウトされていない場合、両方のテーブルに無応答の 21 の列があります。

これは私を一日中バタバタさせていたので、どんな考えでも私の人生を大きく改善するでしょう!