精選

標籤

Ergast API：繪出 F1 賽場上的車手車隊表現

繼上篇【F1賽車哪裡看？怎麼看？線上觀賽小知識】介紹許多關於F1的細節與近期*GP賽事的看點，也有對車手、車隊做簡單介紹。該篇文其中有些圖是Yun自行運用R繪圖出來的，像是賽事地圖、最快單圈，而在這次的文章裡，我將會講述我所使用的F1資料來源是什麼？我如何做出這些圖形？並帶大家看幾個採用Ergast這個API的作品應用。（GP = Grand Prix 大獎賽，是賽車比賽的最高殿堂。）

F1資料來源: Ergast API

Ergast API：https://ergast.com/mrd/
從API Documentation閱讀它的JSON參數了解基本格式：
https://ergast.com/api/<series>/<season>/<round>/...
series這邊固定選擇級別為F1的賽事。舉幾個例子，假如要抓六月底在奧地利Austrian Grand Prix的賽事（2019年第9場）的排位賽結果，JSON格式的API網址就是下列第一個

末端去掉.json會呈現表格整理的網頁，方便閱讀以作檢查。


實作過程：jsonlite、ggmap、magick

有了前面提到的json檔，在R裡面其實就能很方便地透過jsonlite套件來轉換取得dataframe的格式。不過，在自己做之前，還是先看了一下別人怎麼處理F1的資料格式，所以我大致閱讀了Wrangling F1 Data With R – F1DataJunkie Book這本電子書，作者做出了一個ergastR-core.R的source，也可以下載到*wd後，運用其內建的函數來抓取json API並化為data.frame。（*working directory 工作資料夾）

透過觀察這份檔案中的所有function以領會API結構。接著自己用fromJSON轉換、觀察結果弄成data.frame，使用mutate、cbind調整variables留下最重要資訊，比如：
affix_url <- "https://ergast.com/api/f1/2019"
f1_2019 <- fromJSON(paste0(affix_url, ".json"))
f1 <- f1_2019$MRData$RaceTable$Races
f1 <- f1 %>% mutate(circuitName = f1_2019$MRData$RaceTable$Races$Circuit$circuitName)
f1_2019 <- f1 %>% cbind(f1_2019$MRData$RaceTable$Races$Circuit$Location)
而這些資料抓下來的class都是character，所以要依照變數的特性做轉換，日期時間用lubridate套件的month()、hms()等等、數值可用as.numeric()，比如：
as_datetime(f1_2019$date) %>% month()
f1_2019$lat <- as.numeric(f1_2019$lat)
也從書上學到一招：用kable而不用df或tibble輸出，在.rnb上看起來更簡潔。
knitr::kable(f1_2019[,-6], row.names=F,format="markdown")
知道怎麼抓下資料、清楚資料內容後，即可著手做更多變化。接下來放上幾個自己實作的範例。


Example 1：賽事地圖（maps, ggrepel, gganimate）

require(maps)
p <- f1_2019 %>% ggplot() + borders("world", colour="#FFFFFF", fill="#000000")+
  coord_cartesian(ylim = c(-50, 80))+
  theme_void() + 
  theme(
    plot.title = element_text(hjust = 0.5, size=32),
    plot.subtitle = element_text(hjust = 0.5, size=20)
  )+
  ggtitle("Grand Prix Tracks (F1GP)")+
  geom_point(aes(x=long, y=lat) ,color="red", size=10, alpha=0.7)
p + geom_label_repel(aes(x=long, y=lat, label = country),
                  box.padding   = 0.5,
                  point.padding = 1,
                  segment.color = 'red')
1. 首先取得maps的地圖資料庫，選用"world"世界地圖，以borders畫出。
2. 設定直角坐標系（Cartesian coordinate system）中y軸的範圍限制（ylim），移除南極。
3. 設定坐標系採用的x,y，以及點圖（geom_point）的呈現方式：顏色、大小、透明度
4-1. 趕走（Repel）在點上的label，設定與點的距離、與其他文字距離、線段顏色。

p + transition_time(time = round) +
  labs(subtitle = "Round {round(frame_time)} | {f1_2019$date[f1_2019$round == round(frame_time)]} | {f1_2019$locality[f1_2019$round == round(frame_time)]}",
       title = "{f1_2019$raceName[f1_2019$round == round(frame_time)]}") +
  enter_fade() + 
  exit_shrink() +
  ease_aes('quartic-in-out')
