Rで解析：B.LEAGUEの選手とクラブの成績詳細の取得例

#必要パッケージの読み込み
#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)