R Shiny:根据单独文件中的输入创建过滤函数
R Shiny: Creating a filter function relying on input in a separate file
我正在编写一个 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 次并应用相同的过滤器对我来说不合适。
为了简化我想到了这个。我觉得这也不是最佳实践(通过连接字符串来处理输入 $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 函数接受我要过滤的所有列的命名参数。这看起来很简单,但对我来说也很多余
访问服务器端闪亮的输入变量,收集所有以“filter_”开头的“列”并将它们传递给过滤器函数。过滤器功能然后应用必要的过滤器。
我很确定我在某个地方搞砸了,但我还没弄明白。什么在这里不起作用?
首先,让我们解决如何根据多个输入连续调用多个过滤器的问题。我们可以为此使用 purrr:reduce2
:
在下面的示例中,reduce2
采用一个名为 myfilter
的自定义函数,该函数具有三个参数:初始 data.frame
列名称和我们要过滤的值。调用 reduce2
时,重要的是将 data.frame
提供给 .init
参数。
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()})
})
另一种通过将代码放入外部函数/文件来清理代码的方法是使用闪亮的模块。根据此模块与应用程序其他部分的交互方式,有多种设置方法。一种方法是将所有内容都放入模块中:
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)
我正在编写一个 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 次并应用相同的过滤器对我来说不合适。
为了简化我想到了这个。我觉得这也不是最佳实践(通过连接字符串来处理输入 $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 函数接受我要过滤的所有列的命名参数。这看起来很简单,但对我来说也很多余
访问服务器端闪亮的输入变量,收集所有以“filter_”开头的“列”并将它们传递给过滤器函数。过滤器功能然后应用必要的过滤器。
我很确定我在某个地方搞砸了,但我还没弄明白。什么在这里不起作用?
首先,让我们解决如何根据多个输入连续调用多个过滤器的问题。我们可以为此使用 purrr:reduce2
:
在下面的示例中,reduce2
采用一个名为 myfilter
的自定义函数,该函数具有三个参数:初始 data.frame
列名称和我们要过滤的值。调用 reduce2
时,重要的是将 data.frame
提供给 .init
参数。
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()})
})
另一种通过将代码放入外部函数/文件来清理代码的方法是使用闪亮的模块。根据此模块与应用程序其他部分的交互方式,有多种设置方法。一种方法是将所有内容都放入模块中:
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)