f1 laptime explorer - Shiny - ergast API

global.R

library(RJSONIO)
library(plyr)

#racechart

#Helper functions
getNum=function(x){as.numeric(as.character(x))}
timeInS=function(tStr){
  x=unlist(strsplit(tStr,':'))
  tS=60*getNum(x[1])+getNum(x[2])
}

#ggplot chart helpers
xRot=function(g,s=5,lab=NULL) g+theme(axis.text.x=element_text(angle=-90,size=s))+xlab(lab)


#My cacheing attempt is broken
#messing up scope somewhere?
#race.cache=list()

##factorise this to pieces, just in case...?
#def get race URL
getLapsURL=function(raceNum){
  paste("http://ergast.com/api/f1/2012/",raceNum,"/laps.json?limit=2500",sep='')
}

getRaceResultsURL=function(raceNum){
  paste("http://ergast.com/api/f1/2012/",raceNum,"/results.json",sep='')
}

getDriversURL=function(year){
  paste("http://ergast.com/api/f1/",year,"/drivers.json",sep='')
}

getDriversData=function(year){
  drivers.data=data.frame(
    name=character(),
    driverId=character()
  )
  drivers.json=fromJSON(getDriversURL(year),simplify=FALSE)
  drivers=drivers.json$MRData$DriverTable$Drivers
  for (i in 1:length(drivers)){
    drivers.data=rbind(drivers.data,data.frame(
      driverId=drivers[[i]]$driverId,
      name=drivers[[i]]$familyName
    ))
  }
  drivers.data
}

getRacesData.full=function(year='2012'){
  racesURL=paste("http://ergast.com/api/f1/",year,".json",sep='')
  races.json=fromJSON(racesURL,simplify=FALSE)
  races.json
}

getRacesData=function(year){
  races.data=data.frame(
    round=numeric(),
    racename=character(),
    circuitId=character()
  )
  rd=getRacesData.full(year)
  races=rd$MRData$RaceTable$Races
  for (i in 1:length(races)){
    races.data=rbind(races.data,data.frame(
      round=races[[i]]$round,
      racename=races[[i]]$raceName,
      circuitId=races[[i]]$Circuit$circuitId
    ))
  }
  races.data
}

getRaceResultsData.full=function(raceNum){
  raceResultsURL=getRaceResultsURL(raceNum)
  raceResults.json=fromJSON(raceResultsURL,simplify=FALSE)
  raceResults.json
}

getLapsData.full=function(raceNum){
  print('grabbing data')
  lapsURL=getLapsURL(raceNum)
  laps.json=fromJSON(lapsURL,simplify=FALSE)
  laps.json
}

#getLapsData.full.cache=function(raceNum,race.cache=list()){
#  if (as.character(raceNum) %in% names( race.cache )){
#      print('using cache')
#      #laps.json=race.cache[as.character(raceNum)][[1]]
#  } else {
#    print('grabbing data')
#    laps.json=getLapsData.full(raceNum)
#    print('cacheing')
#    rn=as.character(raceNum)
#    race.cache[[rn]]=laps.json
#  }
#  race.cache
#}

getLapsData=function(rd){
  laps.data=rd$MRData$RaceTable$Races[[1]]$Laps
  laps.data
}


hack1=function(crap){
  if (length(crap$FastestLap)>0)
    getNum(crap$FastestLap$lap)
  else NA
}
hack2=function(crap){
  if (length(crap$FastestLap)>0)
    timeInS(crap$FastestLap$Time$time)
  else NA
}
hack3=function(crap){
  if (length(crap$FastestLap)>0)
    getNum(crap$FastestLap$rank)
  else NA
}

