闪亮的 actionButton 删除数据表中的行（带代码）答案

【问题标题】：Shiny actionButton to delete rows in datatable (with code)闪亮的 actionButton 删除数据表中的行（带代码）
【发布时间】：2020-04-03 15:51:31
【问题描述】：

我有一个带有 actionButton 的 Shiny 应用程序，单击该按钮时会运行一个查询数据库的函数并返回结果表。然后，我将应用程序中的表格显示为数据表。

这很好用。

sqlOutput <- eventReactive(input$sqlButton, {

  sqlScript(conn, ...)

})

output$sqlSearchResults <- DT::renderDT(server = TRUE, {
  DT::datatable(sqlOutput()[[1]],
                rownames = FALSE,
                extensions = c("FixedColumns"),
                class = 'cell-border stripe',
                ... )
})

但是，我还有另一个 actionButton“deleteRows”，我想用它在单击时删除选定的行。我添加了一个observeEvent，它将修改后的表分配给一个新变量。然后数据表输出使用新变量“testdf”。但它不起作用。错误显示为 Warning: Error in inherits: object 'testdf' not found，其中行号对应于数据表输出。

sqlOutput <- eventReactive(input$sqlButton, {

  sqlScript(conn, ...)

})


observeEvent(input$deleteRows,{

  if (!is.null(input$sqlSearchResults_rows_selected)) {
    testdf <- sqlOutput()[[1]][-as.numeric(input$sqlSearchResults_rows_selected),]
  } else testdf <- sqlOutput()[[1]]

})



output$sqlSearchResults <- DT::renderDT(server = TRUE, {
  DT::datatable(testdf,
                rownames = FALSE,
                extensions = c("FixedColumns"),
                class = 'cell-border stripe',
                ... )
})

我做错了什么？

【问题讨论】：

请看我更新的答案。此外，只是一个旁注 - 您可能应该编辑您的问题而不是添加答案。这似乎是其他人可以效仿的最佳做法。

标签： r shiny dt

【解决方案1】：

如果没有 min reprex 很难测试，但 testdf 在 observeEvent({}) 之外不可用，因此对 renderDT({}) 不可用，因此您需要使用 reactiveValues。请参阅下文并注意使用values$testdf 代替testdf：

sqlOutput <- eventReactive(input$sqlButton, {

  sqlScript(conn, ...)

})

values <- reactiveValues()

observeEvent(input$deleteRows,{

  if (!is.null(input$sqlSearchResults_rows_selected)) {
    values$testdf <- sqlOutput()[[1]][-as.numeric(input$sqlSearchResults_rows_selected),]
  } else values$testdf <- sqlOutput()[[1]]

})



output$sqlSearchResults <- DT::renderDT(server = TRUE, {
  DT::datatable(values$testdf,
                rownames = FALSE,
                extensions = c("FixedColumns"),
                class = 'cell-border stripe',
                ... )
})

更新

请尝试以下：

library(shiny)
library(shinydashboard)

ui <- dashboardPage(skin = "blue", title = "",
                    dashboardHeader(),
                    dashboardSidebar(sidebarMenu(id="sidebarmenu",
                                                 sidebarMenuOutput("menusidebar"))),
                    dashboardBody(fluidRow(column(12,
                                                  tabItems(tabItem(tabName ="home", uiOutput("homePage")))))
                    )
)

server <- function(input, output, session) {
    output$menusidebar <- renderMenu({menuItem("Home", tabName = "home", icon = icon("home"))})

    dframe <- data.frame(Category = LETTERS[1:26],
                         Value = 1:26)


    dfOutput <- eventReactive(input$genDF, {
        dfResult <- dframe

    })

    values <- reactiveValues()

    observeEvent(dfOutput(), {
        if(!is.null(dfOutput())){
            values$testdf <- dfOutput()
        }
    })

    observeEvent(input$deleteRows,{
        if (!is.null(input$dfResults_rows_selected)) {
            values$testdf <- values$testdf[-input$dfResults_rows_selected,]
        }
    })





    output$dfResults <- DT::renderDT(server = TRUE, {
        DT::datatable(values$testdf,
                      rownames = FALSE,
                      extensions = c("FixedColumns", "Buttons"),
                      class = 'cell-border stripe',
                      options = list(dom = 'ft',
                                     pageLength = nrow(values$testdf))
        )
    })





    output$homePage <- renderUI({
        fluidPage(
            fluidRow(
                column(3, actionButton("genDF", "Generate Data Frame")),
                column(9,
                       actionButton("deleteRows", strong("Delete Filtered Rows")),
                       DT::dataTableOutput("dfResults"))
            )
        )
    })

}

