javascript - 通过在 Shiny 中添加复选框使列动态化

Question

我一直在尝试在数据表上添加一行(基本上是一行复选框)，以便用户能够决定他们想要保留/删除哪一列。这是我的 Shiny 应用程序到目前为止的样子。任何知道任何提示的人请帮忙!

如有任何帮助，我们将不胜感激!

ui <- dashboardPage(dashboardHeader(disable = T),
                dashboardSidebar(disable = T),
                dashboardBody(uiOutput("MainBody")))

server <- shinyServer(function(input, output){
  vals <- reactiveValues()
  vals$data <- data.table(vals$Data<-data.table(
           Brands=paste0("Brand",1:10),
           Forecasted_Growth=sample(1:20,10),
           Last_Year_Purchase=round(rnorm(10,1000,1000)^2),
           Contact=paste0("Brand",1:10,"@email.com")
 ))

      output$MainBody <- renderUI({
        fluidPage(
          box(width = 12,
          h3(strong("Template"), align = "center"),
          hr(),
          column(6, offset = 6, 
                 actionButton(inputId = "Del_Col", label = "Delete Select Column"))),
      column(12, dataTableOutput("MainTable")),
      tags$script()
    )
  })

Answer 1

我同意 Pork Chop 的观点，你应该重新考虑你的布局。我无法理解它，所以我将它重新设计成一个最小的流畅页面。

下面的代码应该可以帮助您接近。它使用辅助函数 described here. 将按钮(不过您可以制作这些复选框)直接渲染到表中。下面的代码使用这些按钮来子集和更新数据帧，我将其称为“reactiveTable”。功能如下:

祝你好运!

library(data.table)
library(DT)

## Nice helper function to make the buttons from:
## https://github.com/rstudio/DT/issues/178
shinyInput <- function(FUN, len, id, ...) {
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(FUN(paste0(id, i), ...))
  }
  inputs
}

## Basic UI with a reset button
ui <- fluidPage(
  mainPanel(
    h1('Table Subsetter'),
    actionButton('reset', 'Reset!'),
    DT::dataTableOutput('mytable')
  )
)

server <- function(input, output){

  #This is the table you provided in your question
  tableA <- data.table(
    Brands=paste0("Brand",1:10),
    Forecasted_Growth=sample(1:20,10),
    Last_Year_Purchase=round(rnorm(10,1000,1000)^2),
    Contact=paste0("Brand",1:10,"@email.com")
  )

  #make a reactive value for the table and columns to delete
  reactiveTable <- reactiveValues(tab=tableA)
  columnToDelete <- reactiveValues(col=NULL)

  #Logic to make the buttons, reruns everytime the table is updated
  tableOut <- reactive({
    buttons <- shinyInput(actionButton, length(reactiveTable$tab[1,]), 'button_', label = "Delete!", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' )
    buttons <- t(as.data.frame(buttons, stringsAsFactors = FALSE))
    colnames(buttons) = colnames(reactiveTable$tab)
    rbind(buttons, reactiveTable$tab)
  })

  #reset button replaces the table
  observeEvent(input$reset, {
    reactiveTable$tab <- tableA
  })

  #listener to for the delete button 
  observeEvent(input$select_button, {
    columnToDelete$col <-as.numeric(strsplit(input$select_button, "_")[[1]][2])
      reactiveTable$tab <- subset( reactiveTable$tab, select = -columnToDelete$col )
  })

  #output the table with DT. use escape=F so it renders the html
  output$mytable <- DT::renderDataTable({
                      tableOut()
                      },server = FALSE, escape = FALSE, selection = 'none')

}
shinyApp(ui = ui, server = server)