Skip to content

Instantly share code, notes, and snippets.

@ramnathv
Forked from pssguy/global.R
Created May 13, 2013 20:08
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ramnathv/5571066 to your computer and use it in GitHub Desktop.
Save ramnathv/5571066 to your computer and use it in GitHub Desktop.
# 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
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))
})
})
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"))
)
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment