Test. EPL charts and lineups

gameResults.csv

global.R

# needed for full version
require(rCharts)
require(shiny)
require(reshape2)
library(sqldf)
library(plyr)
library(lubridate)
library(stringr)
library(zoo)
library(XML)

Lineups <- read.csv("Lineups.csv", stringsAsFactors=FALSE)
tables_dt_print <- read.csv("tables_dt_print.csv", stringsAsFactors=FALSE)
gameResults <-read.csv("gameResults.csv", stringsAsFactors=FALSE)

seasonChoice <- sort(unique(gameResults$season))

Lineups.csv

server.R

shinyServer(function(input, output) {
  
  
  # create some conditional uiOutputs
  output$teams<- renderUI( {
    
    teamChoice <- sort(unique(gameResults[gameResults$season==input$season,]$team))
    selectInput("team", "Select Team",teamChoice)
    
    
    
    
  })
  
  
  # results chart 
  output$myChart <- renderChart( {
    #     
    input$goButton
    isolate({
      print(input$season)
      print(input$team)
      theTeam <- input$team
      if (is.null(theTeam)) theTeam<- "Arsenal"
      print(theTeam)
      df <- subset(gameResults,team==theTeam&season==input$season)
      # print(df)
      #df <- subset(gameResults,team=="Arsenal"&season=="1992/1993")
      df$showDate <- paste(month(df$gameDate,label = TRUE, abbr=TRUE),day(df$gameDate),year(df$gameDate), sep=" ")
      df_orig<- data.frame(x=df$seasonGame,
                           y=df$GD,
                           info=sprintf("<table cellpadding='4' style='line-height:1.5'><tr><th align='left'>%1$s</th></tr><tr><td align='center'>%2$s %4$s<br>%3$s</td></tr></table>",
                                        df$showDate,
                                        df$opposition,
                                        paste0(df$GF," - ",df$GA),
                                        paste0("(",df$venue,")")
                                        
                                        
                           ),
                           gameDate = df$gameDate,
                           result=df$result,
                           MATCHID=df$MATCHID)
      
        print(df_orig)
      
      b <- rCharts:::Highcharts$new()
      invisible(sapply(c("W", "D", "L"), function(res){
        df <- df_orig[df_orig$result == res,]
        df.lst <- lapply(1:nrow(df), function(i) as.list(df[i,]))
        b$series(data=df.lst, type = "column", name = res)
        
      })) 
      
      
      b$plotOptions(
        column = list(pointPadding = -0.25,
                      groupPadding = 0.1,
                      pointWidth = 10,
                      grouping=F,
                      cursor = "pointer", 
                      point = list(
                        events = list(
                          click = "#! function() {
                          Shiny.onInputChange('info', {
                          MATCHID: this.MATCHID
                          })   
    } !#")), 
                      marker = list(
                        symbol = "circle", 
                        radius = 5
                      )
                      )
        )
      # b$plotOptions(column = list(pointPadding = -0.25, groupPadding = 0.1, pointWidth = 10))
      b$tooltip(useHTML = T,formatter = "#! function() { return this.point.info; } !#") # this works as does anything else in thouh date needs
      b$yAxis(title=list(enabled=T,text="Goal Margin"), allowDecimals = FALSE) 
      b$xAxis(title=list(text="Season Game"), allowDecimals = FALSE) 
      
      b$colors('green','blue','red')
      b$chart(height=250)
      
      
      
      b$set(dom = 'myChart')
      
      return(b)
  })
    
  })
  
  # Position chart
  output$posChart <- renderChart( {
    #     
    input$goButton
    isolate({
      print(input$season)
      print(input$team)
      theTeam <- input$team
      if (is.null(theTeam)) theTeam<- "Arsenal"
      #df <- subset(tables_dt_print,season=="1992/1993"&team=="Arsenal")
      df <- subset(tables_dt_print,season==input$season&team==theTeam)
      df <- df[,c(1,2,3,4,12)]
      df <- arrange(df,seasonGame)
      df_final <- data.frame(x=df$seasonGame,y=df$Pos,Pts=df$cumPoints,
                             info=sprintf("<table cellpadding='4' style='line-height:1.5'><tr><td align='center'>Position: %1$s<br>Points: %2$s</td></tr></table>",
                                          df$Pos,
                                          df$cumPoints
                                          
                                          
                             ))
      
      
      posSeries <- lapply(split(df_final, rownames(df_final)), as.list)
      names(posSeries) <- NULL
      posSeries <- posSeries[order(sapply(posSeries, function(x) x$x))]
      c <- rCharts::Highcharts$new()
      c$series(data=posSeries, type = "line") # Great 
      c$yAxis(title=list(text="League Position"), reversed = TRUE, allowDecimals = FALSE, min= -5, startOnTick = FALSE)
      c$xAxis(title=list(text="Season Game"), allowDecimals = FALSE)
      c$legend(enabled=FALSE)
      c$chart(height=200)
      
      c$tooltip(useHTML = T, formatter = "#! function() { return this.point.info; } !#")
      
      
      c$set(dom = 'posChart')
      
      return(c)
      
    })
  })
  
  # Home team lineup
  output$home <- renderTable({
    print("matchid")
    print(input$info$MATCHID)
    if (is.null(input$info$MATCHID)){
      matchid_chosen = 1313
    } else {
      matchid_chosen = input$info$MATCHID
    }
    df <- subset(Lineups, MATCHID==matchid_chosen&venue=="H")
    df$order <- 1
    df[str_sub(df$POSITION,1,1)=="D",]$order <- 2
    df[str_sub(df$POSITION,1,1)=="M",]$order <- 3
    df[str_sub(df$POSITION,1,1)=="F",]$order <- 4
   
    for (i in 1:nrow(df)) {
          if (is.na(df$CARD[i])) {
            df$C[i] <- ''
          
      } else  if (df$CARD[i]=="Y") {
        df$C[i] <- '<img src="http://guardian.touch-line.com/images/yellow.gif"></img>'
      } else if (df$CARD[i]=="R") {
        df$C[i] <- '<img src="http://guardian.touch-line.com/images/red.gif"></img>'
      } else if (df$CARD[i]=="P") {
        df$C[i] <-'<img src="http://guardian.touch-line.com/images/yellow.gif"> </img><img src="http://guardian.touch-line.com/images/yellow.gif"></img>'
      } else if (df$CARD[i]=="Z"||df$CARD[i]=="X") {
        df$C[i] <-'<img src="http://guardian.touch-line.com/images/yellow.gif"> </img><img src="http://guardian.touch-line.com/images/red.gif"></img>'
      }
    }
   
    df$sub <- ''
    
    df <- arrange(df,desc(START),order,LASTNAME) # might want to change for older games where not all starts are 3 or change in lineus probeasier make all 6
    df$name <- paste0(df$LASTNAME,", ",str_sub(df$FIRSTNAME,1,1))
    df[df$Goals<1,]$Goals <- NA
    colnames(df)[8] <- "G"
    colnames(df)[21] <- "A"
    df$nameInfo <- df$name
    # sub image
    df$S <-''
    
    for (i in 1:nrow(df)) {
      if (df$subOn[i]>0&df$OFF[i]==0) {
        df$nameInfo[i] <- paste0(df$name[i]," (",df$subOn[i],")")
        df$S[i] <- '<img src="http://guardian.touch-line.com/images/MatchSubs/on1.gif"></img>'
      } else if (df$subOn[i]==0&df$OFF[i]>0) {
        df$nameInfo[i] <- paste0(df$name[i]," (",df$OFF[i],")")
        df$S[i] <- '<img src="http://guardian.touch-line.com/images/MatchSubs/off1.gif"></img>'
      } else if (df$subOn[i]>0&df$OFF[i]>0) {
        df$nameInfo[i] <- paste0(df$name[i]," (",df$subOn[i],", ",df$OFF[i],")")
      }
    }
    
    
    # birth country flag - still ned to setup
    for (i in 1:nrow(df)) {
      if (!is.na(df$iso2c[i])) {
        df$B[i] <- paste0('<img src="images/gif/',df$iso2c[i],'.gif" title="',df$COUNTRY[i],'"></img>')
      } else {
        df$B[i] <- ""   # should add dummy flag
      }
    }
    # Age
    df$BIRTHDATE <- ymd(df$BIRTHDATE) # makes POSIXct
    df$gameDate <- ymd(df$gameDate)
    df$Age <- str_sub(as.period(df$gameDate - df$BIRTHDATE, units = "year"),1,2)
    df_print<- data.frame(df[,c("B","Age","nameInfo","S","G","A","C")])                 
    colnames(df_print) <- c("","","","","Gl","As","Cd")
    df_print
  }, include.rownames=FALSE, sanitize.text.function = function(x) x)
  
  output$homeText <- renderText({
    unique(subset(Lineups, MATCHID==8041&venue=="H")$TEAMNAME)
  })
  
  output$away <- renderTable({
    if (is.null(input$info$
                  MATCHID)){
      matchid_chosen = 1313
    } else {
      matchid_chosen = input$info$MATCHID
    }
    df <- subset(Lineups, MATCHID==matchid_chosen&venue=="A")
    df$order <- 1
    df[str_sub(df$POSITION,1,1)=="D",]$order <- 2
    df[str_sub(df$POSITION,1,1)=="M",]$order <- 3
    df[str_sub(df$POSITION,1,1)=="F",]$order <- 4
    
      for (i in 1:nrow(df)) {
        if (is.na(df$CARD[i])) {
          df$C[i] <- ''
          
        } else  if (df$CARD[i]=="Y") {
          df$C[i] <- '<img src="http://guardian.touch-line.com/images/yellow.gif"></img>'
        } else if (df$CARD[i]=="R") {
          df$C[i] <- '<img src="http://guardian.touch-line.com/images/red.gif"></img>'
        } else if (df$CARD[i]=="P") {
          df$C[i] <-'<img src="http://guardian.touch-line.com/images/yellow.gif"> </img><img src="http://guardian.touch-line.com/images/yellow.gif"></img>'
        } else if (df$CARD[i]=="Z"||df$CARD[i]=="X") {
          df$C[i] <-'<img src="http://guardian.touch-line.com/images/yellow.gif"> </img><img src="http://guardian.touch-line.com/images/red.gif"></img>'
        }
      }
    df$sub <- ''
    
    df <- arrange(df,desc(START),order,LASTNAME) # might want to change for older games where not all starts are 3 or change in lineus probeasier make all 6
    df$name <- paste0(df$LASTNAME,", ",str_sub(df$FIRSTNAME,1,1))
    df[df$Goals<1,]$Goals <- NA
    colnames(df)[8] <- "G"
    colnames(df)[21] <- "A"
    df$nameInfo <- df$name
    # sub image
    df$S <-''
    
    for (i in 1:nrow(df)) {
      if (df$subOn[i]>0&df$OFF[i]==0) {
        df$nameInfo[i] <- paste0(df$name[i]," (",df$subOn[i],")")
        df$S[i] <- '<img src="http://guardian.touch-line.com/images/MatchSubs/on1.gif"></img>'
      } else if (df$subOn[i]==0&df$OFF[i]>0) {
        df$nameInfo[i] <- paste0(df$name[i]," (",df$OFF[i],")")
        df$S[i] <- '<img src="http://guardian.touch-line.com/images/MatchSubs/off1.gif"></img>'
      } else if (df$subOn[i]>0&df$OFF[i]>0) {
        df$nameInfo[i] <- paste0(df$name[i]," (",df$subOn[i],", ",df$OFF[i],")")
      }
    }
    # df$Country <- "england" # obv will vary when got sorted
    
    # birth country flag - still ned to setup
    for (i in 1:nrow(df)) {
      if (!is.na(df$iso2c[i])) {
        df$B[i] <- paste0('<img src="images/gif/',df$iso2c[i],'.gif" title="',df$COUNTRY[i],'"></img>')
      } else {
        df$B[i] <- ""   # should add dummy flag
      }
    }
    # Age
    df$BIRTHDATE <- ymd(df$BIRTHDATE) # makes POSIXct
    df$gameDate <- ymd(df$gameDate)
    df$Age <- str_sub(as.period(df$gameDate - df$BIRTHDATE, units = "year"),1,2)
    df_print<- data.frame(df[,c("B","Age","nameInfo","S","G","A","C")])                 
    colnames(df_print) <- c("","","","","Gl","As","Cd")
    df_print
  }, include.rownames=FALSE, sanitize.text.function = function(x) x)
  output$homeText <- renderText({
    unique(subset(Lineups, MATCHID==8041&venue=="H")$TEAMNAME)
  })
  
  
  
  output$homeBadge <- renderUI({
    img(src="http://images.racingpost.com/football/teambadges/2471.png", width="20", height="20") #works
    # try to combine image and text alts with css not working either yet
    #paste(img(src="http://images.racingpost.com/football/teambadges/2471.png", width="20", height="20")) # makes text
  })
  
  output$homeText <- renderText({
    output$homeText <- renderText({
      if (is.null(input$info$MATCHID)){
        matchid_chosen = 1313
      } else {
        matchid_chosen = input$info$MATCHID
      }
      unique(subset(Lineups, MATCHID==matchid_chosen&venue=="H")$TEAMNAME)
    })
  })
  
  output$description <- renderText({
    repURL <- "http://www.guardian.co.uk/football/2013/may/19/tottenham-sunderland-premier-league-match-report"
    basicInfo <- htmlParse(repURL, isURL = TRUE)
    description <-xpathSApply(basicInfo, '//*/meta[@name="description"]/@content')
    title <- xpathSApply(basicInfo, '//*/meta[@property="og:title"]/@content')
    title_df <- data.frame(title)
    
    title <- as.character(title_df$title[1])
    d_df <- data.frame(description)
    
    description<- as.character(d_df$description[1])
    description
  })
  
  output$report <- renderText({
    repURL <- "http://www.guardian.co.uk/football/2013/may/19/tottenham-sunderland-premier-league-match-report"
    basicInfo <- htmlParse(repURL, isURL = TRUE)
    content <- xpathSApply(basicInfo, "//*/p/text()", xmlValue)[2]
    x <- unlist(strsplit(content, "\\s+"))
    y <- split(x, seq_along(x)%/%150)
    content <- paste(y[[1]],collapse=' ') # then add more... wih a href
    content
  })
  
  
  
})

tables_dt_print.csv

ui.R

shinyUI(pageWithSidebar(
  
  # Application title. Leave blank to create more space
  headerPanel(""),
  
    sidebarPanel(
    tags$head(
      tags$link(rel = 'stylesheet', type = 'text/css', href = 'styles.css')),
   
    
    helpText(h5
             (p("Results, interaction standing"))),
             

    wellPanel(
      
      selectInput("season", "Select Season",seasonChoice),
      uiOutput("teams"),
      actionButton("goButton","Refresh")
                
      
      ),
      h5(textOutput("description")),
    p(textOutput("report"))

  ),

mainPanel(
 showOutput("posChart","highcharts"),
  showOutput("myChart","highcharts"),
 
 uiOutput("homeBadge"), textOutput("homeText"), 
 div(class="row"),
 
 
 div(class="span5", tableOutput("home")),
 div(class="span5", tableOutput("away"))

   
  )
))