当我从
filter = 'top'
中的 renderDT
中给出的选项应用或调整过滤器时。我希望在使用 selectInput
中的 sidebarPanel
调整(selected_column)后保留这些过滤器。
目前我一直在处理的问题是,每次我从
selectInput
中选择一个新选择时,例如(每月”、“两个月”...),过滤器都会刷新,然后我必须重新应用它们。我不想这样做。
我尝试了几种方法,我认为
stateSave = TRUE
可以解决我的问题,但可惜的是,它没有。
具体来说,我相信这与“average_type”来自代码的
ui
部分有关,但我不知道如何以任何其他方式解决这个问题。
ui <- fluidPage(
titlePanel("Average Data Viewer"),
sidebarLayout(
sidebarPanel(
selectInput("average_type", "Select Average Type:",
choices = c("Monthly" = "monthly_average",
"Two Month" = "two_month_average",
"Three Month" = "three_month_average",
"Four Month" = "four_month_average",
"Six Month" = "six_month_average",
"Year" = "year_average"),
selected = "monthly_average")
),
mainPanel(
DTOutput("catalogTable")
)
)
)
这是一个演示代码(较短),显示了我面临的问题。
library(shiny)
library(DT)
library(shinyjs)
library(shinyWidgets)
library(ggplot2)
library(dplyr)
# UI
ui <- fluidPage(
titlePanel("Average Data Viewer"),
sidebarLayout(
sidebarPanel(
selectInput("average_type", "Select Average Type:",
choices = c("Monthly" = "monthly_average",
"Two Month" = "two_month_average",
"Three Month" = "three_month_average",
"Four Month" = "four_month_average",
"Six Month" = "six_month_average",
"Year" = "year_average"),
selected = "monthly_average")
),
mainPanel(
DTOutput("catalogTable")
)
)
)
# Server
server <- function(input, output, session) {
# Sample data frame
cat2 <- data.frame(
part_number = c("A", "B", "C"),
quantity = c(500, 6, 34),
monthly_average = c(100, 150, 200),
two_month_average = c(120, 160, 220),
three_month_average = c(130, 170, 230),
four_month_average = c(140, 180, 240),
six_month_average = c(160, 200, 260),
year_average = c(180, 220, 280)
)
cat2 <- cat2 %>%
mutate(MOH = quantity/monthly_average)
# Initialize reactive values to store the previous selected column and table state
prevSelectedColumn <- reactiveVal(NULL)
prevTableState <- reactiveVal(NULL)
output$catalogTable <- renderDT({
# Select the appropriate column based on user input
selected_column <- input$average_type
catalogTable <- datatable(cat2[, c("part_number", "quantity", "MOH", selected_column)],
filter = 'top',
options = list(
stateSave = TRUE))
return(catalogTable)
})
}
# Run the application
shinyApp(ui = ui, server = server)
重申一下,即使从
filter = 'top'
选择的显示列发生更改,我也会尝试保留 selectInput
中的过滤器。
stateSave
不适用于保存过滤器。但是,您可以组合使用 dataTableProxy() 和 updateSearch()
,如下所示。
library(shiny)
library(DT)
library(shinyWidgets)
library(dplyr)
if (!exists("default_search"))
default_search <- ""
if (!exists("default_search_columns"))
default_search_columns <- NULL
# UI
ui <- fluidPage(titlePanel("Average Data Viewer"),
sidebarLayout(sidebarPanel(
selectInput(
"average_type",
"Select Average Type:",
choices = c(
"Monthly" = "monthly_average",
"Two Month" = "two_month_average",
"Three Month" = "three_month_average",
"Four Month" = "four_month_average",
"Six Month" = "six_month_average",
"Year" = "year_average"
),
selected = "monthly_average"
)
),
mainPanel(DTOutput("catalogTable"))))
# Server
server <- function(input, output, session) {
# Sample data frame
cat2 <- data.frame(
part_number = c("A", "B", "C"),
quantity = c(500, 6, 34),
monthly_average = c(100, 150, 200),
two_month_average = c(120, 160, 220),
three_month_average = c(130, 170, 230),
four_month_average = c(140, 180, 240),
six_month_average = c(160, 200, 260),
year_average = c(180, 220, 280)
)
cat2 <- cat2 %>%
mutate(MOH = quantity / monthly_average)
# Initialize reactive values to store the previous selected column and table state
prevSelectedColumn <- reactiveVal(NULL)
prevTableState <- reactiveVal(NULL)
output$catalogTable <- renderDT({
# Select the appropriate column based on user input
selected_column <- input$average_type
catalogTable <-
datatable(
cat2[, c("part_number", "quantity", "MOH", selected_column)],
filter = 'top',
options = list(searchCols = default_search_columns,
stateSave = FALSE)
)
return(catalogTable)
})
observeEvent(input$average_type, {
isolate({
default_search <- input$catalogTable_search
default_search_columns <-
c("", input$catalogTable_search_columns)
proxy %>% updateSearch(keywords =
list(global = default_search, columns = default_search_columns))
})
})
proxy <- dataTableProxy('catalogTable')
}
# Run the application
shinyApp(ui = ui, server = server)