最近、日本のバスケットボールが面白いことに気が付きました。日本バスケット団体のB.LEAGUEのホームページを見ていたところ、各選手と各クラブの成績詳細のデータが公開されていました。
B.LEAGUE：https://www.bleague.jp/
B.LEAGUEのホームページから「各選手と各クラブの成績詳細のデータの取得」、「取得したデータをエクセルで保存」、「取得したデータから試合数8以上、得点数100以上の選手の3ポイントとフリースローの成功率の散布図の作成」のコマンド例を紹介します。
スクレイピングには「RSelenium」パッケージを使用しています。
さらに日本のバスケットが面白くなるような解析が広がればと思います。
各パッケージバージョンは記事作成時で最新。実行コマンドはwindows 11のR version 4.2.2で確認しています。
実行コマンドの紹介
詳細はコマンド、各パッケージのヘルプを確認してください。
#必要パッケージの読み込み
#RSeleniumパッケージがなければインストール
if(!require("RSelenium", quietly = TRUE)){
install.packages("RSelenium");require("RSelenium")
}
#tidyverseパッケージがなければインストール
if(!require("tidyverse", quietly = TRUE)){
install.packages("tidyverse");require("tidyverse")
}
#openxlsxパッケージがなければインストール
if(!require("openxlsx", quietly = TRUE)){
install.packages("openxlsx");require("openxlsx")
}
#cowplotパッケージがなければインストール
if(!require("cowplot", quietly = TRUE)){
install.packages("cowplot");require("cowplot")
}
#seleniumサーバーを開始する
#初回は必要ファイルをダウンロードするので時間がかかる
StartSel <- rsDriver(browser = "chrome",
chromever = "107.0.5304.62",
verbose = TRUE)
###選手とクラブの成績詳細を取得する#####
#seleniumを準備
SelGet <- StartSel[["client"]]
#取得年を指定
GetYear <- 2022
#選手とクラブの成績詳細のURLを設定
SelGet$navigate(paste0("https://www.bleague.jp/stats/?tab=1&year=",
GetYear,"&target=player-b1&value=AveragePoints"))
#もっと見るボタンを指定
GetMotto <- SelGet$findElement(using = "css", "[class = 'btn']")
#もっと見るボタンの体裁を取得
StyleMotto <- SelGet$findElement(using = "id", "player_b1_more")
#エラー格納変数
GetValue <- ""
#StyleMottoにdisplay: none;が出るまで繰り返し実行
while(!GetValue == "display: none;"){
GetMotto$clickElement()
GetValue <- StyleMotto$getElementAttribute("style")[[1]]
}
#htmlに変換
GetHtml <- XML::htmlParse(SelGet$getPageSource()[[1]])
#テーブル部分を抽出
GetTable <- XML::readHTMLTable(GetHtml, encoding = "utf-8")
#選手の成績詳細を取得する
PlayerData <- tibble(GetTable[["player-b1"]]) %>%
#順位列で"順位"を含む行を除外
filter(!順位 == "順位") %>%
#複数空白を一つに置換する
#mutate("選手" = str_squish(選手)) %>%
#選手列から情報を分割
mutate("選手名" = str_extract(選手, "^[^0-9#]+"),
"背番号" = str_extract(選手, "[#|#\\d]+"),
"ポジション" = str_extract(選手, "[[:alpha:]/[:alpha:]]+$|[[:alpha:]]+$")) %>%
select(順位, 選手名, 背番号, ポジション, everything(), -選手) %>%
mutate_if(is.character, str_trim)
#チームの成績詳細を取得する
ClubB1Data <- tibble(GetTable[["club-b1"]]) %>%
#複数空白を一つに置換する
mutate("クラブ" = str_squish(クラブ)) %>%
#順位列で"順位"を含む行を除外
separate(col = "クラブ",
into = c("クラブ","クラブ略名"),
sep = " ", remove = TRUE)
#選手とチームの成績詳細を作業フォルダにエクセルで出力
#ワークブックの作成:createWorkbコマンド
NewWb <- createWorkbook()
#シートを追加
addWorksheet(wb = NewWb, sheetName = "PlayerData", tabColour = "red")
addWorksheet(wb = NewWb, sheetName = "ClubB1Data", tabColour = "blue")
#データを書き込み
writeData(wb = NewWb, sheet = 1, x = PlayerData)
writeData(wb = NewWb, sheet = 2, x = ClubB1Data)
#xlsxファイルで保存
saveWorkbook(wb = NewWb, file = paste0(GetYear, "_BLeague.xlsx"),
overwrite = TRUE)
#seleniumサーバーを終了
SelGet$close()
StartSel[["server"]]$stop()
###試合数8以上,得点数100以上の選手の3ポイントとフリースローの成功率の散布図を作る#####
#データの整理
PlayerData %>%
select("クラブ", "G", "PTS", "選手名", "3FG%", 'FT%') %>%
rename("Club" = 'クラブ',
"Plyer" = '選手名',
"TFG_Percent" = '3FG%',
"FT_Percent" = 'FT%') %>%
mutate("FT_Percent" = str_replace(FT_Percent, pattern = "%",
replacement=""),
"TFG_Percent" = str_replace(TFG_Percent, pattern = "%",
replacement="")) %>%
mutate("TFG_Percent" = as.integer(TFG_Percent),
"FT_Percent" = as.integer(FT_Percent),
"G" = as.integer(G),
"PTS" = as.integer(PTS)) %>%
filter(G >= 8 & PTS >= 100) -> PlotData
#並べてプロット
ggplot(PlotData, aes(x = TFG_Percent, y = FT_Percent,
col = Club, label = Plyer)) +
geom_text(show.legend = FALSE) +
ggtitle("選手名:試合数8以上,得点数100以上の選手\n3ポイントとフリースローの成功率") +
labs(x = "3Pシュート成功率", y = "フリースロー成功率") -> P1
ggplot(PlotData, aes(x = TFG_Percent, y = FT_Percent,
col = Club, label = Club)) +
geom_text() +
ggtitle("クラブ名:試合数8以上,得点数100以上の選手\n3ポイントとフリースローの成功率") +
labs(x = "3Pシュート成功率", y = "フリースロー成功率") -> P2
#プロット
cowplot::plot_grid(P1, P2, align = "h",
rel_widths = c(1, 1.5),
scale = 0.95)出力例
・試合数8以上,得点数100以上の選手の3ポイントとフリースローの成功率の散布図
少しでも、あなたの解析が楽になりますように！！
