时间戳

首页 > 解决方案 > 为每行创建 selectInput(s) 并使用所选值更新反应表

r - 为每行创建 selectInput(s) 并使用所选值更新反应表

问题描述

我正在尝试使用闪亮和 DT 包在 data.frame 的每一行中实现“selectInput”。这篇文章对我有很大帮助。

以下代码应从每一行获取输入，并为每次单击“更改”按钮更新 Update_Select 列。问题是它更新了一次列并变得空闲。

library(shiny)
library(DT)

ui <- fluidPage(
  fluidRow(
    fluidRow(column(6, actionButton("act", "Change:")),
             column(6, verbatimTextOutput("txt", placeholder = T))),
    fluidRow(column(12, DTOutput("react_tbl")))
  )
)

server <- function(input, output, session) {
  # 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), label = NULL, ...))
    } 
    inputs 
  } 

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

  alld <- reactiveValues(react_tbl = data.frame(cars, Rating = shinyInput(selectInput,
                                                                          nrow(cars),
                                                                          "selecter_",
                                                                          choices=1:5,
                                                                          width="60px"),
                                                Update_Action = NA,
                                                Update_Select = NA))


  output$react_tbl = DT::renderDataTable(
    alld$react_tbl,
    selection = 'none',
    server = FALSE,
    escape = FALSE,
    options = list(
      dom = "t",
      paging = TRUE,
      pageLength = 20,
      lengthMenu = c(5, 10, 20, 100, 1000, 10000),
      preDrawCallback = JS('function() { 
                           Shiny.unbindAll(this.api().table().node()); }'), 
      drawCallback = JS('function() { 
                        Shiny.bindAll(this.api().table().node()); } '))
      )


  observeEvent(input$act,{
    alld$react_tbl["Update_Action"] <- input$act
    alld$react_tbl["Update_Select"] <- shinyValue("selecter_", nrow(alld$react_tbl))
  })
  output$txt <- renderText(shinyValue("selecter_", nrow(alld$react_tbl)))

  }

shinyApp(ui, server)

标签： rshinydt

解决方案

数据变化时需要解除绑定。

ui <- fluidPage(
  tags$head(tags$script(
    HTML(
      "Shiny.addCustomMessageHandler('unbindDT', function(id) {
        var $table = $('#'+id).find('table');
        if($table.length > 0){
          Shiny.unbindAll($table.DataTable().table().node());
        }
      })")
  )),
  fluidRow(......

在服务器功能中：

  observeEvent(alld$react_tbl, {
    session$sendCustomMessage("unbindDT", "react_tbl")
  })

推荐阅读