shinyApp(ui, server)

这是关键行：

values$testdf <- values$testdf[-input$dfResults_rows_selected,]

您必须使用values$testdf，因为下次您按删除时，它将跟踪以前的删除，除非您刷新dfOutput()。同样关键的是input$dfResults_rows_selected。数据表名称为dfResults。

【讨论】：

【解决方案2】：

谢谢伊莱。我快到那里了。使用下面的修改后的代码加载了初始表，这是一个改进，但不幸的是，当单击 deleteButton 时，表返回“表中没有可用数据”。

sqlOutput <- eventReactive(input$sqlButton, {

  sqlScript(conn, ...)

})

values <- reactiveValues()

observeEvent(icdOutput(), {
    if(!is.null(sqlOutput()[[1]])){
      values$testdf <- sqlOutput()[[1]]
    }
  })

observeEvent(input$deleteRows,{
  if (!is.null(input$sqlSearchResults_rows_selected)) {
    values$testdf <- sqlOutput()[[1]][-as.numeric(input$sqlSearchResults_rows_selected),]
  }
})

output$sqlSearchResults <- DT::renderDT(server = TRUE, {
  DT::datatable(values$testdf,
                rownames = FALSE,
                extensions = c("FixedColumns"),
                class = 'cell-border stripe',
                ... )
})

我也试过

... values$testdf <- values$testdf[-as.numeric(input$sqlSearchResults_rows_selected),] ...

但是点击deleteButton的时候还是没有返回数据。

【讨论】：

你好安德鲁。不幸的是，如果没有虚拟数据和适当的最小代表，我将无法进一步。也许您可以将 sql 表保存为 data.frame 并发布一个样本集以允许我们正确测试。此外，我们需要一个完全可用的闪亮应用程序（min reprex），以获得进一步帮助您的最佳机会。从你给我们的来看，上面的一切似乎都很好。

【解决方案3】：

谢谢伊莱。我认为你的方法是正确的。可能是一些简单的事情。这是我的应用程序。它产生相同的结果。

抱歉，我没有隔离主页选项卡，因此您需要在侧边栏菜单中单击它。

library(shiny)
library(shinydashboard)

ui <- dashboardPage(skin = "blue", title = "",
                    dashboardHeader(),
                    dashboardSidebar(sidebarMenu(id="sidebarmenu",
                                                 sidebarMenuOutput("menusidebar"))),
                    dashboardBody(fluidRow(column(12,
                                                  tabItems(tabItem(tabName ="home", uiOutput("homePage")))))
                    )
)

server <- function(input, output, session) {
  output$menusidebar <- renderMenu({menuItem("Home", tabName = "home", icon = icon("home"))})

  dframe <- data.frame(Category = LETTERS[1:26],
                       Value = 1:26)


  dfOutput <- eventReactive(input$genDF, {
    dfResult <- dframe

  })

  values <- reactiveValues()

  observeEvent(dfOutput(), {
    if(!is.null(dfOutput())){
      values$testdf <- dfOutput()
    }
  })

  observeEvent(input$deleteRows,{
    if (!is.null(input$dfResults_rows_selected)) {
      values$testdf <- dfOutput()[-as.numeric(input$sqlSearchResults_rows_selected),]
    }
  })





  output$dfResults <- DT::renderDT(server = TRUE, {
    DT::datatable(values$testdf,
                  rownames = FALSE,
                  extensions = c("FixedColumns", "Buttons"),
                  class = 'cell-border stripe',
                  options = list(dom = 'ft',
                                 pageLength = nrow(values$testdf))
    )
  })





  output$homePage <- renderUI({
    fluidPage(
      fluidRow(
        column(3, actionButton("genDF", "Generate Data Frame")),
        column(9,
               actionButton("deleteRows", strong("Delete Filtered Rows")),
               DT::dataTableOutput("dfResults"))
      )
    )
  })

}

shinyApp(ui, server)

【讨论】：