Shiny example: EPL Players Goal Scoring Runs

global.R

library(shiny)
library(ggplot2)

# data based on goals scored to early November 2012
url <- "http://www.premiersoccerstats.com/plScoringRuns.csv"
df <- read.csv(url,stringsAsFactors=FALSE)


# create the data for the selectInput
playerChoices <- unique(df[,c(1,2)])$PLAYERID
names(playerChoices) <- unique(df[,c(1,2)])$name

server.R

shinyServer(function(input, output) {
   
  output$yesPlot <- reactivePlot(function(player=input$player) {
   
    
    # subset to selected player
    df.player <- subset(df,(PLAYERID==player))
    ## subset to scoring runs
    yesRun <- subset(df,(PLAYERID==player&value==1))
    # construct new df to handle plotting better than a histogram
    yesRunNew <-data.frame(table(yesRun$slength))
    if (nrow(yesRunNew)>0) {
    colnames(yesRunNew) <- c("Games","Count")
    yesRunNew$Games <- as.integer(as.character(yesRunNew$Games))
    }
    
                     if (nrow(yesRun)>0) {
                       if (tail(df.player,1)$value==1)  {
                       print(ggplot(yesRunNew, aes(x=Games,y=Count))+ geom_bar(data=subset(yesRunNew,Games==tail(yesRun,1)$slength),fill="green",stat="identity")+
                         geom_bar(data=subset(yesRunNew,Games!=tail(yesRun,1)$slength),fill="green",alpha=1/5,stat="identity") +
                         scale_x_discrete(breaks=yesRunNew$Games) +
                         xlab("Sequence Length")+ ylab("Count")+ggtitle("Games Scored In"))
                     } else {
                       print(ggplot(yesRunNew, aes(x=Games,y=Count))+
                               geom_bar(data=yesRunNew,fill="green",alpha=1/5,stat="identity") +
                               scale_x_discrete(breaks=yesRunNew$Games) +
                               xlab("Sequence Length")+ ylab("Count")+ggtitle("Games Scored In"))
                     }
  } else {
    # print a dummy table 
    print(ggplot(subset(df,(PLAYERID=="TORRESF"&value==1)), aes(x=slength))+
            geom_histogram(binwidth=1,fill="green",alpha=1/217)+
            xlab("Sequence Length")+ ylab("Count")+ggtitle("Games Scored In"))
  }
                     
  })
  
  output$noPlot <- reactivePlot(function(player=input$player) {
    
    
    
   # Do similar procedure for non-scoring sequences
    noRun <- subset(df,(PLAYERID==player&value==0))
    noRunNew <-data.frame(table(noRun$slength))
    colnames(noRunNew) <- c("Games","Count")
    noRunNew$Games <- as.integer(as.character(noRunNew$Games))
   
    if (tail(df.player,1)$value==0)  {
      print(ggplot(noRunNew, aes(x=Games,y=Count))+ geom_bar(data=subset(noRunNew,Games==tail(noRun,1)$slength),fill="red",stat="identity")+
              geom_bar(data=subset(noRunNew,Games!=tail(noRun,1)$slength),fill="red",alpha=1/5,stat="identity") +
              scale_x_discrete(breaks=noRunNew$Games) +
              xlab("Sequence Length")+ ylab("Count")+ggtitle("Games Not Scored In"))
    } else {
      print(ggplot(noRunNew, aes(x=Games,y=Count))+
              geom_bar(data=noRunNew,fill="red",alpha=1/5,stat="identity") +
              scale_x_discrete(breaks=noRunNew$Games) +
              xlab("Sequence Length")+ ylab("Count")+ggtitle("Games Not Scored In"))
    }
  })
  
  # Adjust caption text if necessary
  output$caption <- reactiveText(function() {
    "caption"
    
  })
  
  # calculate the best runs all time
  output$view <- reactiveTable(function() {
    df.top <- arrange(subset(df,value==1&slength>6),desc(slength))
    df.top <-df.top[,c(2,3)]
    colnames(df.top) <- c("","Games")
    df.top
  })

  
})

ui.R

shinyUI(pageWithSidebar(
  
  # Application title
  headerPanel("PremierSoccerStats"),
  
  # Sidebar with information, controls to select the player and a best-of table
  sidebarPanel(
    
    helpText(
      "Choose any of the EPL players and see
      the runs of games they have scored  & failed
      to score in. The highlighted bar is the current
      ,or final, sequence"),
    helpText(
      "After initial loading of the data,
      changes are instantaneous"),
    
    
    selectInput("player", "Player:",playerChoices,selected="Fernando Torres"),
    helpText(
      "Below are the leading sequences
      since September 1992. van Nistelrooy's
      record run was spread over two seasons")
        ,
    
    tableOutput("view")
    
   
    
    
  ),
  
  # Show the plots 
  
  mainPanel(
    div(class="row"),
      div(class="span3", plotOutput("yesPlot")),
    div(class="span6", plotOutput("noPlot")),
    div(class="row"),
    helpText(
      "More data can be found at premiersoccerstats.com, the associated blog and by following
      @pssguy on twitter")
    
  )
))