MSAN 622 Shiny Bar Plot

server.r

# required packages
require(shiny)
require(ggplot2)

# figure out where the genre columns start
start <- which(colnames(movies) == "Action")

# figure out where the genre columns end
end <- which(colnames(movies) == "Short")

# get just the genre names
genres <- colnames(movies)[start:end]

# pre-allocate space for movie counts
counts <- rep(0, length(genres))

# calculate number of movies for each genre
for(i in 1:length(genres)) {
  counts[i] <- sum(movies[, genres[i]])
}

# combine into data frame
df <- data.frame(factor(genres), counts)

# capiltalize column names for better table output
colnames(df) <- c("Genres", "Counts")

# color-blind friendly palette from http://jfly.iam.u-tokyo.ac.jp/color/
palette1 <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")

# test plotting function
getPlot <- function(sortOrder = 1:length(genres), colorScheme = "None") {
  
  # copy the data frame (don't want to change the data frame for other viewers)
  localFrame <- df
  
  # re-order the x-axis based on the returned sort order
  localFrame$Genres <- factor(localFrame$Genres, levels = localFrame$Genres[sortOrder])
  
  # build basic ggplot
  localPlot <- ggplot(localFrame, aes(x = Genres, y = Counts, fill = Genres)) +
    geom_bar(stat = "identity") +
    xlab("Genre") +
    ylab("Count") +
    theme(legend.position = "none")
  
  # decide on color scheme to use
  if (colorScheme == "Qualitative 1") {
    localPlot <- localPlot + scale_fill_brewer(type = "qual", palette = 1)
  }
  else if (colorScheme == "Qualitative 2") {
    localPlot <- localPlot + scale_fill_brewer(type = "qual", palette = 2)
  }
  else if (colorScheme == "Color-Blind Friendly") {
    localPlot <- localPlot + scale_fill_manual(values = palette1)
  }
  else {      
    localPlot <- localPlot + scale_fill_grey(start = 0.4, end = 0.4)
  }
  
  # return plot
  return(localPlot)
}

# display default plot for testing
print(getPlot())

# create shiny server
shinyServer(function(input, output) {
  
  cat("Press \"ESC\" to exit...\n")
  
  # output row order based on sorting criteria
  # should update every time the sort column or descending checkbox is changed
  sortOrder <- reactive(function() {
    if (input$sortColumn == "Genre") {
      return(order(df$Genres, decreasing = input$sortDecreasing))
    }
    else {
      return(order(df$Counts, decreasing = input$sortDecreasing))
    }
  })
  
  # output sorted table
  # should update every time sort order updates
  output$table <- reactiveTable(function() {
    return(df[sortOrder(), ])
  }, include.rownames = FALSE)
  
  # output sorted bar plot
  # should update every time sort or color critera changes
  output$barPlot <- reactivePlot(function() {

    # use our function to generate the plot
    barPlot <- getPlot(sortOrder(), input$colorScheme)
    
    # output the plot
    print(barPlot)
  })
  
})

# two ways to run this application
# runApp()
# runGist("https://gist.github.com/19388fcc21fa22f00fd4")

ui.r

require(shiny)

# create a simple shiny page
shinyUI(pageWithSidebar(
  
  # add title
  headerPanel("Movie Genres"),
  
  # setup sidebar widgets
  sidebarPanel(
    # drop-down box for sort columns
    selectInput("sortColumn", "Sort By:", choices = c("Genre", "Count")),
    
    # true/false checkbox for sorting ascending or descending 
    checkboxInput("sortDecreasing", "Decreasing", FALSE),
    
    # little bit of space between widgets
    br(),
    
    # radio buttons for selecting the color scheme
    radioButtons("colorScheme", "Color Scheme:",
      c("None", "Qualitative 1", "Qualitative 2", "Color-Blind Friendly")
    ),
    
    # add download link
    HTML("<p align=\"center\">[ <a href=\"https://gist.github.com/19388fcc21fa22f00fd4\">download source</a> ]</p>")
  ),
  
  # setup main panel
  mainPanel(
    # create a tab panel
    tabsetPanel(
      # add a tab for displaying the histogram
      tabPanel("Histogram", plotOutput("barPlot")),
      
      # add a tab for displaying the table (will be sorted)
      tabPanel("Table", tableOutput("table"))
    )
  )
  
))