Reputation: 117
I am going through the Shiny tutorial on this website and I am stuck with a cascading filter or subfilter.
This tutorial uses this dataset. The data "contains information about all the products sold by BC Liquor Store".
What I want to happen is when I select the variable PRODUCT_CLASS_NAME I would like the selection choices for PRODUCT_MINOR_CLASS_NAME to be limited to those within the PRODUCT_CLASS_NAME. So, that if BEER is selected in PRODUCT_CLASS_NAME I don't have the option to select, say, AMERICAN WHISKEY under PRODUCT_MINOR_CLASS_NAME.
Some setup code:
library(shiny)
library(ggplot2)
library(dplyr)
bcl <- read.csv("http://pub.data.gov.bc.ca/datasets/176284/BC_Liquor_Store_Product_Price_List.csv", stringsAsFactors = F)
Here is my ui:
ui <- fluidPage(
titlePanel("BC Liquor Store prices"),
sidebarLayout(
sidebarPanel(
uiOutput("countryOutput"),
sliderInput("priceInput", "Price", min = 0, max = 100, value=c(0,50), pre="$"),
#radioButtons("typeInput", "Product Type", choices = c("BEER", "REFRESHMENT", "SPIRITS", "WINE"), selected="WINE"),
uiOutput("typeOutput"),
uiOutput("subtypeOutput")
#selectInput("countryInput", "Country", choices = c("CANADA", "FRANCE", "ITALY"))
),
mainPanel(
plotOutput("coolplot"),
br(),
tableOutput("results")
)
)
)
Here's my server:
server <- function(input, output) {
# create a reactive to filter the dataset
df <- reactive({
# df() is trying to access teh country input, but the country input hasn't been created yet via uiOutput, so there is an initial error that goes away.
# to prevent this temporary error, just include the following:
if (is.null(input$priceInput[1]) | is.null(input$priceInput[2]) | is.null(input$countryInput) | is.null(input$subtypeInput) | is.null(input$typeInput)) {
return(NULL)
}
bcl <- bcl %>%
filter(CURRENT_DISPLAY_PRICE >= input$priceInput[1],
CURRENT_DISPLAY_PRICE <= input$priceInput[2],
PRODUCT_COUNTRY_ORIGIN_NAME %in% input$countryInput,
PRODUCT_CLASS_NAME %in% input$typeInput,
PRODUCT_MINOR_CLASS_NAME %in% input$subtypeInput)
bcl
})
output$coolplot <- renderPlot({
# same error as above
if (is.null(df())) {
return(NULL)
}
ggplot(df(), aes(PRODUCT_ALCOHOL_PERCENT)) + geom_histogram(binwidth = 1)
})
output$results <- renderTable({
df()
})
output$countryOutput <- renderUI({
selectInput("countryInput", "Country",
sort(unique(bcl$PRODUCT_COUNTRY_ORIGIN_NAME))
)
})
output$typeOutput <- renderUI({
selectInput("typeInput", "Product type",
sort(unique(bcl$PRODUCT_CLASS_NAME))
)
})
output$subtypeOutput <- renderUI({
selectInput("subtypeInput", "Product subtype",
sort(unique(bcl$PRODUCT_MINOR_CLASS_NAME))
)
})
}
shinyApp(ui = ui, server = server)
I realize this is a result of not fully understanding Shiny or filter. Is there a better approach to get the result I want?
Thanks!
Upvotes: 1
Views: 1228
Reputation: 117
Thanks to Pork Chop for helping me understand that I didn't know how to use filter.
Here's the final code, based off Pork Chop's, that works on the actual dataset:
library(shiny)
library(ggplot2)
library(dplyr)
bcl <- read.csv("http://pub.data.gov.bc.ca/datasets/176284/BC_Liquor_Store_Product_Price_List.csv", stringsAsFactors = F)
ui <- fluidPage(
titlePanel("BC Liquor Store prices"),
sidebarLayout(
sidebarPanel(
selectInput("countryInput", "Country",sort(unique(bcl$PRODUCT_COUNTRY_ORIGIN_NAME))),
sliderInput("priceInput", "Price", min = 0, max = 100, value=c(0,50), pre="$"),
uiOutput("typeOutput"),
uiOutput("subtypeOutput")
),
mainPanel(
plotOutput("coolplot"),
br(),
dataTableOutput("results")
)
)
)
server <- function(input, output) {
# create a reactive to filter the dataset
df0 <- eventReactive(input$countryInput,{
bcl %>% filter(PRODUCT_COUNTRY_ORIGIN_NAME %in% input$countryInput)
})
output$typeOutput <- renderUI({
selectInput("typeInput", "Product type",sort(unique(df0()$PRODUCT_CLASS_NAME)))
})
df1 <- eventReactive(input$typeInput,{
df0() %>% filter(PRODUCT_CLASS_NAME %in% input$typeInput)
})
output$subtypeOutput <- renderUI({
selectInput("subtypeInput", "Product subtype",sort(unique(df1()$PRODUCT_MINOR_CLASS_NAME)))
})
df2 <- reactive({
df1() %>% filter(CURRENT_DISPLAY_PRICE >= input$priceInput[1],
CURRENT_DISPLAY_PRICE <= input$priceInput[2],
PRODUCT_MINOR_CLASS_NAME %in% input$subtypeInput)
})
output$coolplot <- renderPlot({
ggplot(df2(), aes(PRODUCT_ALCOHOL_PERCENT)) + geom_histogram(binwidth = 1)
})
output$results <- renderTable({
df2()
})
}
shinyApp(ui = ui, server = server)
Upvotes: 0
Reputation: 29387
I think you just mixed up some of your filtering. Have a look at the updates I introduced. Note that there are no columns within the dataset with CAPS
#rm(list = ls())
library(shiny)
library(ggplot2)
library(dplyr)
bcl <- read.csv("http://deanattali.com/files/bcl-data.csv", stringsAsFactors = F)
app <- shinyApp(
ui <- fluidPage(
titlePanel("BC Liquor Store prices"),
sidebarLayout(
sidebarPanel(
selectInput("countryInput", "Country",sort(unique(bcl$Country))),
sliderInput("priceInput", "Price", min = 0, max = 100, value=c(0,50), pre="$"),
uiOutput("typeOutput"),
uiOutput("subtypeOutput")
),
mainPanel(
plotOutput("coolplot"),
br(),
tableOutput("results")
)
)
),
server <- function(input, output) {
df0 <- eventReactive(input$countryInput,{
bcl %>% filter(Country %in% input$countryInput)
})
output$typeOutput <- renderUI({
selectInput("typeInput", "Product type",sort(unique(df0()$Name)))
})
df1 <- eventReactive(input$typeInput,{
df0() %>% filter(Country %in% input$countryInput)
})
output$subtypeOutput <- renderUI({
selectInput("subtypeInput", "Product subtype",sort(unique(df1()$Subtype)))
})
df2 <- reactive({
df1() %>% filter(Price >= input$priceInput[1], Price <= input$priceInput[2],Subtype %in% input$subtypeInput)
})
output$coolplot <- renderPlot({
ggplot(df2(), aes(Alcohol_Content)) + geom_histogram(binwidth = 1)
})
output$results <- renderTable({
df2()
})
})
runApp(app)
Upvotes: 1