Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
f1 laptime explorer - Shiny - ergast API
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')
##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)
})
})
##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")
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.