Condition Filter in Dplyr Based on Shiny Input

Condition Filter in dplyr based on Shiny input

Given that you indicated that there are actual multiple variables you need to either filter for NA or not, you could do this using standard evaluation via filter_ and some help from package lazyeval.

library(dplyr)
library(lazyeval)

The algorithm would be something like this:

First, for each of your check boxes that you want to either remove the missing values or keep them, you would make a reactive statement in server.r kind of like in your question, except it would either return NULL or the variable name from the dataset you are using as a string.

Coupon_Select <- reactive({ 
    if(input$checkbox){"Coupon"}
      else {NULL}  
  })

Sale_Select <- reactive({ 
    if(input$checkbox2){"Sale"}
      else {NULL}  
  })

You'll use the output of these reactive functions in your Data_Select reactive function. In this step, you'll concatenate the check box reactive result together into a vector or list and then loop through them with lapply to set up the condition for each variable for use in filter_. This involves using interp from package lazyeval much as in this answer. Note that this works when using the same condition for each variable (removing rows that contain missing values for those particular variables).

The output list of conditions to filter on can be used in the .dots argument of filter_. I added the filter_ as a second filtering step, so the other conditions that you will always have can still easily be done via filter.

dataInput = reactive({
        extrafilt = c(Coupon_Select(), Sale_Select())
        dots = lapply(extrafilt, function(cols) interp(~!is.na(x), 
                                                        .values = list(x = as.name(cols))))
        Orders %>%
            filter(Region %in% Region_Select(), Community.Type %in% Type_Select())  %>%
            filter_(.dots = dots)
    })

I found it particularly useful that this works when all check box reactive functions return NULL and you don't need any additional filtering.

Conditional values using if else within shiny app using tidyverse and dplyr to group and filter a dataset

We may need to use {} to block the code between the %>%

 students_results <- reactive({
    ds %>%
      {
        if (input$all_quest == TRUE) {
          . 
            } else {
          {.} %>%
           filter(domain == input$domain) %>%
           group_by(input$quest) 
       } 
        
        }%>%
    summarise(mean(test))
  })

Use dplyr conditional filter in reactive function in Shiny

I do not think that is possible. You could do as follows:

if(input$status!="All")
  test_data %>% filter(status %in% input$status)
else
  test_data

So you only filter if the input is not "All". If you have a very long dplyr chain and you do not want to break it into pieces, you could also do:

if(input$status=="All")
  my_filter=unique(test_data$status)
else
  my_filter = input$status

test_data %>%
  filter(status %in% my_filter) %>%
  ..... %>%
  .....

Hope this helps.

Shiny: how to make a reactive input for a conditional filter in this case?

As you correctly assumed in your question R pretty much gives you the answer in the error message:

Input `..1` is `Alias == input$id`.
x Can't access reactive value 'id' outside of reactive consumer.
i Do you need to wrap inside reactive() or observe()?

you cant access the value within input$id outside of a reactive context. Just wrap your assignment of df_kpi1 into a reactive, e.g.:

df_kpi1 <- reactive(data %>%
      ...
      ...
      )

This should solve your issue.

EDIT: Your example

# shiny lib
library(shiny)
library(shinydashboard)
# core
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(DT))

#### UI 

ui <- dashboardPage(
  dashboardHeader(title = "TEST"),
  dashboardSidebar(
    sidebarMenu(id = "tabs",
                menuItem("Inspection",
                         tabName = "analyze"
                )
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "analyze",
              selectInput(inputId = "id",
                          label = "Select",
                          choices = "",
                          selected = ""),
              mainPanel(width = 100, 
                        fluidPage(
                          fluidRow(dataTableOutput("ts_kpi1.1")
                          )
                        )
              )
      )
    )
  )
)

#### SERVER

