我正在编写一个 Shiny 的程序来操作用户上传的数据集。 该数据集具有固定的列名称，我创建了几个 UI 元素 (selectInputs) 来过滤该数据集。
Reprex 看起来像这样:
ui <- fluidPage(
fluidRow(selectInput("filter_a","label",choices = c("a","b","c"),multiple = T),
selectInput("filter_b","label",choices = c("x","z","y"),multiple = T),
dataTableOutput("o1"),
br(),
dataTableOutput("o2")
)
)
server <- function(input, output) {
df <- reactive({
df <- data.frame(a = c("a","b","c"),
b = c("x","z","y"))
})
filter_function_1 <- reactive({
req(data)
df <- df()
if(!is.null(input$filter_a)){
df <- df %>%
filter(df$a %in% input$filter_a)
}
if(!is.null(input$filter_b)){
df <- df %>%
filter(df$b %in% input$filter_b)
}
return(df)
})
output$o1 <- renderDataTable({filter_function_1()})
虽然这有效，但看起来是非常糟糕的做法。在我的实际程序中，我有一组 14 个过滤器，并将其包装 14 次，然后应用相同的过滤器对我来说看起来不太合适。
为了简化我想出了这个。我有一种感觉，这也不是最佳实践(通过连接字符串来寻址 input$filter_a 似乎并不正确)。
filter_func <- function(df, arg) {
filter_arg <- paste0("filter_", arg)
filter <- paste0("input$", filter_arg)
if (!is.null(eval(parse(text = filter)))) {
df <- df %>%
filter(df[[arg]] %in% input[[filter_arg]])
}
return(df)
}
filter_function_2 <- reactive({
df <- df()
df <- df %>%
filter_func(arg="a") %>%
filter_func(arg="b")
return(df)
})
output$o2 <- renderDataTable({filter_function_2()})
}
现在，这对我来说看起来更干净，但我仍然想进一步模块化代码，并将过滤器函数和代码放在文件中。涉及更多数据准备步骤，我希望能够轻松调试它们，因此需要单独的文件/函数。
代码现在可能如下所示:
filter_data.R
filter_func <- function(df, arg) {
filter_arg <- paste0("filter_", arg)
filter <- paste0("input$", filter_arg)
if (!is.null(eval(parse(text = filter)))) {
df <- df %>%
filter(df[[arg]] %in% input[[filter_arg]])
}
return(df)
}
这是它不再工作的点，因为它在函数范围内找不到输入 - 这至少是我的最佳猜测。我想用几种方式重写函数，这些是我的想法:
让 filer_data.R 函数接受我想要过滤的所有列的命名参数。这看起来很简单，但对我来说也非常多余
访问服务器端的 Shiny 输入变量，收集所有以“filter_”开头的“列”并将它们传递给过滤器函数。然后过滤器函数应用必要的过滤器。
我很确定我在某个地方搞砸了，但我一直无法弄清楚。这里什么不起作用？
最佳答案
首先，让我们解决如何根据多个输入连续调用多个过滤器的问题。我们可以使用 purrr:reduce2 来实现:
在下面的示例中，reduce2 采用名为 myfilter 的自定义函数，该函数具有三个参数:初始 data.frame、列名称和值我们想要过滤。调用 reduce2 时，向 .init 参数提供 data.frame 非常重要。
library(shiny)
library(tidyverse)
myfilter <- function(df, col, vals) {
if(!is.null(vals)) {
filter(df, !!sym(col) %in% vals)
} else {
df
}
}
shinyApp(ui = fluidPage(
fluidRow(selectInput("filter_a","label", choices = c("a","b","c"), multiple = TRUE),
selectInput("filter_b","label", choices = c("x","z","y"), multiple = TRUE),
dataTableOutput("o1"),
br(),
dataTableOutput("o2")
)
),
server = function(input, output) {
df <- reactive({
df <- data.frame(a = c("a","b","c"),
b = c("x","z","y"))
})
filter_function_1 <- reactive({
req(data)
filter_ls <- map(set_names(grep("^filter", names(input), value = TRUE)), ~ input[[.x]])
col_nms <- gsub("^filter_", "", names(filter_ls))
reduce2(col_nms,
filter_ls,
myfilter,
.init = df())
})
output$o1 <- renderDataTable({filter_function_1()})
})
然后我们可以创建一个带有两个参数的单独函数 filter_function_1:react_dat 和 input。
library(shiny)
library(tidyverse)
myfilter <- function(df, col, vals) {
if(!is.null(vals)) {
filter(df, !!sym(col) %in% vals)
} else {
df
}
}
filter_function_1 <- function(reac_dat, input) {
reactive({
filter_ls <- map(set_names(grep("^filter", names(input), value = TRUE)),
~ input[[.x]])
col_nms <- gsub("^filter_", "", names(filter_ls))
reduce2(col_nms,
filter_ls,
myfilter,
.init = reac_dat)
})
}
shinyApp(ui = fluidPage(
fluidRow(selectInput("filter_a","label", choices = c("a","b","c"), multiple = TRUE),
selectInput("filter_b","label", choices = c("x","z","y"), multiple = TRUE),
dataTableOutput("o1"),
br(),
dataTableOutput("o2")
)
),
server = function(input, output) {
df <- reactive({
df <- data.frame(a = c("a","b","c"),
b = c("x","z","y"))
})
filter_dat <- filter_function_1(df(), input = input)
output$o1 <- renderDataTable({filter_dat()})
})
通过将代码放入外部函数/文件中来清理代码的另一种方法是使用 Shiny 的模块。有多种方法可以进行设置，具体取决于该模块与应用程序其他部分的交互方式。一种方法是将所有内容放入模块中:
library(shiny)
library(tidyverse)
myfilter <- function(df, col, vals) {
if(!is.null(vals)) {
filter(df, !!sym(col) %in% vals)
} else {
df
}
}
filterFunUI <- function(id) {
tagList(
fluidRow(selectInput(NS(id, "filter_a"),"label", choices = c("a","b","c"), multiple = TRUE),
selectInput(NS(id, "filter_b"),"label", choices = c("x","z","y"), multiple = TRUE),
dataTableOutput(NS(id, "o1")),
br(),
dataTableOutput(NS(id, "o2")))
)
}
filterFunServer <- function(id) {
moduleServer(id, function(input, output, session) {
df <- reactive({
df <- data.frame(a = c("a","b","c"),
b = c("x","z","y"))
})
filter_dat <- reactive({
filter_ls <- map(set_names(grep("^filter", names(input), value = TRUE)),
~ input[[.x]])
col_nms <- gsub("^filter_", "", names(filter_ls))
reduce2(col_nms,
filter_ls,
myfilter,
.init = df())
})
output$o1 <- renderDataTable({filter_dat()})
})
}
ui <- fluidPage(filterFunUI("first"))
server <- function(input, output, session) {
filterFunServer("first")
}
shinyApp(ui = ui, server = server)
关于R Shiny : Creating a filter function relying on input in a separate file，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/71305283/