R闪亮：更新data.table中的选择输入值

Question

我有 renderDataTable 里面有选择输入和按钮。单击适当行中的“保存”按钮后，我想更新数据表中的 selectInput。我怎样才能做到这一点？在寻找解决方案的过程中，我发现“如果你重新渲染表格，输入将不起作用，除非你添加一些额外的代码来取消绑定”。但是，我是新来的闪亮和使用 js 选项，所以我会感谢任何提示/解决方案。

library(shiny)
library(DT) 
runApp(list(
  ui = basicPage(
    h2('The mtcars data'),
    DT::dataTableOutput('mytable'),
    h2("Selected"),
    tableOutput("checked")
  ),

  server = function(input, output) {
    # helper function for making checkbox
    shinyInput = function(FUN, len, id, ...) { 
      inputs = character(len) 
      for (i in seq_len(len)) { 
        inputs[i] = as.character(FUN(paste0(id, i), ...)) 
      } 
      inputs 
    } 
    # datatable with checkbox
    output$mytable = DT::renderDataTable({
      data.frame(mtcars,Rating=shinyInput(selectInput,nrow(mtcars),"selecter_",label=NULL,
                                          choices=1:5, width="60px"),
                 Save = shinyInput(actionButton, nrow(mtcars),'button_', 
                                         label = 'Save',onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ))
    }, selection='none',server = FALSE, escape = FALSE, options = list( 
      paging=TRUE,
      preDrawCallback = JS('function() { 
                           Shiny.unbindAll(this.api().table().node()); }'), 
      drawCallback = JS('function() { 
                        Shiny.bindAll(this.api().table().node()); } ') 
      ) )
    # helper function for reading checkbox
    shinyValue = function(id, len) { 
      unlist(lapply(seq_len(len), function(i) { 
        value = input[[paste0(id, i)]] 
        if (is.null(value)) NA else value 
      })) 
    } 
    # output read checkboxes
    output$checked <- renderTable({
      data.frame(selected=shinyValue("selecter_",nrow(mtcars)))
    })
    }
))

Answer 1

嘿，所以我不完全理解你的问题，但希望这会有所帮助。这个应用程序并不完美，但应该做你想做的事：

library(shiny)
library(DT)
runApp(list(
  ui = basicPage(
    tags$script(
      HTML(
        "Shiny.addCustomMessageHandler('unbind-DT', function(id) {
        Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
        })"
)
    ),
h2('The data'),
selectInput("myData", "Choose dataset", c("mtcars", "iris"), "mtcars"),
DT::dataTableOutput('mytable'),
h2("Selected"),
tableOutput("checked")
      ),

server = function(input, output, session) {
  dataset <- reactive({
    session$sendCustomMessage("unbind-DT", "mytable")
    get(input$myData)
  })

  # helper function for making checkbox
  shinyInput = function(FUN, len, id, ...) {
    inputs = character(len)
    for (i in seq_len(len)) {
      inputs[i] = as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }
  # datatable with checkbox
  output$mytable = DT::renderDataTable({
    data.frame(
      dataset(),
      Rating = shinyInput(
        selectInput,
        nrow(dataset()),
        "selecter_",
        choices = 1:5,
        width = "60px",
        label = NULL
      ),
      Save = shinyInput(actionButton, nrow(dataset()), 'button_',
                        label = 'Save')
    )
  }, selection = 'none', server = FALSE, escape = FALSE, options = list(
    dom = "ti",
    paging = TRUE,
    preDrawCallback = JS(
      'function() {
      Shiny.unbindAll(this.api().table().node()); }'
    ),
    drawCallback = JS('function() {
                      Shiny.bindAll(this.api().table().node()); } ')
    ))
  # helper function for reading checkbox
  shinyValue = function(id, len) {
    unlist(lapply(seq_len(len), function(i) {
      value = input[[paste0(id, i)]]
      if (is.null(value))
        NA
      else
        value
    }))
  }
  # output read checkboxes
  output$checked <- renderTable({
    data.frame(selected = shinyValue("selecter_", nrow(mtcars)))
  })

  lapply(1:150, function(i) {
    observeEvent(input[[paste0("button_", i)]], {
      updateSelectInput(session,
                        paste0("selecter_", i),
                        selected = 5,
                        label = NULL)
    })
  })

}

))