-
-
Save fototo/5596089 to your computer and use it in GitHub Desktop.
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
# 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 | |
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
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)) | |
}) | |
}) |
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
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")) | |
) | |
) | |
)) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment