Jen sabbyATL Jen sabbyATL - 3 days ago 4
R Question

Subfiltering dataset in Shiny reactive

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!

Answer

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)

enter image description here

Comments