server <- function(input, output, session) {
  
  data <- tibble(value = c(c(10000.33,15000.55),c(12000.99,33005.44)),
                 Alias = c(rep("A",2),rep("B",2))
  )
  updateSelectInput(session ,
                    "id",
                    choices = unique(data$Alias)
  )
  DT_kpi1 <- reactive({
    
    
    df_kpi1 <- data %>% 
    dplyr::filter(Alias == input$id) %>%
    summarise(Mean = mean(value),
              Median = median(value)
    ) %>% as_tibble() %>% 
    mutate_if(is.numeric, ~round(., 0)
    )
    
  DT_kpi1 <- datatable(df_kpi1,         
                       options = list(
                         scrollX = FALSE,
                         autoWidth = TRUE,
                         bFilter = 0,
                         bInfo = FALSE,
                         bPaginate = FALSE,
                         lengthChange = FALSE,
                         columnDefs = list(list(searchable = FALSE, targets = "_all"),
                                           list(targets = c(0), visible = TRUE),
                                           list(searching = FALSE),
                                           list(ordering=F)
                         )
                       ),
                       rownames = FALSE ) %>% 
    formatCurrency(columns = c(1:2), currency = "", interval = 3, mark = ".")
  DT_kpi1
  })
  
  
  output$ts_kpi1.1 <- DT::renderDataTable({
    DT_kpi1()
  }) 
}
runApp(list(ui = ui, server = server),launch.browser = TRUE)

Conditional filtering using dbplyr in Shiny

This was the solution to the problem.

reactive({
  # If 'All' not selected, filter
  if (input$list != 'All') {
    
    filter(my_database_data, branch == !!input$list)
    
  } else {
    
    my_database_data
    
  }
})

Generalizable function to select and filter dataframe r - using shiny input

Here's a 1-liner table_reducer function in base R -

table_reducer <- function(df, select_var, filter_values) {
  subset(df, Reduce(`&`, Map(`%in%`, df[select_var], filter_values)))  
}

selected_variables <- c('date', 'result')
selected_values <- list(c(1,2), c('W'))
table_reducer(df, selected_variables, selected_values)

#  date time place result
#1    1    a     A      W
#2    2    b     A      W
#4    2    e     H      W
#5    2    b     A      W

Map is a wrapper over mapply so you were right in thinking that you should use mapply for this task. This answer is also free of dreaded for loops.

Why does this dplyr filter not work in shiny, but works fine when run without shiny?

Is this closer to what you need?

library(shiny)
library(tidyverse)

ui <-
  fluidPage(
    h3("Data table:"),
    tableOutput("data"),
    h3("Sum the data table columns:"),
    radioButtons(
      inputId = "grouping",
      label = NULL,
      choiceNames = c("By period 1", "By period 2"),
      choiceValues = c("Period_1", "Period_2"),
      selected = "Period_1",
      inline = TRUE
    ),
    tableOutput("sums")
  )

server <- function(input, output, session) {
  data <- reactive({
    data.frame(
      ID = c(1,1,2,2,2,2),
      Period_1 = c("2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04"),
      Period_2 = c(1, 2, 1, 2, 3, 4),
      ColA = c(10, 20, 30, 40, 50, 52),
      ColB = c(15, 25, 35, 45, 55, 87)
    )
  })
  
  dataExpand <- reactive({
    data() %>%
      tidyr::complete(ID, nesting(Period_2)) %>%
      tidyr::fill(ColA, ColB, .direction = "down")
  })  
  
  choice <- reactive(input$grouping)
  
  summed_data <- reactive({
    dataExpand() %>%
      group_by(across(choice())) %>%
      select("ColA","ColB") %>%
      summarise(across(everything(), sum, na.rm = TRUE)) |> 
      filter(across(1,.fns = ~ .x |> negate(is.na)() ))
    
    # Below removes Period_1 rows that are added due to Period_2 < 4 when grouping by Period_2
    
  })
  
  
  
  output$data <- renderTable(data())
  output$sums <- renderTable(summed_data())
}

shinyApp(ui, server)

Use shiny text input and dplyr to filter rows in a dataframe

As aosmith pointed out, you need to remove the quotes for filtering. Second, you should use == instead of %in% inside of filter(). Third, you would use switch() in other cases (read up on ?switch), but here you don't need it.

Your server.R should look like this:

library(shiny)
library(dplyr)
df1 <- data_frame(Name = c("Carlos","Pete","Carlos","Carlos","Carlos","Pete",
                         "Pete","Pete","Pete","Homer"),
                  Sales = c(3, 4, 7, 6, 4, 9, 1, 2, 1, 9))

shinyServer(function(input, output) {
  datasetInput <- reactive({
    df1 %>% filter(Name == input$text) %>% arrange(desc(Sales))
  })
  output$volume <- renderPrint({
    dataset <- datasetInput()
    dataset$Sales
  })
})

---

Related Topics