I'm building a Shiny app that uses a lot of filters and the main output is a series of graphs based on aggregations. I have a few selectInput filters, where I want the user to be able to choose a value of a factor variable. But I want do a graph based on aggregating on varying variables within the dataframe. However, I want to limit those variables to a select few factors. I also need to retain the original dataset for other filters, transformations, input boxes, etc. I thought that varSelectInput was what I needed, but according to the documentation, there is no option for choices like there is for selectInput.
I have created a limited reproducible example that illustrates the problem I have (not perfect, but creating a reprex in Shiny is a bit harder than a normal R problem).
library(shiny)
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(ggplot2)
library(ggrepel)
library(tidyr)
library(nycflights13)
all_flights <- flights %>%
inner_join(airlines, by = c('carrier', 'carrier')) %>%
rename(carrier_name = name) %>%
left_join(airports, by = c('dest' = 'faa')) %>%
rename(destination_city = name) %>%
add_count(dest, name = 'count_dest') %>%
filter(count_dest > 6000) #limit to keep manageable as example
destination_city_list <- all_flights %>%
select(destination_city) %>%
distinct() %>%
as.list()
ui <- fluidPage(
# Application title
titlePanel("Flights"),
sidebarLayout(
sidebarPanel(
selectInput("destination", "Destination",
choices = destination_city_list),
varSelectInput('type_delay', 'Arrival or Destination Delay?', all_flights)
),
mainPanel(
plotOutput("delay_graph")
)
)
)
server <- function(input, output) {
flight_sum <- reactive({
all_flights() %>%
filter(destination_city == input$destination) %>%
mutate(delay_indicator = if_else(!!input$type_delay, 'delay', 'not_delay')) %>%
filter(!is.na(delay_indicator)) %>%
count(delay_indicator, carrier_name) %>%
spread(delay_indicator, n) %>%
mutate(delay = replace_na(delay, 0),
not_delay = replace_na(not_delay, 0),
more_delays = if_else(delay > not_delay, 1, 0))
})
output$delay_graph <- renderPlot({
flight_sum() %>%
mutate(more_delays = as.factor(more_delays)) %>%
ggplot(aes(not_delay, delay, label = carrier_name, color = more_delays)) +
geom_point(aes(color = more_delays)) +
ggtitle("Number of Delays vs. No Delays by Air Carrier") +
labs(x = "No Delays", y = "Delays") +
geom_abline(intercept = 0, slope = 1) +
scale_color_manual(values = c('black', 'red'), guide = F) +
geom_text_repel(aes(color = more_delays), size = 3, max.iter = 100000)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Shiny applications not supported in static R Markdown documents
Created on 2019-03-29 by the reprex package (v0.2.1)
The above app basically doesn't work, since the varSelectInput allows all variables in the dataframe to be selected, including ones that really don't make any sense (non-factors, for the most part). For this particular app, only dep_delay and arr_delay are appropriate, since it is intended to show the number of delay vs non-delayed flights by arrival or departure.
My way around this is a bit hacky and I'm not crazy about it. I essentially copy over the entire dataset, create a common new variable (delay_var) for the two different datasets, and use a switch statement to choose the aggregating variable. This is inefficient since I now have three full copies of the all_flights dataset loaded when the app runs.
library(shiny)
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(ggplot2)
library(ggrepel)
library(tidyr)
library(nycflights13)
all_flights <- flights %>%
inner_join(airlines, by = c('carrier', 'carrier')) %>%
rename(carrier_name = name) %>%
left_join(airports, by = c('dest' = 'faa')) %>%
rename(destination_city = name) %>%
add_count(dest, name = 'count_dest') %>%
filter(count_dest > 6000)
destination_city_list <- all_flights %>%
select(destination_city) %>%
distinct() %>%
as.list()
departure_data <- all_flights %>%
mutate(delay_var = dep_delay)
arrival_data <- all_flights %>%
mutate(delay_var = arr_delay)
ui <- fluidPage(
# Application title
titlePanel("Flights"),
sidebarLayout(
sidebarPanel(
selectInput("destination", "Destination",
choices = destination_city_list),
selectInput("type_delay", "Arrival or Departure Delay?",
choices = list("Arrival Delay", "Departure Delay"),
selected = "Departure Delay")
),
mainPanel(
plotOutput("delay_graph")
)
)
)
server <- function(input, output) {
delay_dataset <- reactive({
switch(input$type_delay,
"Arrival Delay" = arrival_data,
"Departure Delay" = departure_data)
})
flight_sum <- reactive({
delay_dataset() %>%
filter(destination_city == input$destination) %>%
mutate(delay_indicator = if_else(delay_var > 0, 'delay', 'not_delay')) %>%
filter(!is.na(delay_indicator)) %>%
count(delay_indicator, carrier_name) %>%
spread(delay_indicator, n) %>%
mutate(delay = replace_na(delay, 0),
not_delay = replace_na(not_delay, 0),
more_delays = if_else(delay > not_delay, 1, 0))
})
output$delay_graph <- renderPlot({
flight_sum() %>%
mutate(more_delays = as.factor(more_delays)) %>%
ggplot(aes(not_delay, delay, label = carrier_name, color = more_delays)) +
geom_point(aes(color = more_delays)) +
ggtitle("Number of Delays vs. No Delays by Air Carrier") +
labs(x = "No Delays", y = "Delays") +
geom_abline(intercept = 0, slope = 1) +
scale_color_manual(values = c('black', 'red'), guide = F) +
geom_text_repel(aes(color = more_delays), size = 3, max.iter = 100000)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Shiny applications not supported in static R Markdown documents
Created on 2019-03-29 by the reprex package (v0.2.1)
So, it works, but this doesn't seem to be a good solution. The app I'm working on is a dashboard that builds off of a global.R file that runs through a database. And now I've been asked to add a few additional features. The main dataset ends up being over a million rows. I'd rather not load a different copy of that dataset for every factor I'm trying to aggregate on. But despite all my searching, I haven't found a way yet to limit the choices available in the varSelectInput option in Shiny.
Any advice/ideas would be greatly appreciated. Thanks!