4-2. 動點顯示年度賽事順序，transition採用time，同步隨著場次更改標題、副標。（如果不是numeric的變數，不能用time，要用states）

png("圖片名稱.png", height=600, width=1200)
/*圖片的生成資料擺在這之間*/
dev.off()
animate(p, height = 600, width = 1200)
anim_save("動圖名稱.gif")
logo_raw <- image_read("logo.png")
plot <- image_read("./圖片名稱.png")
logo <- logo_raw %>% image_scale("50")
# image_info(plot)
final_plot <- image_composite(plot, logo, 
                              offset = paste0("+",image_info(plot)[2]*0.1,"+",image_info(plot)[3]*0.8))
image_write(final_plot, "./成品.png"))
5. 存成png（或gif）後，使用magick套件以加上個人logo，image_read讀檔、scale縮放、info了解圖片資訊、composite合成、write寫入儲存。合成時，offset是用以設定logo位置 （+寬+高，以左上角為原點）。


Example 2：最快單圈（apply, geom_text, scale_y_continuous, color_manual）

運用相同方法，修改一下API位址，取得今年第九場賽事res9的資料，內容包含各車手、車隊、最快單圈時間、排名（position）、起跑位（grid）。這裡針對上一篇出現過的最速單圈圖，來了解Yun怎麼實作的吧！


speed <- res9$FastestLap %>% 
  mutate(Time= sapply(Time$time, timeInS), AverageSpeed = as.numeric(AverageSpeed$speed))

speed[] <- lapply(speed, function(x) {
    if(is.character(x)) as.numeric(as.character(x)) else x
})

speed <- speed %>% mutate(constructor = as.factor(res9$Constructor$name), driver=res9$Driver$code)
speed %>% ggplot(aes(x=rank, y=AverageSpeed, label = driver, color = constructor)) +
  theme_bw() +
  labs(x="Rank", y="Avg Speed (kph)") +
  scale_y_continuous(breaks=round(speed$AverageSpeed,1), limits = c(min(speed$AverageSpeed)-0.5, max(speed$AverageSpeed)+0.5)) +
  geom_point(alpha=0) +
  geom_text(aes(label=round(Time,1), size=sqrt(1/Time)),hjust=0, vjust=0,nudge_x = 0.5,angle = 20) +
  geom_text(aes(label=ifelse(lap>73*0.8 ,paste0("L",lap), '')),hjust=1, vjust=1, nudge_x = -1,angle = 20) +
  geom_text(aes(color = constructor), colour = "#383838", size =3, fontface = "bold")  +
  annotate("text", label = "Fastest Lap", x = 5, y = 220.7, size = 8, colour = "blue") +
  guides(size = FALSE) +
  scale_color_manual(values = qb)
1. 調整欄位資料型態，將時間改為秒計。（用sapply逐一轉換row的每筆資料）
2. 將char轉變成numeric（用lapply逐一轉換每個column）
3. 車隊取用車隊名稱，並轉為factor；車手則取用車手縮寫 *code
4. 依照該場比賽的最速單圈做圖，x為排行，y為單圈速度。可看出左上角Verstappen為最快，而右下角Kubica最慢。
5. 最快單圈標記：各車手右方加上秒數，左方加上做出最快的圈次（但僅標示比賽尾盤做出最快單圈之選手, label=ifelse）。
6. 方便閱讀：加上角度迴避、大小強調，直接將每個點改為車手code，也調整y軸breaks直接標示每位車手速度。
7. 輔以車隊顏色區辨（這部分要先取得車隊Hex色碼，再讓顏色mapping車隊的factor level。）
tmp <- read.table(file = "./車隊色碼.txt", header = F, stringsAsFactors = F)
qb <- tmp$V2[match(levels(speed$constructor), tmp$V1)]


Example 3：車手名次（geom_raster, geom_hline, na.value）

接著我也將前九場比賽的資料做整理，將所有車手的名次列出，同時包含完賽狀況 *status。
Win19 <- data.frame()
for (rnd in 1:9) {
    /* ...
      運用json API得到各場資料，並整理，類似Example2
    ... */
    res_tmp2 <- cbind(round = rnd, res_tmp2)
    Win19 <- rbind(Win19, res_tmp2)
    Sys.sleep(runif(1, min = 1, max = 2))
}
Win19
t <- (str_detect(Win19$status, "Lap") | str_detect(Win19$status, "Finished"))%>% as.data.frame()
Win19$status[!t$.] <- "DNF"