formatRaceResultsData=function(rrd){
  race.results.data=data.frame(
    carNum=numeric(),
    pos=numeric(),
    driverId=character(),
    constructorId=character(),
    grid=numeric(),
    laps=numeric(),
    status=character(),
    millitime=numeric(),
    fastlapnum=numeric(),
    fastlaptime=character(),
    fastlaprank=numeric()
    )
  
  for (i in 1:length(rrd)){
    race.results.data=rbind(race.results.data,data.frame(
      carNum=as.integer(as.character(rrd[[i]]$number)),
      pos=as.integer(as.character(rrd[[i]]$position)),
      driverId=rrd[[i]]$Driver$driverId,
      constructorId=rrd[[i]]$Constructor$constructorId,
      grid=as.integer(as.character(rrd[[i]]$grid)),
      laps=as.integer(as.character(rrd[[i]]$laps)),
      status=rrd[[i]]$status,
      #millitime=rrd[[i]]$Time$millis,
      fastlapnum=hack1(rrd[[i]]),
      fastlaptime=hack2(rrd[[i]]),
      fastlaprank=hack3(rrd[[i]])
    ))
  }
  race.results.data$driverId=reorder(race.results.data$driverId, race.results.data$carNum)
  race.results.data
}

getResults.df=function(raceNum){
  rrj=getRaceResultsData.full(raceNum)
  rrd=rrj$MRData$RaceTable$Races[[1]]$Results
  formatRaceResultsData(rrd)
}

getWinner=function(raceNum){
  wURL=paste("http://ergast.com/api/f1/2012/",raceNum,"/results/1.json",sep='')
  wd=fromJSON(wURL,simplify=FALSE)
  wd$MRData$RaceTable$Races[[1]]$Results[[1]]$Driver$driverId
}

formatLapData=function(rd){
  #initialise lapdata frame
  lap.data <- data.frame(lap=numeric(),
                       driverID=character(), 
                       position=numeric(), strtime=character(),rawtime=numeric(),
                       stringsAsFactors=FALSE)

  for (i in 1:length(rd)){
    lapNum=getNum(rd[[i]]$number)
    for (j in 1:length(rd[[i]]$Timings)){
      lap.data=rbind(lap.data,data.frame(
        lap=lapNum,
        driverId=rd[[i]]$Timings[[j]]$driverId,
        position=as.integer(as.character(rd[[i]]$Timings[[j]]$position)),
        strtime=rd[[i]]$Timings[[j]]$time,
        rawtime=timeInS(rd[[i]]$Timings[[j]]$time)
      ))
    }
  }
  
  lap.data=ddply(lap.data,.(driverId),transform,cuml=cumsum(rawtime))
  
  #via http://stackoverflow.com/a/7553300/454773
  lap.data$diff <- ave(lap.data$rawtime, lap.data$driverId, FUN = function(x) c(NA, diff(x)))
  
  lap.data=ddply(lap.data,.(driverId),transform,decmin=rawtime-min(rawtime))
  lap.data$topdelta=lap.data$rawtime-min(lap.data$rawtime)
  lap.data
}

getLapsdataframe=function(rd){
  ld=getLapsData(rd)
  laps.data=formatLapData(ld)
  laps.data
}

getLaps.df=function(raceNum){
  rd=getLapsData.full(raceNum)
  ld=getLapsData(rd)
  laps.data=formatLapData(ld)
  laps.data
}

df=getRacesData('2012')

server.R

##shinyLapdata

library(shiny)
library(ggplot2)

###TEST CODE FOR CONSOLE
#laps=getLaps.df(1)
#results=getResults.df(1)

