R Shiny: Creating a filter function relying on input in a separate file

user_15300497 0
Viewed 103

I am writing a Shiny program which manipulates a dataset the user uploads. The dataset has fixed column names and I create several UI elements (selectInputs) to filter that dataset.

Reprex looks like this:

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()})

While this works it looks like very bad practice. In my actual program I have a set of 14 filters and wrapping it 14 times and applying the same just doesnt look right to me.

Wanting to simplify I came up with this. I have a feeling that this is also not best practice (addressing the input$filter_a by concatenating strings doesnt seem right).

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()})

}

Now, this looks cleaner to me, but I still want to modulize the code even more and have the filter function and code resign in a file. There are more data prep steps involved and I want to be able to debug them easily, hence the separate files / functions.

Code might look now like this:

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)
}

This is the point where it doesn't work anymore, since it can't find the input while in the function scope - that would be at least my best guess. I though of rewriting function in several ways, these are my ideas:

  1. Have the filer_data.R function take in named arguments for all columns I want to filter. This seems straight-forward but also very redundant to me

  2. Access shiny input variable on the server side, collect all "columns" that start with "filter_" and pass them onto the filter function. The filter function then applies the necessary filters.

I'm pretty sure I mess up somewhere, but I haven't been able to figure it out. What's not working here?

shiny filter r input scope
1 Answers

First, lets solve the problem how to call several filter in a row based on multiple inputs. We can use purrr:reduce2 for this:

In the example below reduce2 takes a custom function called myfilter with three arguments: the initial data.frame the column name and the value we want to filter. When calling reduce2 it is important to supply the data.frame to the .init argument.

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()})
  
})

Then we could create a separate function filter_function_1 with two arguments: react_dat and 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()})
  
})

And another way cleaning the code by putting it in external function / files would be to use shiny modules. There are many ways to set this up depending on how this module interacts with other parts of your app. One way of doing this is putting everything into the module:

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)
user_93493020
Related