R 闪亮:更新 data.table 中的选择输入值 [英] R shiny: update select input values in data.table

问题描述

我有带有选择输入和按钮的 renderDataTable.单击相应行中的保存"按钮后，我想更新数据表中的 selectInput.我怎样才能做到这一点?在寻找解决方案的过程中，我发现如果您重新渲染表格，除非您添加一些额外的代码来解除绑定，否则输入将无法工作".然而，我是新来的，并且使用 js 选项，所以我将不胜感激任何提示/解决方案.

I have renderDataTable with select Inputs and buttons inside. I want to update selectInput inside datatable after click on 'Save' button in appropriate row. How can I do that? During searching for a solution I found that "if you rerender the table, the inputs won't work unless you add some extra code to unbind". However I am new in shiny and using js options, so I would be grateful for any hints/solutions.

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)))
    })
    }
))

推荐答案

嘿，我不完全理解你的问题，但希望这会有所帮助.这个应用程序并不完美，但应该可以满足您的需求:

Hey so I don't completely understand your question, but hopefully this helps. This app isn't perfect, but should do what you want:

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)
    })
  })

}

))

这篇关于R 闪亮:更新 data.table 中的选择输入值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！