-
-
Save kylegallatin/147a0fc8ea3b4c235bf8b9104550564d to your computer and use it in GitHub Desktop.
Shiny apps for displaying Beeradvocate data
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ### Shiny app for displaying American Ales ### | |
| ## global.R ## | |
| #global.R | |
| library(dplyr) | |
| library(tidyr) | |
| library(ggplot2) | |
| americanAmber = read.csv('data/americanAmber_redAle.csv') | |
| americanAmber$Style = rep('American Amber', nrow(americanAmber)) | |
| americanBlackAle = read.csv('data/americanBlackAle.csv') | |
| americanBlackAle$Style = rep('American Black Ale', nrow(americanBlackAle)) | |
| americanBlondeAle = read.csv('data/americanBlondeAle.csv') | |
| americanBlondeAle$Style = rep('American Blonde Ale', nrow(americanBlondeAle)) | |
| americanBrownAle = read.csv('data/americanBrownAle.csv') | |
| americanBrownAle$Style = rep('American Brown Ale', nrow(americanBrownAle)) | |
| americanDoubleIPA = read.csv('data/americanDouble_imperialIPA.csv') | |
| americanDoubleIPA$Style = rep('American Double/Imperial IPA', nrow(americanDoubleIPA)) | |
| americanImperialStout = read.csv('data/americanDouble_imperialStout.csv') | |
| americanImperialStout$Style = rep('American Double/Imperial Stout', nrow(americanImperialStout)) | |
| americanIPA = read.csv('data/americanIPA.csv') | |
| americanIPA$Style = rep('American IPA', nrow(americanIPA)) | |
| americanPale_wheatAle = read.csv('data/americanPale_wheatAle.csv') | |
| americanPale_wheatAle$Style = rep('American Pale/Wheat Ale', nrow(americanPale_wheatAle)) | |
| americanPaleAle = read.csv('data/americanPaleAle.csv') | |
| americanPaleAle$Style = rep('American Pale Ale', nrow(americanPaleAle)) | |
| americanPorter = read.csv('data/americanPorter.csv') | |
| americanPorter$Style = rep('American Porter', nrow(americanPorter)) | |
| americanStout = read.csv('data/americanStout.csv') | |
| americanStout$Style = rep('American Stout', nrow(americanStout)) | |
| beerStyle = rbind(americanAmber, americanBlackAle, americanBlondeAle, | |
| americanBrownAle, americanDoubleIPA, americanImperialStout, | |
| americanIPA, americanPale_wheatAle, americanPaleAle, | |
| americanPorter, americanStout) | |
| #data cleaning, removing empty spaces, NAs and converting to numeric | |
| beerStyle[beerStyle == ''] <- NA | |
| beerStyle = na.omit(beerStyle) | |
| beerStyle$Ratings = as.numeric(sub(',', '', beerStyle$Ratings)) | |
| beerStyle$ABV = sub('\\?', NA, beerStyle$ABV) | |
| beerStyle$ABV = as.numeric(beerStyle$ABV) | |
| beerStyle$Avg = sub('-', NA, beerStyle$Avg) | |
| beerStyle$Avg = as.numeric(beerStyle$Avg) | |
| ## ui.R ## | |
| #beerStyles ui | |
| library(shinydashboard) | |
| shinyUI(dashboardPage( | |
| dashboardHeader(title = 'American Beer Styles'), | |
| dashboardSidebar( | |
| sidebarUserPanel('Kyle Gallatin', image = 'handsome_man.jpg'), | |
| sidebarMenu( | |
| menuItem("Most Reviewed", tabName = 'mReviews', icon = icon("beer")), | |
| menuItem("ABV ~ Rating", tabName = 'ABV', icon = icon('ambulance')), | |
| menuItem("Style Ratings", tabName = 'Avg', icon = icon('glass')), | |
| menuItem("Table", tabName = 'table', icon = icon('table')), | |
| sliderInput("ratings","Min Number of Ratings", 0, 16327, 0), | |
| sliderInput("avg", "Min Average Rating", 0 , 5, 0, step = 0.1), | |
| sliderInput('alcohol', "Min Alcohol Content", 0, 13, 0, step = 0.1) | |
| )), | |
| dashboardBody( | |
| tabItems( | |
| tabItem(tabName = "mReviews", | |
| fluidRow(plotOutput("plot1"))), | |
| tabItem(tabName = 'ABV', | |
| fluidRow(plotOutput("plot2")), | |
| fluidRow(verbatimTextOutput('text'))), | |
| tabItem(tabName = 'Avg', | |
| fluidRow(plotOutput("plot3"))), | |
| tabItem(tabName = 'table', | |
| fluidRow(dataTableOutput("table1"))) | |
| ), | |
| fluidRow( | |
| checkboxGroupInput("checkGroup", | |
| label = h3("Select Style"), | |
| choices = list("American Amber" = "American Amber", | |
| "American Black Ale" = "American Black Ale", | |
| "American Blonde Ale" = "American Blonde Ale", | |
| "American Brown Ale" = "American Brown Ale", | |
| "American Double/Imperial IPA" = "American Double/Imperial IPA", | |
| "American Double/Imperial Stout" = "American Double/Imperial Stout", | |
| "American IPA" = "American IPA", | |
| "American Pale/Wheat Ale" = "American Pale/Wheat Ale", | |
| "American Pale Ale" = "American Pale Ale", | |
| "American Porter" = "American Porter", | |
| "American Stout" = "American Stout"), | |
| selected = unique(beerStyle$Style)) | |
| )) | |
| )) | |
| ## server.R ## | |
| #beerStyles server | |
| shinyServer(function(input, output){ | |
| # beers <- reactive({ | |
| # filter(beerStyle, Style == c(input$checkGroup)) | |
| # }) | |
| #reactive function for the ratings sliderbar | |
| numRatings <- reactive({ | |
| beerStyle[beerStyle$Ratings >= input$ratings,] | |
| }) | |
| avgRating <- reactive({ | |
| numRatings()[beerStyle$Avg >= input$avg,] | |
| }) | |
| #reative function for alcohol content, just checking for linear regression | |
| alcoholContent <- reactive({ | |
| avgRating()[beerStyle$ABV >= input$alcohol,] | |
| }) | |
| #reactive function for the linear regression analysis | |
| reg <- reactive({ | |
| temp = lm(alcoholContent()$Avg ~ alcoholContent()$ABV) | |
| return(temp) | |
| }) | |
| #reactive function for plot fill if numRatings is high | |
| fill <- reactive({ | |
| if (input$ratings > 4500) { | |
| return('Brewery') | |
| } else { | |
| return(NULL) | |
| } | |
| }) | |
| #plot of the count of each style, with Bros ratings | |
| output$plot1 <- renderPlot( | |
| ggplot(alcoholContent()[!is.na(alcoholContent()$Avg),], aes_string(x = 'Style', fill = fill())) + | |
| geom_histogram(stat = 'count') + | |
| coord_flip() + | |
| ggtitle('Number of Beers by Style') | |
| ) | |
| output$plot2 <- renderPlot( | |
| ggplot(alcoholContent(), aes(ABV, Avg, col = Style)) + | |
| geom_point() + | |
| geom_abline(intercept = reg()$coefficients[1], slope = reg()$coefficients[2]) + | |
| ylab('Average Rating') + | |
| ggtitle('Average Rating by Alcohol Content') | |
| ) | |
| output$plot3 <- renderPlot( | |
| ggplot(alcoholContent(), aes(x = Style, y = Avg, fill = Style)) + | |
| geom_boxplot() + | |
| coord_flip() + | |
| theme_minimal() + | |
| ggtitle('Average Rating by Style') + | |
| ylab('Average Rating') | |
| ) | |
| output$table1 <- renderDataTable( | |
| alcoholContent() | |
| ) | |
| output$text <- renderPrint( | |
| summary(reg()) | |
| ) | |
| }) | |
| ### Shiny app for displaying user review data for cheap American Lagers | |
| ## global.R ## | |
| #global.R | |
| library(dplyr) | |
| library(tidyr) | |
| library(ggplot2) | |
| coors <- read.csv("data/coors.csv") | |
| coorsLight <- read.csv("data/coorsLight.csv") | |
| bud = read.csv("data/bud.csv") | |
| budLight = read.csv("data/budLight.csv") | |
| busch = read.csv("data/busch.csv") | |
| buschLight = read.csv("data/buschLight.csv") | |
| nattyIce = read.csv("data/nattyIce.csv") | |
| nattyLight = read.csv("data/nattyLight.csv") | |
| highLife = read.csv("data/miller_highlife.csv") | |
| classic = rbind(coors, coorsLight, bud, | |
| budLight, busch, buschLight, | |
| highLife, nattyIce, nattyLight) | |
| #separate the attributes column into each respective column | |
| classic = separate(classic, name, into = c("name", "brewery"), sep = "\\|") | |
| classic = separate(classic, attributes, into = c('attributes', 'overall'), sep = "overall:") | |
| classic = separate(classic, attributes, into = c('attributes', 'feel'), sep = "feel:") | |
| classic = separate(classic, attributes, into = c('attributes', 'taste'), sep = "taste:") | |
| classic = separate(classic, attributes, into = c('attributes', 'smell'), sep = "smell:") | |
| classic = separate(classic, attributes, into = c('attributes', 'look'), sep = "look:") | |
| classic$attributes <- NULL | |
| #remove extra characters and covert the ratings to numeric | |
| classic$overall = as.numeric(classic$overall) | |
| classic$look = as.numeric(sub('\\|', '', classic$look)) | |
| classic$smell = as.numeric(sub('\\|', '', classic$smell)) | |
| classic$taste = as.numeric(sub('\\|', '', classic$taste)) | |
| classic$feel = as.numeric(sub('\\|', '', classic$feel)) | |
| #turn the dates into the correct format | |
| classic$date = as.POSIXct(classic$date, format = "%b %d,%Y") | |
| classic$year = format(classic$date, '%Y') | |
| classic <- na.omit(classic) | |
| ## ui.R ## | |
| library(shinydashboard) | |
| #ui | |
| shinyUI(dashboardPage( | |
| dashboardHeader(title = "College Lagers"), | |
| dashboardSidebar( | |
| sidebarUserPanel("Kyle Gallatin", image = 'handsome_man.jpg'), | |
| sidebarMenu( | |
| menuItem("Boxplots", tabName = "Boxplots", icon = icon("dropbox")), | |
| menuItem("Ratings by Time", tabName = "Ratings", icon = icon("hourglass")), | |
| menuItem("Data", tabName = 'table', icon = icon('table'))), | |
| selectizeInput("selected", | |
| "Select Item to Display", | |
| choices = c('look', 'smell', 'taste', 'feel', 'overall')), | |
| checkboxGroupInput("checkGroup", | |
| label = h3("Select Beers"), | |
| choices = list("Budweiser" = "Budweiser ", | |
| "Bud Light" = "Bud Light ", | |
| "Coors" = "Coors ", | |
| "Coors Light" = "Coors Light ", | |
| "Busch Beer" = "Busch Beer ", | |
| "Busch Light" = "Busch Light ", | |
| "Miller High Life" = "Miller High Life ", | |
| "Natty Light" = "Natural Light ", | |
| "Natty Ice" = "Natural Ice "), | |
| selected = unique(classic$name)) | |
| ), | |
| dashboardBody( | |
| tabItems( | |
| tabItem(tabName = "Ratings", | |
| fluidRow(plotOutput("plot")), | |
| fluidRow(plotOutput("plot3")), | |
| fluidRow(img(src = 'beerIndustry.jpeg', height = 400, width = 600))), | |
| tabItem(tabName = "Boxplots", | |
| fluidRow(infoBoxOutput("maxBox"), | |
| infoBoxOutput("minBox"), | |
| infoBoxOutput("avgBox")), | |
| fluidRow(plotOutput("plot2"))), | |
| tabItem(tabName = "table", | |
| fluidRow(dataTableOutput('table'))) | |
| )) | |
| ) | |
| ) | |
| ## server.R ## | |
| library(shinydashboard) | |
| library(shiny) | |
| library(dplyr) | |
| #server | |
| options(digits = 4) | |
| shinyServer(function(input, output){ | |
| #reactive function for beer name | |
| beers <- reactive({ | |
| filter(classic, name == c(input$checkGroup)) | |
| }) | |
| #reactive function for beer attribute being assessed | |
| parameter <- reactive({ | |
| input$selected | |
| }) | |
| #first plot of graphs over time | |
| output$plot <- renderPlot( | |
| ggplot(beers(), aes_string(x = 'date', y = parameter(), col = 'name')) + | |
| geom_smooth(se = FALSE) + | |
| ggtitle('Rating over Time') | |
| ) | |
| #second plot of boxplots for averages | |
| output$plot2 <- renderPlot( | |
| ggplot(beers(), aes_string(x = 'name', y = parameter(), fill = 'name')) + | |
| geom_boxplot() + | |
| theme_minimal() + | |
| coord_flip() + | |
| ggtitle('Boxplot of Ratings') | |
| ) | |
| output$plot3 <- renderPlot( | |
| ggplot(beers(), aes_string(x = 'year', y = parameter())) + | |
| geom_boxplot() + | |
| facet_grid(~name, scales = "free_x") + | |
| geom_smooth(aes(group = 1)) + | |
| coord_flip() | |
| ) | |
| #table | |
| output$table <- renderDataTable( | |
| classic | |
| ) | |
| #info graphics | |
| #replace all "tastes" and classic_mean calc w reactive outputs | |
| stats <- reactive({ | |
| stats = beers()[colnames(beers()) == parameter()] | |
| stats = na.omit(cbind(beers()$name, stats)) | |
| colnames(stats) <- c('name', parameter()) | |
| stats %>% group_by(name) %>% summarise_each(funs(mean)) | |
| }) | |
| output$maxBox <- renderInfoBox({ | |
| max_value <- max(stats()[,2]) | |
| max_beer <- | |
| stats()$name[stats()[,2]==max_value] | |
| infoBox(max_beer, max_value, icon = icon("hand-o-up")) | |
| }) | |
| output$minBox <- renderInfoBox({ | |
| min_value <- min(stats()[,2]) | |
| min_beer <- | |
| stats()$name[stats()[,2]==min_value] | |
| infoBox(min_beer, min_value, icon = icon("hand-o-down")) | |
| }) | |
| }) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment