[英]Use Shiny ActionButton to select all rows or add all rows to selection in current view with filtering in a DT datatable
[英]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 很難測試,但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
因為下次您按下 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.