public
Last active

f1 laptime explorer - Shiny - ergast API

  • Download Gist
global.R
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
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
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
##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
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42
##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")
)
))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.