gpt4 book ai didi

r - 在 Shiny 的应用程序中过滤数据,但在更新表时将值保留在 selectInput 中

转载 作者:行者123 更新时间:2023-12-03 15:48:36 26 4
gpt4 key购买 nike

我有一个 Shiny 的应用程序,它要求用户上传一个文件(一个带有数据的表格文件),然后它将这个文件呈现到一个表格中,用户可以根据 numericInput 过滤一些值。 , selectInput , 和 textAreaInput .用户必须选择过滤器,然后按下按钮才能过滤表。

没有顺序过滤,即用户可以填充所有过滤器或只填充一个。每次用户选择一个过滤器时,其他过滤器的值都会更新(selectInput 输入),这就是我想要的行为。然而,一旦过滤器 按钮被按下,我看不到之前的选择,也无法重置过滤器。

我想要实现的是在更新过滤器时保持实际行为,即,一旦我选择一个过滤器并按下另一个过滤器按钮 selectInput选项会自动更新,但是 我想跟踪过滤器选择,以便用户可以看到他/她选择的过滤器。这正是我所期待的,但每次我按下按钮 过滤器 似乎过滤器选项卡再次呈现。

这是我的应用程序,

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)

最佳答案

另一个更新:

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,
DT::dataTableOutput("tabla_julio") # %>% withSpinner(color = "#0dc5c1")
)
))))

ui <-
dashboardPagePlus(
enable_preloader = FALSE,
sidebar_fullCollapse = TRUE,
header,
sidebar,
body
)

server = function(input, output, session) {

# Create the choices for sample input
vals <- reactiveValues(data = iris, filtered_data = iris)

output$filtros <- renderUI({
datos <- isolate(vals$data)
conditionalPanel(
"input.tabs == 'filtros'",
tagList(
div(
style = "display: inline-block;vertical-align:top; width: 221px;",
numericInput(
inputId = "SepalLength",
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(isolate(datos$Species)),
selected = NULL,
multiple = TRUE,
selectize = TRUE,
size = NULL
)
)
)
),
actionButton("filtrar", "Filter", style = "width: 100px;"),
actionButton("reset", "Reset", style = "width: 100px;")
)
})


# Filter data
observeEvent(input$filtrar, {
tib <- vals$data

if (!is.na(input$SepalLength)) {
tib <- tib %>% dplyr::filter(Sepal.Length < input$SepalLength)
print(head(tib))
} else {
tib
}

# Filter
if (!is.null(input$Species)) {
tib <- tib %>% dplyr::filter(Species %in% input$Species)
} else {
tib
}

print(head(tib, n = 15))

vals$filtered_data <- tib

updateSelectInput(session, inputId = "Species", selected = input$Species, choices = unique(vals$filtered_data$Species))

})

observeEvent(input$reset, {
updateNumericInput(session, inputId = "SepalLength", value = NA)
updateSelectInput(session, inputId = "Species", selected = "")
})

# Reactive function creating the DT output object
output$tabla_julio <- DT::renderDataTable({
DT::datatable(vals$filtered_data)
}, server = FALSE)

}

shinyApp(ui, server)

更新:这就是我认为你所追求的。最重要的一步是到 isolate renderUI 中的输入所以它们不会在每次输入更改时重新渲染。
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,
DT::dataTableOutput("tabla_julio") # %>% withSpinner(color = "#0dc5c1")
)
))))

ui <-
dashboardPagePlus(
enable_preloader = FALSE,
sidebar_fullCollapse = TRUE,
header,
sidebar,
body
)

server = function(input, output, session) {

# Create the choices for sample input
vals <- reactiveValues(data = iris, filtered_data = iris)

output$filtros <- renderUI({
datos <- isolate(vals$data)
conditionalPanel(
"input.tabs == 'filtros'",
tagList(
div(
style = "display: inline-block;vertical-align:top; width: 221px;",
numericInput(
inputId = "SepalLength",
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(isolate(datos$Species)),
selected = NULL,
multiple = TRUE,
selectize = TRUE,
size = NULL
)
)
)
),
actionButton("filtrar", "Filter", style = "width: 100px;"),
actionButton("reset", "Reset", style = "width: 100px;")
)
})


# Filter data
observeEvent(input$filtrar, {
tib <- vals$data

if (!is.na(input$SepalLength)) {
tib <- tib %>% dplyr::filter(Sepal.Length < input$SepalLength)
print(head(tib))
} else {
tib
}

# Filter
if (!is.null(input$Species)) {
tib <- tib %>% dplyr::filter(Species %in% input$Species)
} else {
tib
}

print(head(tib, n = 15))

vals$filtered_data <- tib

})

observeEvent(input$reset, {
updateNumericInput(session, inputId = "SepalLength", value = NA)
updateSelectInput(session, inputId = "Species", selected = "")
})

# Reactive function creating the DT output object
output$tabla_julio <- DT::renderDataTable({
DT::datatable(vals$filtered_data)
}, server = FALSE)

}

shinyApp(ui, server)

初始答案:

我建议使用 selectizeGroup-module来自图书馆( shinyWidgets )。

它创造了一个

Group of mutually dependent selectizeInput for filtering data.frame's columns (like in Excel).



除此之外,它只使用 selectizeInput它似乎满足了您的要求,让我们免于打字。

这是使用 iris 的示例数据集:
library(shiny)
library(DT)
library(shinyWidgets)
library(datasets)

DF <- iris
names(DF) <- gsub("\\.", "", names(DF))

ui <- fluidPage(
fluidRow(
column(width = 10, offset = 1, tags$h3("Filter data with selectize group")),
column(width = 3, offset = 1,
selectizeGroupUI(
id = "my-filters",
params = list(
SepalLength = list(inputId = "SepalLength", title = "SepalLength:"),
SepalWidth = list(inputId = "SepalWidth", title = "SepalWidth:"),
PetalLength = list(inputId = "PetalLength", title = "PetalLength:"),
PetalWidth = list(inputId = "PetalWidth", title = "PetalWidth:"),
species = list(inputId = "Species", title = "Species:")
),
inline = FALSE
)),
column(
width = 10, offset = 1,DT::dataTableOutput(outputId = "table")
)
)
)

server <- function(input, output, session) {
filtered_table <- callModule(
module = selectizeGroupServer,
id = "my-filters",
data = DF,
vars = names(DF)
)
output$table <- DT::renderDataTable(filtered_table())
}

shinyApp(ui, server)

Result

关于r - 在 Shiny 的应用程序中过滤数据,但在更新表时将值保留在 selectInput 中,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/60659058/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com