簡體   English   中英

用於刪除數據表中行的閃亮 actionButton(帶代碼)

[英]Shiny actionButton to delete rows in datatable (with code)

我有一個帶有 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”。 但它不起作用。 錯誤顯示警告:繼承中的錯誤:找不到對象“testdf” ,行號與數據表輸出相對應。

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',
                ... )
})

我究竟做錯了什么?

沒有 min reprex 很難測試,但testdfobserveEvent({})之外不可用,因此不可用於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因為下次您按下 delete 時,它​​將跟蹤以前的刪除,除非您刷新dfOutput() 另一個關鍵是input$dfResults_rows_selected 數據表名稱是dfResults

謝謝伊萊。 我快到那里了。 使用初始表下方的修改代碼加載這是一項改進,但不幸的是,當單擊 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 時它仍然不返回任何數據。

謝謝伊萊。 我認為你的方法是正確的。 大概是一些簡單的事情。 這是我的應用程序。 它產生相同的結果。

抱歉,我沒有隔離主頁選項卡,因此您需要在側邊欄菜單中單擊它。

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)

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM