【发布时间】：2020-06-24 19:06:44
【问题描述】：
我有一个闪亮的应用程序，它要求用户上传一个文件（一个带有数据的表格文件），然后它将这个文件呈现到一个表格中，用户可以根据numericInput、selectInput 和textAreaInput。用户必须选择过滤器，然后按下按钮以过滤表。
没有顺序过滤，即用户可以填写所有过滤器或只填写一个。每次用户选择一个过滤器时，其他过滤器的值都会更新（selectInput 输入），这就是我想要的行为。但是，一旦按下 Filter 按钮，我就看不到之前的选择，也无法重置过滤器。
我想要实现的是在更新过滤器时保持实际行为，即，一旦我选择一个过滤器并按下过滤器按钮，其他selectInput 选择就会自动更新，但是我想跟踪过滤器的选择，以便用户可以看到他/她选择的过滤器。这正是我所期待的，但每次我按下按钮 Filter 时，似乎都会再次呈现过滤器选项卡。
这是我的应用程序，
library(shiny)
library(vroom)
library(dplyr)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(tidyr)
header <- dashboardHeader()
sidebar <- dashboardSidebar(width = 450,
sidebarMenu(id="tabs",
menuItem("Filtros", tabName="filtros", icon = icon("bar-chart-o")),
uiOutput("filtros")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName="filtros",
fluidRow(
column(12,dataTableOutput("tabla_julio") %>% withSpinner(color="#0dc5c1"))
)
)
)
)
ui <- dashboardPagePlus(enable_preloader = TRUE, sidebar_fullCollapse = TRUE, header, sidebar, body)
server = function(input, output, session) {
#Create the choices for sample input
vals <- reactiveValues(data=NULL)
vals$data <- iris
output$filtros <- renderUI({
datos <- vals$data
conditionalPanel("input.tabs == 'filtros'",
tagList(
div(style="display: inline-block;vertical-align:top; width: 221px;",numericInput(inputId="Sepal.Length", label="Sepal.Length", value=NA, min = NA, max = NA, step = NA)),
div(
div(style="display: inline-block;vertical-align:top; width: 224px;", selectInput(inputId = "Species", label = "Species", width = "220", choices=unique(datos$Species),
selected = NULL, multiple = TRUE, selectize = TRUE, size = NULL))
)
),
actionButton("filtrar", "Filter")
)
})
# create reactiveValues
vals <- reactiveValues(data=NULL)
vals$data <- iris
# Filter data
observeEvent(input$filtrar, {
tib <- vals$data
if (!is.na(input$Sepal.Length)){
tib <- tib %>% dplyr::filter(!Sepal.Length >= input$Sepal.Length)
print(head(tib))
} else { tib <- tib }
# Filter
if (!is.null(input$Species)){
toMatch <- paste0("\\b", input$Species, "\\b")
matches <- unique(grep(paste(toMatch,collapse="|"), tib$Species, value=TRUE))
tib <- tib %>% dplyr::filter(Species %in% matches)
} else { tib <- tib}
tib -> vals$data
print(head(tib, n=15))
})
# Reactive function creating the DT output object
output$tabla_julio <- DT::renderDataTable({
DT::datatable(vals$data)
})
}
shinyApp(ui, server)
【问题讨论】：
-
我会试试@bretauv
-
@bretauv，我已经把例子缩短了
-
@SeGa，我已经用 iris 数据集更新了示例