Win19 %>% ggplot(aes(x=round, y=position, color = status, fill = Constructor)) + 
  geom_raster(hjust = 0.5, vjust = 0.5) + 
  geom_text(aes(label=Driver),hjust=0.5, vjust=0.5) +
  geom_hline(yintercept=range(5.5), color='black', size=1.5)+
  scale_y_continuous(trans = "reverse",breaks = unique(Win19$position)) +
  scale_x_continuous(breaks = unique(Win19$round)) +
    scale_color_grey(start=0, end=0.95, na.value = "red", labels = c("Finished", "+1 Lap", "+2 Laps", "+3 Laps", "DNF")) +
    scale_fill_manual(values = qb) +
  theme_classic() +
  theme(legend.position = "right",legend.box = "horizontal")
1. 取得前9場各場比賽資料（方法同上，故省略部分code），整理後得到如下方綜合而乾淨的data.frame。（這邊因為要連續scrape資料，所以用一下Sys.sleep給API那邊稍作休息，也可以預防被偵測）
2. 車隊顏色當背景色(fill + raster)、完賽狀態作為文字顏色(color)。在此特將所有未完賽車手統一為紅色DNF（Do not Finished），其餘完賽者差越多圈*Lap顏色越淡，可以看到Williams車隊幾乎都落後一圈以上。
3. 為第5與第6名之間加上水平線（horizontal line）區隔：可以看出前五名幾乎是同樣的五位車手在競爭Hamilton, Bottas, Vettel, Leclerc, Verstappen。


Example 4：排位變化表現（geom_label, transition_states, fps）

沿用前面的賽場資料，並綜合前述技巧，將各場的最終排名（Position / Rank）與起跑排位（Grid）的差距描繪出來，用以觀察車手表現平穩與否。F1DataJunkie書上正巧有提到，直接transform增加排位變化的欄位，與mutate具備相同效果，但僅局限於df內vars之間的運算。
 transform(winners, posdelta = grid - pos, poslapdelta = fastlaprank - pos )

tgrid <- Win19[Win19$grid>=1,] %>% 
  filter(status!="DNF") %>% 
  ggplot(aes(x=round, y=grid - position, label=Driver)) + 
  geom_hline(yintercept=range(-5,5), color='#888888', size=1)+
  geom_hline(yintercept=range(0, 10), color='red4', size=1.25)+
  geom_text(aes(label=Driver),hjust=0.5, vjust=0.5) +
  scale_x_continuous(breaks = unique(Win19$round))+
  labs(y="")+
  geom_label(aes(fill = Constructor, color = Constructor), fontface = "bold") +
  scale_fill_manual(values = qb) +
  scale_color_manual(values = qt) +
  theme_classic() +
  theme(axis.ticks.y = element_blank(),
        plot.title = element_text(hjust = 0.5, face="bold", size=20)) +
  annotate("text", label = "Grid - Rank", x = 5, y = 0, size = 25, colour = "888888", alpha = 0.3)
ttt <- tgrid + 
  transition_states(Driver,
                    transition_length = 0,
                    state_length = 15) +
  ggtitle("{closest_state}" ) +
  ease_aes('quintic-in-out')
animate(ttt, nframes = 100, fps = 2, height=360, width=540)
1. Filter掉DNF和沒參與Qualifying的選手。
2. 建立圖示，採用geom_label來弄出標籤的感覺。
3. 防止字體顏色跟背景色太相近，設定qt來當字體顏色。
qt <- tmp$V3[match(levels(speed$constructor), tmp$V1)]
4. 調整動畫的transition：這邊是用state（因為車手名稱非numeric或時間型態的變數，無法用前面提過的time。）而transition_length是調整車手與車手之間的過渡時間，如果設定轉場為0，就會直接跳下一個state，沒有動點的軌跡。
5. animate中調整frames數量、fps每秒幾幀（越高動越快），還有寬高。

完成後就能清楚看出哪些車手開得特別猛，或哪些人特別穩、都能夠保住位置了。其中Sainz第9場直接挺進超過10個位置！Stroll則是都有力求突破，Magnussen正賽則頻頻被超車。


gallery

除了自己實作玩玩，也要欣賞別人怎麼應用這份API。在網站上有許多作品集可以看，下面列出幾個我覺得很厲害的F1資料視覺化成品！讓人對歷史賽事一目了然。
Labels:

留言

張貼留言

Share Our Blog