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

Posted 2023-05-07

【中文标题】R闪亮：更新data.table中的选择输入值

【英文标题】：R shiny: update select input values in data.table

【发布时间】：2017-03-02 13:13:56

【问题描述】：

我有 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, ),
                 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)))
    )
    
))

【问题讨论】：

您使用的是data.frame，而不是data.table。函数DT::renderDataTable 引用DataTables javascript 库。我已经修复了你的标签。

do not render properly 是什么意思？

我添加了操作按钮“保存”，单击按钮后，我想更新 data.table 中的所有 selectInput 按钮，但是它们都没有更新。在 renderDataTable 中搜索更新输入时，我发现“如果您重新渲染表，输入将不起作用，除非您添加一些额外的代码来取消绑定”。我不知道“解除绑定的额外代码”是什么意思。

我更新了我的问题以更好地理解我的问题。

【参考方案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)
    )
  )



))

【讨论】：

它不会更新给定行中最后选择的值。

大家好，我有一个similar question，不知道你能不能看一下？谢谢