public
Created

Shiny App showing ranking of 140+ TV Shows by episode

  • Download Gist
global.R
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
# 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
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
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 <- pelt@param.est$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
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
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( "andy@premiersoccerstats.com", href="mailto:andy@premiersoccerstats.com"))
),
 
mainPanel(
tabsetPanel(
tabPanel("Chart", plotOutput("plot"),htmlOutput("notes")), # no good , height="200px"
tabPanel("Sortable Table", htmlOutput("gvisTable"))
)
 
)
))

This is really great, a particularly nice use of Shiny!

Some of the scraped titles in the csv have cut off prematurely though for shows including a ":" in the show title. e.g. Terminator: The Sarah Connor Chronicles and all the Star Trek: and Star Wars: shows, so they can't be distinguished in the list, and encoding problems mean Carnivàle also doesn't display properly.

What is Shiny exactly? I have never heard of it.

@mattmalin. Thanks. Yes there are 1 or 2 aspects I should follow up

@shadowace112 From http://www.rstudio.com/shiny/

Shiny makes it super simple for R users like you to turn analyses into interactive web applications that anyone can use. Let your users choose input parameters using friendly controls like sliders, drop-downs, and text fields. Easily incorporate any number of outputs like plots, tables, and summaries.

No HTML or JavaScript knowledge is necessary. If you have some experience with R, you’re just minutes away from combining the statistical power of R with the simplicity of a web page

Awesomeness incarnate!

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.