Shiny App showing ranking of 140+ TV Shows by episode

global.R

# load required packages
library(shiny)
library(shinyIncubator)
library(googleVis)
library(ggplot2)
library(stringr)
library(plyr)
library(XML)
library(httr)
library(Hmisc)
library(changepoint)

# load pre-compiled list of shows on GEOS including title and url code
allShows<- read.csv("http://dl.dropboxusercontent.com/u/25945599/Shows.csv",stringsAsFactors=FALSE)

allShows <- subset(allShows,!is.na(title))

# set data for selectInput in
showSelection <- allShows$title

server.R

shinyServer(function(input, output) {
  

# main data scraping and processing
  Data <-reactive( {
  
    # scrape selected show and create data.frame
    showID <- allShows[allShows$title==input$show,]$id
     showURL <- paste0("http://www.geos.tv/index.php/list?sid=",showID,"&collection=all")
     z <- readHTMLTable(showURL,  stringsAsFactors = FALSE)
    episodes <- z[["collectionTable"]]
    
     # perform some simple tidying
      episodes$Mean <- as.numeric(str_sub(episodes$Mean,1,4))
      episodes$Count <- as.integer(episodes$Count)
      episodes$epOrder <- as.integer(episodes[[1]])
      episodes <- arrange(episodes,epOrder)
    
    # create the changepoint object and  the lines.df
    # necessary for plot lines
    goodData <- subset(episodes,!is.na(Mean))
    pelt <- cpt.mean( goodData$Mean,method='PELT')
    cpts <- pelt@cpts
    st <- c(0,cpts[-length(cpts)])
    means <- [email protected]$mean
    lines.df <- data.frame(st=st,fin=cpts,means=means)
    
    # make data.frames available to other functions
    info <- list(lines.df=lines.df,episodes=episodes)
    return(info)
      
  })
  
  # enable paging on gvisTable
  myOptions <- reactive({  
    list(
    
      page='enable',
      pageSize=15

    )
  })
  
  # Use gvisTable to enable paging and sorting
  output$gvisTable <- renderGvis( {
    
    # make more presentable
    df <- Data()$episodes[,c("epOrder","Title","Mean","Count")]
    names(df) <- c("Episode","Title","Av Rating","Rankers")
    df <- subset(df,Rankers>0&Rankers!="")
    
    gvisTable(df, options=myOptions())
  })
  
  
  output$plot <- renderPlot( {
    
    plotdf <- Data()$episodes
    linesdf <- Data()$lines.df
    
    maxCount <- max(subset(plotdf,Count>0)$Count)
    print(
      ggplot(subset(plotdf,Count>0), aes(x=epOrder,y=Mean))+geom_point(alpha=subset(plotdf,Count>0)$Count/maxCount)+
      geom_segment(data=linesdf, aes(x = st, y = means, xend = fin, yend = means, colour="red"))+
      theme(legend.position="none") +
      ylab("Average Rating (out of 10)")+xlab("Episode Order") 
    )
  })
  
  
  output$notes <- renderUI( {
    
    df <-subset(Data()$episodes,!is.na(Count))
    max <- max(df$Count)
    min <- min(df$Count)
    mean <-ceiling(mean(df$Count))
   
    
    HTML(paste0("The graph represents the average ranking for the show over time. The red lines
indicate changepoints, estimations of when the properties of the time-series, typically the mean changes.
                The intensity of the plot varies according to the number of respondents. An episode of a show
                that is favourably rated tends to get more people ranking as do earlier episodes in long-running show.<p><p> For ",input$show," the average number of rankers was
                 ",mean," with a maximum of ",max))
    
  })
  
})

ui.R

shinyUI(pageWithSidebar(
  
  # Application title
  headerPanel("TV Show Rankings"),
  
  # Sidebar with information, controls to select the player and a best-of table
  sidebarPanel(
   
    
    helpText(
      p("Choose from one of 145 popular TV shows to see episode ranking by ",a("GEOS", href="http://www.geos.tv/")," members.")
      ),

   
    wellPanel(
      selectInput("show", "Select Show:",showSelection)
  
      ),
  
    

    
    p("Regular Articles - ",
      a("PSS blog", href="http://premiersoccerstats.com/wordpress/")
    ),
    
    p("Twitter Feed - ",
      a("@pssguy", href="http://twitter.com/pssGuy")
    ),
    
    
    
    p("Contact - ",
      a( "[email protected]", href="mailto:[email protected]"))
      
  
),
  

mainPanel(
  tabsetPanel(
  
    tabPanel("Chart", plotOutput("plot"),htmlOutput("notes")), # no good , height="200px"
    tabPanel("Sortable Table", htmlOutput("gvisTable"))
               
  ) 

  )
))
  
  

Sadly the GOES website is no longer live. This was a great example that everyone could relate to. It appears as though someone has something similar but does the fits by season here: http://graphtv.kevinformatics.com/ interesting to know if we could scrap the raw data and update the shiny app to use the new data instead.