個人的な備忘録でしかないメモ。
Introduction
先日saenai氏が、noteで以下のような記事を公開していた。
note.com
この記事内の最後にも少し触れられている通り、Jにおいてはこの種の詳細なイベントデータはオープンな形で公開されていないのが現状である。
したがって、主たる関心がJリーグにある自分にとっては、すぐに役立つ種の情報ではないのだが、いっぽうでJリーグに関して現在利用可能な情報からは考えられないような幅広い変数を含むデータというのはそれ自体魅力的だ。
あまりStatsbombをRで使うことに関しての日本語記事は多くは見当たらないため、
saenaiさんの記事内容を理解しつつ、同じような処理をRで行うにはどうすればいいのか？ということ*1を書き記しておくのが本記事である。
<参考URL>
Rでも実現したい処理工程の把握・書き出し
まず、saenai氏の記事（およびハンズオン用code）において行われていることを一覧化する。
※URLはsaenai氏作成のハンズオンへのリンク。
- データの取得・整形(URL)
- 大会情報（JSONデータ）の取得・整形
- 試合情報の取得
- ラインナップの取得
- イベントデータの取得
- イベントデータの基礎集計と可視化(URL)
- チーム別集計（例：パス本数）
- 個人別集計（例：タッチ位置平均）
- 時間帯ごとにパス本数を集計 ※本記事では割愛
- イベントデータのピッチ上への可視化(URL)
- 選手ごとのヒートマップの可視化 ※本記事では割愛
- プレッシャーをかけた位置のヒートマップを可視化
- パスの流れの可視化 ※本記事では割愛
- パスマップ図の可視化
- ショットマップの可視化
だいたい、こんなところだろうか。なかなか夢膨らむ内容である。
以下、saenai様のハンズオン内のコードや図表等を参照しつつ、同一の処理をRで実装していく。
データの取得・整形
JSON形式でデータは公開されており(URL)、大まかに分けて
①大会情報データ②試合情報データ③イベントデータ④ラインナップデータ、の4つの種類がある。
JSONデータをラクに扱うために、jsonliteパッケージをインストールしときましょう。
大会情報の取得・整形
以下のような形で、まずは大会情報データを取得したい。
以下のようにjsonlite::read_json()をつかってからJSON形式でまずデータを取得する
compe_url <- "https://raw.githubusercontent.com/statsbomb/open-data/master/data/competitions.json" compe_json <- read_json( compe_url)
read_json()はJSONの階層構造をリストとして取得してくる。
これをデータフレームに変換する。
compe_row_l <- lapply( compe_json , function(rw){ return(as.data.frame( rw , stringsAsFactors =F)) }) compe_df <- do.call( rbind , compe_row_l) head( compe_df,2) # competition_id season_id country_name competition_name # 1 16 4 Europe Champions League # 2 16 1 Europe Champions League # competition_gender season_name match_updated # 1 male 2018/2019 2020-10-25T12:33:27.855343 # 2 male 2017/2018 2020-07-29T05:00 # match_available # 1 2020-10-25T12:33:27.855343 # 2 2020-07-29T05:00
簡単ですね。
試合情報の取得・整形
つぎにcompetitionやseasonのIDをkeyとして、試合情報を取得してくる処理を実装する。
具体的に「試合情報」とは何かというと、大会／シーズン／ホームチーム名／アウェイチーム名／開催地／大会ステージ、などの情報をさしている。
（元データには実は両チームの監督名や、レフェリーの名前などの情報もあるのだが、saenai氏同様に上の項目だけをデータフレーム化する）
saenai神のコードをみると、competitionは必須で、seasonに関しては指定しなければ該当のcompetitionの全seasonをとってくる、という処理（を行う関数）を書いているようなので、そうする。
getMatchData <- function( compe_id , season_id=NULL ,compe_df =NULL ){ ##-- 内部関数, 生JSONデータのURLを生成する---## makeMatchURL <- function( compe_id ,season_id ){ base_url <- "https://raw.githubusercontent.com/statsbomb/open-data/master/data/matches/" ret_url <- paste0( base_url, compe_id, "/", season_id,".json") return( ret_url) } #func ##-- 内部関数, 生JSONデータからデータフレーム形式へ変換する--## fetch_mInfo <- function( match_url){ info_list <- jsonlite::read_json(match_url) info_row_l <- lapply( info_list , function( wc_row){ wc_row$away_team$managers <- wc_row$away_team$managers[[1]] wc_row$home_team$managers <- wc_row$home_team$managers[[1]] var_list <- list() rapply(wc_row , function(wr){ var_list <<- c(var_list ,wr) })# tst_df <- as.data.frame( var_list, stringsAsFactors=F) colnames(tst_df) <- names( unlist( wc_row)) return( tst_df) }) #lapply return(do.call( dplyr::bind_rows , args=info_row_l )) } #fetch_mInfo if( is.null(season_id) && !is.null(compe_df)){ season_ids <- (dplyr::filter( compe_df , competition_id == compe_id ))[,"season_id"] match_df_l <- lapply(season_ids , function( season_id){ target_url <- makeMatchURL(compe_id , season_id) ret_df <- fetch_mInfo(target_url) return(ret_df) }) #lapply match_df <- do.call( dplyr::bind_rows, match_df_l) }else{ target_url <- makeMatchURL( compe_id ,season_id) match_df <- fetch_mInfo(target_url) } return( match_df) } #function
あまり難しいことはやっていないけれど、とりあえずURLを生成する内部関数(makeMatchURL)と
URLから試合情報をdata.frame形式で取得する関数(fetch_mInfo)をつくって、season_idが指定されなかった場合はループ処理をしている、という感じの内容。
たとえばバルサの過去試合を取得するのならば、以下の感じで。
barca_df <- getMatchData( compe_id =11, compe_df=compe_df) dplyr::glimpse(barca_df) # Rows: 485 # Columns: 48 # $ match_id <int> 303421, 303493, 303516, 303680... # $ match_date <chr> "2020-07-19", "2020-06-23", "2... # $ kick_off <chr> "17:00:00.000", "22:00:00.000"... # $ competition.competition_id <int> 11, 11, 11, 11, 11, 11, 11, 11... # $ competition.country_name <chr> "Spain", "Spain", "Spain", "Sp... # $ competition.competition_name <chr> "La Liga", "La Liga", "La Liga... # $ season.season_id <int> 42, 42, 42, 42, 42, 42, 42, 42... # $ season.season_name <chr> "2019/2020", "2019/2020", "201... # $ home_team.home_team_id <int> 206, 217, 209, 901, 217, 207, ... # $ home_team.home_team_name <chr> "Deportivo Alavés", "Barcelona... # $ home_team.home_team_gender <chr> "male", "mal barca_df <- getMatchData( compe_id =11, season_id = 4 , compe_df=compe_df)
ラインナップの取得
次はlineupの取得である。例として16/17シーズンのクラシコ@カンプノウのデータ(URL)から取得してみよう。
取得してくる項目は、saenaiさまの元コードと同じく、選手ID/選手名/背番号/スタメンかどうか/チームID/チーム名、とする。
############------------====lineup情報の取得====---------############ getLineUp <- function( match_id ){ json_url <- paste0("https://raw.githubusercontent.com/statsbomb/open-data/master/data/lineups/",match_id ,".json") json_list <- read_json( json_url) ## 内部関数：各チームの情報をまとめてData Frame化 ## getTeamData <- function( t_list){ t_id <- t_list$team_id t_name <- t_list$team_name player_info <- t_list$lineup player_df_l <- lapply( player_info , function(player_row){ ret_row <- list() rapply( player_row ,function(x){ ret_row <<- c( ret_row , x) #listに順次追加をしていく。 })#rapply ret_names <- gsub( "\\.","_", names(unlist( player_row))) ret_df <- as.data.frame( ret_row, stringsAsFactors=F) colnames(ret_df) <- ret_names return( ret_df) })## lapply player_df <- do.call( dplyr::bind_rows ,args = player_df_l ) player_df$team_id <- t_id player_df$team_name <- t_name player_df <- dplyr::select( player_df , team_id, team_name , player_id:country_name) return( player_df) } #function #Home/Awayそれぞれの情報を処理してタテにつなげる team_df <- do.call( rbind , lapply( json_list , function(team_json){ return( getTeamData(team_json)) })) # return(team_df) } #function #16/17のクラシコのlineupの取得 clsc_df <- getLineUp( 267076) head(clsc_df, 2) # team_id team_name player_id player_name # 1 220 Real Madrid 3163 Mariano Diaz Mejia # 2 220 Real Madrid 4926 Francisco Roman Alarcon Suarez # player_nickname jersey_number country_id country_name # 1 Mariano Diaz 18 64 Dominican Republic # 2 Isco 22 214 Spain
あまり処理自体について説明することはないけれど、一つだけ付言すると、
read_jsonするとnested list形式で取得されるため、これをflatにしてdata.frameにするためにrapply()を使っている。
※「<<-」を使っていてあまり綺麗じゃないんだけど、以下のStack Overflowを参考にした。
stackoverflow.com
unlist()すると、強制的に型変換が行われてしまい、integerがcharacterとかになってしまうのを嫌った形。
R愛してるけど、ここらへんもっと融通利かないかなぁ。
イベントデータの取得
さいごに、同じ試合を対象としてイベントデータ(URL)を整形して取得してみよう。
試合のあらゆる事象が網羅されているので、当たり前だがデータ量がすんごいことになっている。
とりあえずread_json()して、構造を見てみよう。
evnt_url <- "https://raw.githubusercontent.com/statsbomb/open-data/master/data/events/267076.json" evnt_json <- read_json( evnt_url)
イベントの種類を$event$nameでアクセスして集計してみると、以下のようになる
意外とイベントの種類自体は少ないことがわかる。結構見慣れない指標もある
頭を悩ませるのが、イベントの種類によってかなりデータの形式（どういう変数を含むのか）が違ってくること。
だから、すべてのデータをひとつのdata frameで保持しようとせずに
- ID／イベントの種類／時間情報のみを保持する共通テーブル
- 各イベントごとの詳細情報を格納するテーブル
にわけて、情報を格納していくことにしよう。
まず、以下のような関数を実装する。
############------------====Event情報の取得====---------############ getEventInfo <- function( match_id){ evnt_url <- paste0("https://raw.githubusercontent.com/statsbomb/open-data/master/data/events/", match_id,".json") evnt_json <- read_json( evnt_url) ### 共通DBをつくる ### base_info_l <- lapply( evnt_json, function( evnt_row){ eve_id <- evnt_row$id eve_idx <- evnt_row$index eve_period <- evnt_row$period eve_ts <- evnt_row$timestamp eve_min <- evnt_row$minute eve_sec <- evnt_row$second eve_type_id <- evnt_row$type$id eve_type_name <- evnt_row$type$name eve_row <- data.frame(event_ID=eve_id , Index = eve_idx , Period = eve_period , Minutes = eve_min , Seconds = eve_sec , TimeStamp= eve_ts, Type_ID = eve_type_id , Type_Name=eve_type_name, stringsAsFactors = F) return( eve_row) }) #base_info_l base_df <- do.call( dplyr::bind_rows, args = base_info_l) ### Eventの種類ごとのDFをつくる ### eve_type <- dplyr::distinct( dplyr::select( base_df , Type_Name , Type_ID)) eve_df_l <- list() for( i in seq_along( eve_type$Type_ID)){ #JSONから生成したリストのうち、同じ種類のイベントのものだけ取得する tgt_type <- eve_type$Type_ID[i] tgt_idx <- which( base_df$Type_ID == tgt_type) tgt_evnt <- evnt_json[tgt_idx] #イベントごとのDBを生成する tgt_evnt_l <- lapply( tgt_evnt , function(tgt_row){ ret_row <- list() rapply(tgt_row , function(x){ ret_row <<- c( ret_row, x) }) #rapply ret_row <- as.data.frame( ret_row , stringsAsFactors=F) suppressMessages( colnames( ret_row) <- gsub( "\\.","_", names(unlist(tgt_row )))) return( ret_row) }) #lapply suppressMessages( tgt_evnt_df <- do.call(dplyr::bind_rows, args = tgt_evnt_l) ) colnames( tgt_evnt_df) <- gsub( "\\.\\.\\.","_No",colnames(tgt_evnt_df)) eve_df_l[[gsub(" " , "_" ,eve_type$Type_Name[i] )]] <- tgt_evnt_df }# for ret_list <- list( Base = base_df, Event= eve_df_l) return(ret_list) }#--func
以下のように用いる。
eve_df <- getEventInfo(267076) head(eve_df$Base , 2) # event_ID Index Period Minutes Seconds # 1 29a5ab71-0bda-4291-a084-be14138bbe20 1 1 0 0 # 2 25bdcf3e-3eef-4d06-82a0-60bdae6af6ae 2 1 0 0 # TimeStamp Type_ID Type_Name # 1 00:00:00.000 35 Starting XI # 2 00:00:00.000 35 Starting XI head(eve_df$Event$Pass[,1:20],2) # id index period timestamp minute # 1 ed0d68b9-f420-473b-8cb4-1dbb206ab2ad 5 1 00:00:00.233 0 # 2 adf4c9ad-a749-4f22-883d-1973430e653b 8 1 00:00:03.850 0 # second type_id type_name possession possession_team_id # 1 0 30 Pass 2 220 # 2 3 30 Pass 2 220 # possession_team_name play_pattern_id play_pattern_name team_id # 1 Real Madrid 9 From Kick Off 220 # 2 Real Madrid 9 From Kick Off 220 # team_name player_id player_name position_id position_name # 1 Real Madrid 19677 Karim Benzema 23 Center Forward # 2 Real Madrid 5485 Raphael Varane 3 Right Center Back # location1 # 1 61.0 # 2 40.2
イベントの各項目の値の詳細は公式のドキュメントを参照(URL)。
これでデータの取得処理は実装し終えた（難しいことはやってないけど長かった...）ので、やっとデータの分析・可視化にうつることができる。
イベントデータの基礎集計と可視化
必要なデータが
saenai氏がハンズオンで行っている処理をRで再現してみる。
ここからは、saneai氏とおなじく10/11のカンプノウでのエル・クラシコ（ペップ vs モウリーニョの時代）のデータを使っていく
#対象試合のMatch IDを指定 lu_df <- getLineUp(69299) evnt_df <- getEventInfo(69299)
チーム別集計（例：パス本数）
saenai氏はチームごとに、上のような集計を行っているので、再現してみよう。
公式のdocをみると、以下のようにoutcomeの値の設定がなされている。
"Complete"がねーじゃん..って思うけどこれ以外のパスはすべて成功とみなしてとりあえず扱うこととする。
ということで、上の手順で取得したデータをもとに集計を試みる
pass_info <- evnt_df$Event$Pass pass_info <- dplyr::mutate( pass_info , Pass_Result = as.character(case_when( is.na(pass_outcome_id) ~ "Complete", pass_outcome_id == 9 ~ "Incomplete", pass_outcome_id %in% 74:75 ~ "Out", pass_outcome_id == 76 ~ "Offside", TRUE ~ as.character(NA) ))) pass_info<- dplyr::left_join(pass_info , dplyr::select( lu_df, player_id , TeamName_byP= team_name), by ="player_id") xtabs(~ TeamName_byP + Pass_Result , data = pass_info)
ちゃんとsaenai氏の表と一致している。
個人別集計（例：タッチ位置平均）
StatsBombのデータのウレシイところは、位置情報についても事細かな情報を把捉できる点にもある。
選手ごとのタッチ位置の平均を算出している上のsaenai神の表を再現できるか、試みる。
ハンズオンでは、どのイベントを対象としたのがか書いていないので、location情報が取得できるイベントをすべて対象する
- statsbombのデータは、ピッチで言うとcoordinates_xが縦、coordinates_yが横を示している
- xとyが逆やないとも思うけれど、基本的にピッチをみるときは左右にゴールがある横視点が基本
- またその数字はm単位でなく、0-100に変換されている
とsaenai氏のハンズオンにはあるけれど、こっちの取得したデータだとX座標は0～120 , Y座標は0～80のままであるので、それを変換しなければならない。
ちなみに上記の公式ドキュメントのAppendix 2には、座標系の解説があるけれども、これも特に変換はしていない（なぜだ？）
......結果から話すと悲しいことに数値は合わなかった。
おそらく原因をみるにはpythonのStatsbombパッケージの内部処理まで見る必要があるけど、そこまでやる気力はないので挫折。かなしい。
イベントデータのピッチ上への可視化
これも楽しい作業。
ピッチの描画や座標表現に関してはggsoccerパッケージをつかっていく。
名前から察することができるだろうが、ggplotを利用したパッケージであり、いくつかの代表的なfootballのデータの座標系に対応してピッチを描画することができる
以下のように使う。
gg_pitch1 <- ggplot( data = barca_coord , mapping=aes( x=X2 , y =Y2, label= player_nickname)) + annotate_pitch(fill="darkolivegreen1", dimensions=pitch_statsbomb) + theme_pitch() + geom_point( shape= 18 , fill = "midnightblue") + geom_text_repel( size = 3.5, family = "Meiryo" , color = "firebrick4") + direction_label(x_label=60)
annotate_pitch()でピッチを描画（dimensionに適切な座標系を指定）し、theme_pitch()でいらない軸や目盛りを消している。
direction_labelで攻撃方向を示す。
プレッシャーをかけた位置のヒートマップを可視化
上のような、各チームのプレッシャーの位置分布の可視化を実装する。
ヒートマップを使うにはgeom_tile()が便利である。
◆geom_tile()に関しての参考URL
以下のような処理で、同様のヒートマップを実装できる
#プレッシャー位置の取得 press_df <- evnt_df$Event$Pressure press_Real <- dplyr::filter(press_df,team_name == "Real Madrid") #縦6区画、横5区画への分割 h_sep_l <- lapply( 20* 0:5 , function(x){c( x,x+20)}) w_sep_l <- lapply( 16* 0:4 , function(x){c( x,(x+16))}) numToArea <- function(x , area_l){ ret_v <- c() for( i in seq_along(x)){ x_i <- x[i] if(is.na(x_i)){ ret_v <- c(ret_v , as.numeric(NA)) }else{ cnt <- 0 flag <- FALSE lapply( area_l , function(area){ cnt <<- cnt + 1 if( x_i >= area[1] && x_i < area[2]){ ret_v <<- c( ret_v, cnt) flag <<- TRUE } })# lapply if(!flag){ ret_v <- c(ret_v , as.numeric(NA))} #if } #if }#for return( ret_v) } #func press_Real$Press_AreaX <- numToArea( press_Real$location1 , h_sep_l) press_Real$Press_AreaY <- numToArea( press_Real$location2, w_sep_l) press_Real <- dplyr::mutate( press_Real , Press_AreaXY=interaction( Press_AreaX, Press_AreaY,sep="×")) press_density <- table(press_Real$Press_AreaXY) /sum(table(press_Real$Press_AreaXY)) dense_df <- data.frame( Density = as.numeric(press_density), Area = names( press_density)) xy_coord <- expand.grid( 1:6 , 1:5) xy_coord[,1] <- xy_coord[,1]*20-10 xy_coord[,2] <- xy_coord[,2]*16 -8 dense_df <- cbind( dense_df , xy_coord) colnames( xy_coord) <- paste0( c("X","Y"), "2") press_Real <- dplyr::left_join( press_Real, dense_df , by = c("Press_AreaXY"="Area")) press_Real$Press_Percent <- press_Real$Density * 100 #第一段階:プレス点のみ gg_pressR <- ggplot( data = press_Real , mapping=aes( x = location1 , y=80- location2 )) +annotate_pitch(dimensions=pitch_statsbomb , fill="grey") + theme_pitch() + direction_label(x_label=60) + geom_point( color="white", shape=20 ) + ggtitle( "Pressure Map(Real Madrid @2010/11 El Clasico)") +theme(plot.title = element_text(hjust = 0.5)) #第二段階:ヒートマップ gg_pressR2 <- gg_pressR + geom_tile(data = dense_df , mapping=aes( x= X2 , y =80-Y2, fill=Density*100, width= 20 , height = 16) ,alpha=0.5) + scale_fill_gradientn(colours=c("cyan","brown4"),name="Percentage") +geom_text(data = dense_df , mapping=aes( x= X2 , y =80-Y2 ,label= paste0(round(Density*100 , 1),"%")) )
以下のように、saenai氏と同じような図が可視化できている。
いやー面白い。
パスマップ図の可視化
次は上のようなパスのネットワーク図を描いてみよう。
上の図の完全な再現をめざすではなく、以下のような考え方で簡易的に描いてみる。
- 各ポジションの平均位置は、パスを出すイベント（"Pass"）に含まれている出し手／受け手の位置情報を使って取得する。
- ポジションを表わす点の大きさは、（パスを出した回数＋受けた回数）÷2とする
- ポジション間をつなぐ線は（どちらがパスの出し手／受け手を区別せず）パスのやりとりの総数に比例する
とりあえず、データを可視化しやすいように取得・整形する
lu_df <- getLineUp(69299) evnt_df <- getEventInfo(69299) library( pipeR) pass_df <- evnt_df$Event$Pass rcv_df <- evnt_df$Event[["Ball_Receipt*"]] pass_df$Team_byP <- lu_df[match(pass_df$player_id, lu_df$player_id),"team_name"] position_info <- dplyr::distinct(dplyr::select(pass_df , position_id , position_name ,player_name , player_id,Team_byP )) pass_df$recipient_position <- position_info[ match( pass_df$pass_recipient_id , position_info$player_id), "position_name"] #出し手のポジションを取得する pass_df %>>% dplyr::mutate( completed = if_else( is.na( pass_outcome_name), TRUE , FALSE) ) -> pass_df pass_Real <- dplyr::filter( pass_df, Team_byP == "Real Madrid") pass_Barca <- dplyr::filter( pass_df, Team_byP == "Barcelona") ##座標系の取得 pass_grp_Real <- ( dplyr::group_by( pass_Real, position_name , recipient_position) %>>% dplyr::filter( completed==T, !is.na( position_name), !is.na( position_name))) pass_grp_Real %>>% ( ~ cnt_smr_Real = dplyr::summarise( .,N=n())) %>>% (grp~ cbind(cnt_smr_Real , dplyr::summarise_at(grp ,vars( contains(location) ), mean ) ) ) -> pass_smr_Real cnt_smr_Real <- ( dplyr::summarize( pass_grp_Real, N= n()) %>>% as.data.frame) pos_smr_Real <- (dplyr::summarize_at( pass_grp_Real, vars(contains("location")),mean) %>>% as.data.frame) pass_smr_Real <- dplyr::left_join( cnt_smr_Real , pos_smr_Real , by= c("position_name","recipient_position")) ##出し手としての平均位置／受け手としての平均位置と重みを取得 passer_pos <- ( pass_smr_Real %>>% dplyr::group_by(position_name) %>>% dplyr::summarise( N = sum(N), X = mean(location1), Y = mean(location2) ) %>>% as.data.frame) receiver_pos <- ( pass_smr_Real %>>% dplyr::group_by(recipient_position) %>>% dplyr::summarise( N = sum(N), X = mean(pass_end_location1), Y = mean(pass_end_location2) ) %>>% as.data.frame) colnames(passer_pos) <- paste0("Pass_",colnames(passer_pos) ) colnames(passer_pos)[1] <- "Position" colnames(receiver_pos) <- paste0("Receive_",colnames(receiver_pos) ) colnames(receiver_pos)[1] <- "Position" pos_Real <- dplyr::left_join( passer_pos , receiver_pos , by = "Position") pos_Real <- ( pos_Real %>>% dplyr::mutate( X = (Pass_X * Pass_N + Receive_X* Receive_N) / (Pass_N + Receive_N), Y = (Pass_Y * Pass_N + Receive_Y* Receive_N) / (Pass_N + Receive_N) , Weight = Pass_N + Receive_N) )
以下のような形で、データが取得・整形できている。
さて、あとはこれをggsoccerやggplot2を使ってプロットしていくだけだ。
線分を引くためには、geom_segment()を使う。
pass_smr_Real$from_X <- pos_Real[match( pass_smr_Real$position_name,pos_Real$Position ),"X"] pass_smr_Real$from_Y <- pos_Real[match( pass_smr_Real$position_name,pos_Real$Position ),"Y"] pass_smr_Real$to_X <- pos_Real[match( pass_smr_Real$recipient_position,pos_Real$Position ),"X"] pass_smr_Real$to_Y <- pos_Real[match( pass_smr_Real$recipient_position,pos_Real$Position ),"Y"] ##描画する gg_passNetR <- ggplot( data =pos_Real , mapping=aes( x = X , y=80- Y ,size=Weight * 3/50 )) +annotate_pitch(dimensions=pitch_statsbomb , fill="chartreuse4") + theme_pitch() + direction_label(x_label=60) + geom_point(color="firebrick3", shape=18) + ggtitle( "Pass Network(Real Madrid @2010/11 El Clasico)") +theme(plot.title = element_text(hjust = 0.5)) gg_passNetR2 <- gg_passNetR + geom_segment( data=pass_smr_Real, mapping=aes( x = from_X , y =80- from_Y , xend = to_X , yend = 80- to_Y , size = N *2/3* 0.3 , alpha = N /10 ) , color= "white")+ geom_text_repel(aes(label=Position), size=3.5 , color="yellow",fontface = "bold") +theme(legend.position = 'none')
これで出力されるのが下図である。
いやーめっちゃかっこいいですね。テンションあがりますわ。
シュートの位置分布の可視化
シュートをどの位置から打ったのかを一覧化する。
イメージとしては、Football Labの試合結果ページ（例：名古屋vs湘南）にあるような形でシュートの位置分布を描画したい。
基本的にはFootball LABの図を踏襲するようにして、ゴールのときのみシュートの弾道を赤色にするようにしてみる。
以下のようなシンプルなコードで書ける。
#データ整形 shot_df <- evnt_df$Event$Shot shot_Barca <- dplyr::filter(shot_df , team_name == "Barcelona") (shot_Barca %>>% dplyr::mutate( Shot_Result = if_else( shot_outcome_id ==97 , "Goal",if_else( shot_outcome_id %in% c(96,98,99) , "off-Target","Saved")))) -> shot_Barca #描画 gg_shotB <- ggplot( data = shot_Barca,mapping=aes(x = location1 , y= 80-location2, fill= Shot_Result ,colour = Shot_Result )) +annotate_pitch(dimensions=pitch_statsbomb , fill="olivedrab1") + theme_pitch() + direction_label(x_label=60) + ggtitle( "Shot Map(Barcelona@ 2010/11 El Clasico)")+theme(plot.title = element_text(hjust = 0.5), legend.position="none") + coord_flip(xlim=c(58,121),ylim= c(-12,112)) gg_shotB2 <- gg_shotB +geom_segment( data = shot_Barca , mapping=aes(x= location1 , y =80- location2 , xend = shot_end_location1 , yend = 80- shot_end_location2, colour = Shot_Result),size= 0.7, linejoin="round",lineend="round")+ scale_colour_manual( limits= c("Goal","off-Target", "Saved"), values=c("red2", "grey55","grey55"), name="", guide=F)+ geom_point(color="midnightblue", shape=18,size=2.5)
できあがった図は以下のようなもの。求める形で描画できている。
もうちょっと見栄えは工夫できそうだけどそれは今後の課題である。
Conclusion
とりあえずなぞってみただけど、面白かった。こういう楽しい体験のきっかけとなったsaenai氏の記事に感謝である。
これくらいの粒度のデータでマッシモ名古屋を分析して風間さんの時代との違いとかを分析できたら、超楽しいんだろう。
そういう時代が、来たらいいな。
ヒトリエ『アンチテーゼ・ジャンクガール』MV / HITORIE - Antithesis JunkGirl
Enjoy!!