# Define server logic
shinyServer(function(input, output) {
  #This attempt at cacheing is broken? race.cache doesn't?
  #race.cache=list()
  
  results.data <- reactive(function(){
    getResults.df(input$race)  
  })
  
  drivers.data <- reactive(function(){
    getDriversData(2012)  
  })
  
  laps.data <- reactive(function() {  
    raceNum=input$race
    #really should cache this?
    #First attempt does't work? Scope problems?
    #print(names(race.cache))
    #race.cache=getLapsData.full.cache(raceNum,race.cache)
    #print(names(race.cache))
    #rd=race.cache[as.character(raceNum)][[1]]
    #laps.data=getLapsdataframe(rd)
    laps.data=getLaps.df(raceNum)
    #rr=getResults.df(raceNum)    
    driverN=getWinner(raceNum)#'maldonado'
    
    driverNtimes=subset(laps.data,driverId==driverN,select=c('rawtime'))
    winnerMean=colMeans(driverNtimes)
    
    laps.data$raceHistory=winnerMean*laps.data$lap-laps.data$cuml
    laps.data
  })

  
  output$driversControl <- reactiveUI(function() {
    ddrivers <-drivers.data()
    dList=levels(ddrivers$driverId)
    names(dList)=ddrivers$name
    dList[['All']]="all"
    checkboxGroupInput("drivers", "Choose Drivers", dList)
  })
  
  output$raceHistory = reactivePlot(function() {
    fdd=input$drivers
    
    if (length(fdd)==0) laps=laps.data()
    else if ('all' %in% fdd) laps=laps.data()
    else laps=subset(laps.data(),driverId %in% fdd)
    
    g=ggplot(laps)
    g=g+geom_line(aes(x=lap,y=raceHistory,group=driverId,col=driverId))
    g=g+xlab("Laps")+ylab(NULL)
    print(g)
  })
  
  output$lapChart = reactivePlot(function() {
    fdd=input$drivers

    if (length(fdd)==0){
      laps=laps.data()
      if (input$annotations==TRUE) results=results.data()
    } 
    else if ('all' %in% fdd){
      laps=laps.data()
      if (input$annotations==TRUE) results=results.data()
    } 
    else {
      laps=subset(laps.data(),driverId %in% fdd)
      if (input$annotations==TRUE) results=subset(results.data(),driverId %in% fdd)
    }
    
    #Chart annotations should be a result of a UI switch being enabled?
    if (input$annotations==TRUE) {
      results.status=subset(results,select=c('driverId','status','laps'))
      laps2=merge(laps,results.status,by.x=c('driverId','lap'),by.y=c('driverId','laps'))
    }
    
    laps=subset(laps,select=c('position','driverId','lap'))
    d=subset(results.data(),select=c('grid','driverId'))
    d$lap=0
    colnames(d)=c('position','driverId','lap')
    laps=rbind(d,laps)

    g=ggplot(laps)
    g=g+geom_line(aes(x=lap,y=position,group=driverId,col=driverId))
    if (input$annotations==TRUE)
      g=g+geom_text(data=subset(laps2,status!='Finished'),aes(x=lap,y=position,label=status),size=3,angle=45,col='red')
    g=g+xlab("Laps")+ylab(NULL)+ylim(1,24)
    print(g)
  })
                                    
  output$lapEvolutioncf = reactivePlot(function() {
    fdd=input$drivers
    if (length(fdd)==0) laps=laps.data()
    else if ("all" %in% fdd) laps=laps.data()
    else laps=subset(laps.data(),driverId %in% fdd)
    g=ggplot(laps)
    g=g+geom_line(aes(x=lap,y=decmin,group=driverId,col=driverId))
    g=g+xlab("Laps")+ylim(0,15)+ylab("Delta from personal fastest lap (s)")
    g=g
    print(g)
  })
  
  output$personalDeltas=reactivePlot(function(){
    fdd=input$drivers
    if (length(fdd)==0) laps=laps.data()
    else if ("all" %in% fdd) laps=laps.data()
    else laps=subset(laps.data(),driverId %in% fdd)
    g=ggplot(laps)
    g=g+geom_line(aes(x=lap,y=diff,group=driverId,col=driverId))
    g=g+xlab("Laps")+ylim(-3.5,3.5)+ylab("Delta from personal fastest lap (s)")
    g=g
    print(g)
  })
  
  output$overallDeltas=reactivePlot(function(){
    fdd=input$drivers
    if (length(fdd)==0) laps=laps.data()
    else if ("all" %in% fdd) laps=laps.data()
    else laps=subset(laps.data(),driverId %in% fdd)
    g=ggplot(laps)
    g=g+geom_line(aes(x=lap,y=topdelta,group=driverId,col=driverId))
    g=g+xlab("Laps")+ylim(0,20)+ylab("Delta from overall fastest lap (s)")
    g=g
    print(g)
  })

  output$raceSummary=reactivePlot(function(){
    
    fdd=input$drivers
    if (length(fdd)==0) {
      laps=laps.data()
      results=results.data()
    }
    else if ("all" %in% fdd) {
      laps=laps.data()
      results=results.data()
    }
    else {
      laps=subset(laps.data(),driverId %in% fdd)
      results=subset(results.data(),driverId %in% fdd)
    }
    
    #tmax=ddply(laps, "driverId", summarise, max = max(position))
    #tmin=ddply(laps, "driverId", summarise, min = min(position))
    #tt=merge(tmax,tmin,"driverId")
    
    #The first point is just a fudge to set driver order by driver number (factor order relates to results$driverId)
    ##results$driverId=reorder(results$driverId, results$carNum)
    #Also eg
    #results$driverId=reorder(results$driverId, results$pos)
    #or by grid classification
    results$driverId=reorder(results$driverId, results$grid)
    #Maybe set the order from a user control?
    
    g=ggplot(results)
    g=g+geom_point(aes(x=driverId, y=grid)) 

    g=g+geom_point(aes(x=driverId, y=grid),size=6, ,colour='lightblue') 
    #g=g+geom_linerange(data=tt,aes(x=driverId,ymin=min,ymax=max))
    g=g+geom_violin(data=laps,aes(x=driverId,y=position))
    g=g+geom_point(data=subset(laps,lap==1),aes(x=driverId, y=position), pch=3, size=4)
    #If we add this in, is it too distracting?
    #g=g+geom_point(aes(x=driverId, y=grid),size=1, ,colour='lightblue')
    if (length(fdd)!=0 & (!("all" %in% fdd))) g=g+geom_point(aes(x=driverId, y=grid),size=6, ,colour='lightblue')
    g=g+geom_point(aes(x=driverId, y=pos), col='red',size=2.5) + ylab("Position")
    g=xRot(g,8)
    g=g+labs(title="red = final pos, blue = grid, - = end lap 1, | = pos distribution")
    print(g)
  })
  
  output$raceSummaryDesc=reactiveUI(function(){
    HTML("<div>The <em>Race Summary Chart</em> is intended to provide an at glance summary of driver positions
        at notable parts of the race: on the grid, at the end of the first lap, at the end of the race.
        The range and density of race positions held throughout the race is also shown using a statistical 
        graphics technique known as a a <em>violin plot</em>.</div>
        <hr/>")
    
  })
  
  output$fastLaps=reactivePlot(function(){
    fdd=input$drivers
    if (length(fdd)==0) results=results.data()
    else if ("all" %in% fdd) results=results.data()
    else results=subset(results.data(),driverId %in% fdd)
    g=ggplot(results)
    g=g+geom_text(aes(x=fastlapnum,y=fastlaptime,label=driverId), angle=45,size=3)
    g=g+xlab("Lap")+ylab("Laptime (s)")
    print(g)
  })
  
  output$view = reactiveTable(function() {
    d = results.data()
    head(d,n=24)
  })
  
})

ui.R

##shinyLapData
#Experiments around ergast API lap time data

library(shiny)

rList=levels(df$round)
names(rList)=df$racename

# Define UI for application that plots random distributions 
shinyUI(pageWithSidebar(
  
  
  # Application title
  headerPanel("Ergast F1 2012 Laptime Explorer"),
  
  sidebarPanel(
    #selectInput("ctyp", "Report:",list("Race History Chart" = "rhc", "Laptime evolution" = "lte")),
    selectInput("race", "Race:",rList),
    #uiOutput("driverControl"),
    checkboxInput("annotations", "Show annotations", FALSE),
    uiOutput("driversControl"),
    div("This demo provides a couple of views over Formula One laptime data obtained from the",
        a(href='http://ergast.com/mrd/',
          "Ergast Developer API")),
    div("The code is available as a gist:",a(href="https://gist.github.com/4188912","Shiny F1 laptime explorer"))
    
  ),
  
  #The main panel is where the "results" charts are plotted
  mainPanel(
    tabsetPanel(
      tabPanel("Race History", plotOutput("raceHistory")),
      tabPanel("Lap Chart",plotOutput("lapChart")),
      tabPanel("Lap Evolution", plotOutput("overallDeltas")),
      tabPanel("Personal Lap Evolution", plotOutput("lapEvolutioncf")),
      tabPanel("Personal Deltas", plotOutput("personalDeltas")),
      tabPanel("Race Summary", plotOutput("raceSummary"),htmlOutput('raceSummaryDesc')),
      tabPanel("Fast Laps", plotOutput("fastLaps"))
    ),
    tableOutput("view")
  )
))