JeniFav
JeniFav

Reputation: 117

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!

Upvotes: 1

Views: 1228

Answers (2)

JeniFav
JeniFav

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

Pork Chop
Pork Chop

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)

enter image description here

Upvotes: 1

Related Questions