はじめに

R Shinyのお勉強もかねて、Jリーグ関連のデータを加工するアプリを作成してみました。
順位の推移グラフはよく見かけるのですが、勝ち点の推移グラフってあまり無いので、無いなら自分で作ってしまえと。ついでに表もJリーグ公式サイトだと使い勝手がイマイチなので自分が見たい感じに表を作ってみました。
大したモノではありませんが、身近なデータ用いたR - Shinyによる加工/可視化の実践例という感じです。
主な機能は以下の通りです。

勝点推移グラフを折れ線グラフで表示
試合の結果/今後のスケジュール表

アプリ、ソースは以下に公開しています。
アプリ: https://tomotagwork.shinyapps.io/JLeagueScheduleResult/
ソース: https://github.com/tomotagwork/RShinyJLeagueScheduleResult
※2023/09/21: 2019-2023年対応版にアップデート

インフラ屋さんのためのR言語: 環境構築編
 オフラインでのR環境構築 on RHEL
z/OSにRを導入してみた
 インフラ屋さんのためのR言語: プログラミング編
 R Markdownによるレポート生成
 R MarkdownのHTMLレポートをブラッシュアップ
 R - ShinyによるWebアプリケーション作成: 基礎編
 R - ShinyによるWebアプリケーション作成: shinydashboard編
 R - ShinyによるWebアプリケーション作成Tips: shinydashboardでの画面遷移制御
 R - ShinyによるWebアプリケーション作成Tips: UIオブジェクトの動的制御
 R - Shinyアプリ/管理サーバーテンプレート
 R - ShinyアプリでJリーグの勝点推移グラフを作成してみた<= 当記事

アプリ概要

勝点推移

X軸に日付(節ではなく！)、Y軸に勝ち点をプロットしてチームごとの折れ線グラフで表示します。

日程/結果表

試合のスケジュールを表形式で表示します。
全チームの一覧と、チーム毎の詳細情報をそれぞれ表示します。
試合実施済みのものは結果を表中に表示し、JLeague Data Siteの各試合の詳細ページに飛べるようにします。

内部実装補足

データ取得

J.LEAGUE DATA SITEというのがあって、ここから各種Jリーグ関連のデータが取得できるようになっています。

ただし！残念ながらJSONとかXMLとかCSVとかで取得できるようにはなっていない！うーん、イケてないなぁ。
しょうがないので、Webスクレイピングして必要なテーブル部分をdata.frameとして取得することにしました。これは、XML::readHTMLTable を使うことで割とすんなりできました。

ここから、以下のリクエストを発行することで、2019年度のJ1の試合結果一覧が表として取得できます。
https://data.j-league.or.jp/SFMS01/search?competition_years=2019&competition_frame_ids=1&tv_relay_station_name=

  targetUrl_game<-"http://data.j-league.or.jp/SFMS01/search?competition_years=2019&competition_frame_ids=1&tv_relay_station_name="
  dfTableOriginal_game <- readHTMLTable(targetUrl_game, header = FALSE, which=1, stringsAsFactors = FALSE)

ちょっと引っかかったのが、表のヘッダー部分です。よくわからないのですが、取り込みたいテーブルのヘッダー部分に日本語が入っているとエラーになってしまうようで、とりあえずheader=FALSEとすることで取り込むことができました。この辺の挙動はちょっとナゾでした。

今回は各試合の詳細情報についてはJLeague Data Siteのページに飛ぶようにしたため、リンク先の情報も取得したかったのですが、上の仕組みだとその辺りのハイパーリンクの情報は省かれてしまいます。そのため、上の仕組みとは別にxml2::read_html, rvest::htmlnodes, rvest::html_attr辺りを用いてリンク先情報だけ別に取得してマージしています。

  data <- read_html(targetUrl_game)
  strURLPrefix <- "https://data.j-league.or.jp"
  listMatchLink <- paste0(strURLPrefix, 
                          html_nodes(data,".al-c") %>% html_nodes("a") %>% html_attr("href"))
  listMatchLink <- c(listMatchLink, rep("", nrow(dfTableMaster)-length(listMatchLink)))
  dfTableMaster$match_link <-listMatchLink

※後から機能を付けたししていく感じで作っているので色々汚いコードになってますが悪しからず...

加工

data.frameに落としたら、加工しやすいように、得点や失点などの情報は個別の列として追加していきます。
それを元に、チーム単位の得点、失点、勝点の累計などを集計していきます。

また、最新の勝点、得失点差、総得点でソートした順位表のテーブルなんかも作ります。

詳細はソースをどうぞ。
server.R

グラフ化

data.frameとして情報がある程度そろったところで、グラフ化します。
グラフ描画にはggplot2というのがよく知られていますが、インタラクティブに操作できるグラフを出したい！と思って色々調べていたら、なんと、ggplot2のオブジェクトをそのままインタラクティブなグラフとして返還してくれるplotly::ggplotlyというのがあるぢゃないですか！素晴らしい！！！
ということで、ggplot2 + plotlyでグラフを出力することにしました。

結果はこんな感じです。

※tips
ggplotは、凡例の順番を制御するのが分かりにくかったです。今回の場合チーム名が凡例として並ぶことになるのですが、これは現在の順位に並べたいですよね。でもデフォルトでは、文字列でソート(あいうえお順)になってしまうっぽい。これを制御するには、colorで凡例用に指定しているデータ(ここではtarget_team列)をfactor型とし、並べたい順番にlevelを指定する、ということすれば制御できました。

  # get team order list
  teamOrder <- dfTeamStandings$target_team

  ...

  # set factor levels for legend order
  dfTeamData_plot$target_team <- factor(dfTeamData_plot$target_team, levels=teamOrder)

ちなみに、チームごとにグラフの線の色を明示指定しているのですが、これは超xxx掲示板のサイトの背景カラーをそのまま採用させて頂きました。
参考: 超サッカー掲示板

表作成

表形式のデータは、DTパッケージのdataTableが使い勝手がよいのでそれを使っています。
参考: DT

一覧

チーム別

ちょっと特殊な機能として、dataTableの以下のようなオプションを使っています。

ハイパーリンクの埋め込み: 「escape=FALSE」指定し、データに<a>タグを埋め込み
検索文字のハイライト: optionsにて「searchHighlight = TRUE」を指定
X軸スクロール(横スクロール): optionsにて「scrollX = TRUE」を指定
X軸スクロール時の列固定: extensionsにて「FixedColumns」を指定し、optionsのfixedColumnsで制御
列幅の制御: optionsのcolumnDefsで制御
列ごとのフィルター: 「filter='top'」を指定

Shiny UIオブジェクト/Serverファンクションの動的制御

上に示したチーム別の表については、tabBoxを使ってチーム別のタブを用意しています。これを18チーム分全部個別に定義するのはかったるいので、動的に各オブジェクトを生成させるようにします(例えばJ2のデータにもこの仕組みを流用しようとすると、チーム数が18⇒22になりますが、そのような場合にも応用がききます)。

UI部分

ui_ResultTeam.R

uiOutput("uiOutput_ResultTeam")

server_ResultTeam.R

output$uiOutput_ResultTeam <- renderUI({
  listTabBoxVal      <- list(id="tabBox_ResultTeam", title="", width = "100%")
  for (i in 1:length(teamList)) {
    targetTeam<-teamList[i]
    listTabBoxVal[[i+3]] <- tabPanel(targetTeam, "",
                                     tags$head(tags$style(type='text/css', paste0('#dataTable_ResultTeam',targetTeam,'{ overflow-x: scroll; }'))),                                   
                                     dataTableOutput(paste0("dataTable_ResultTeam",targetTeam)))
  }

  do.call(tabBox, listTabBoxVal)
  
})

tabBoxに渡す引数として、各タブ情報を渡すので、tabBox関数の引数の数が可変となります。そのため、引数をlistTabBoxValで組み立てて、do.callからtabBox関数を呼び出すようにしています。

なお、各タブにはDTのdataTable出力用のオブジェクトを用意していますが、その名前は「dataTable_ResultTeam<チーム名>」というように末尾にチーム名を付けるようにしています。

Rendering部分

各タブにはそれぞれdataTableを埋め込む想定で、そのdataTableのデータのrenderingのロジックを書く必要がありますが、ここを動的に生成させるのに苦労しました。

ソースとしては以下の箇所です。

server_ResultTeam.R

purrr::iwalk(listTeamData, ~ {
  temp_dataTabelOutputName <- paste0("dataTable_ResultTeam",.y)
  output[[temp_dataTabelOutputName]] <- renderDataTable({
    dfTempTeam <- .x
    dfTempTeam$score <- ifelse(dfTempTeam$score != "vs", 
                               paste0('<a href="', dfTempTeam$match_link, '"target="_blank">', dfTempTeam$score, '</a>'), 
                               dfTempTeam$score)
    dfTempTeam$attendances <- as.numeric(stringr::str_replace(dfTempTeam$attendances, ",", ""))

    dfTempTeam <- dplyr::select(dfTempTeam, section, matchday_org, kickofftime, home, score, away, stadium, attendances, broadcast)
    return(dfTempTeam)
  },server=FALSE,
    rownames=FALSE, 
    escape=FALSE,
    colnames=c("節","試合日", "kickoff", "home","score","away","stadium","入場者数","放送"),
    extensions=c("FixedColumns"),
    filter='top',
    options=list(pageLength = 10,
                 searchHighlight = TRUE,
                 dom = 'lftipr', scrollX = TRUE
    )
  )
  
})

まず、普通に静的にUIオブジェクトに対してrenderingの定義を行う場合であれば、output$dataTable_ResultAll <- renderDataTable({...})のように出力先のUIオブジェクトの名前をoutput$に続けて指定しますが、UIオブジェクトを動的に生成させているのでそこを変数にする必要があります。これは、output[[<変数名>]] <- renderDataTable({...}) でOKでした。

次に、このrenderingの指定を各チームごとに行う部分についてですが、これはpurrrというパッケージのiwalkという関数で実現できました。purrrパッケージは、ListやVectorの各要素に対して関数を適用させるためのものです。

ここの実装は非常に頭を悩ませたところなのですが、以下のサイトが参考になりました。
参考:
Create a dynamic number of UI elements in Shiny with purrr
purrr — ループ処理やapply系関数の決定版

ちなみに"listTeamData"にList型で各チーム別のdata.frameを持たせています。
例えばこんな感じ。

> names(listTeamData)
 [1] "札幌"   "仙台"   "鹿島"   "浦和"   "FC東京" "川崎Ｆ" "横浜FM" "湘南"   "松本"   "清水"   "磐田"   "名古屋"
[13] "Ｇ大阪" "Ｃ大阪" "神戸"   "鳥栖"   "広島"   "大分"  

> str(listTeamData$鹿島)
'data.frame':	34 obs. of  31 variables:
 $ year                      : chr  "2019" "2019" "2019" "2019" ...
 $ competition               : chr  "Ｊ１" "Ｊ１" "Ｊ１" "Ｊ１" ...
 $ section                   : chr  "第１節第２日" "第２節第１日" "第３節第１日" "第４節第１日" ...
 $ matchday_org              : chr  "02/23(土)" "03/01(金)" "03/09(土)" "03/17(日)" ...
 $ kickofftime               : chr  "15:03" "19:03" "16:03" "14:03" ...
 $ home                      : chr  "鹿島" "川崎Ｆ" "鹿島" "札幌" ...
 $ score                     : chr  "1-2" "1-1" "1-0" "1-3" ...
 $ away                      : chr  "大分" "鹿島" "湘南" "鹿島" ...
 $ stadium                   : chr  "カシマ" "等々力" "カシマ" "札幌ド" ...
 $ attendances               : chr  "19,463" "23,927" "16,659" "23,002" ...
 $ broadcast                 : chr  "ＤＡＺＮ／ＮＨＫ大分" "ＤＡＺＮ" "ＤＡＺＮ" "ＤＡＺＮ／ＮＨＫ　ＢＳ１" ...
 $ section_num               : chr  "第１節" "第２節" "第３節" "第４節" ...
 $ matchday                  : POSIXct, format: "2019-02-23" "2019-03-01" "2019-03-09" "2019-03-17" ...
 $ home_score                : num  1 1 1 1 1 2 3 1 2 3 ...
 $ away_score                : num  2 1 0 3 1 1 1 0 1 0 ...
 $ score_diff                : num  -1 0 1 -2 0 1 2 1 1 3 ...
 $ home_point                : num  0 1 3 0 1 3 3 3 3 3 ...
 $ away_point                : num  3 1 0 3 1 0 0 0 0 0 ...
 $ match_link                : chr  "https://data.j-league.or.jp/SFMS02/?match_card_id=21493" "https://data.j-league.or.jp/SFMS02/?match_card_id=21497" "https://data.j-league.or.jp/SFMS02/?match_card_id=21510" "https://data.j-league.or.jp/SFMS02/?match_card_id=21515" ...
 $ target_team               : chr  "鹿島" "鹿島" "鹿島" "鹿島" ...
 $ target_team_HA            : chr  "Home" "Away" "Home" "Away" ...
 $ target_team_Opponent      : chr  "大分" "川崎Ｆ" "湘南" "札幌" ...
 $ target_team_Result        : chr  "●" "△" "〇" "〇" ...
 $ target_team_point         : num  0 1 3 3 1 3 0 3 0 3 ...
 $ target_team_goalfor       : num  1 1 1 3 1 2 1 1 1 3 ...
 $ target_team_goalagainst   : num  2 1 0 1 1 1 3 0 2 0 ...
 $ target_team_matchdetail   : chr  "大分(H)_1●2" "川崎Ｆ(A)_1△1" "湘南(H)_1〇0" "札幌(A)_1〇3" ...
 $ target_team_cumpoint      : num  0 1 4 7 8 11 11 14 14 17 ...
 $ target_team_cumgoalfor    : num  1 2 3 6 7 9 10 11 12 15 ...
 $ target_team_cumgoalagainst: num  2 3 3 4 5 6 9 9 11 11 ...
 $ target_team_cumgoaldiff   : num  -1 -1 0 2 2 3 1 2 1 4 ...

このListの各要素(チーム毎のdata.frame)に対して、output[[xxx]] <- renderDataTable({...})を行っている、ということになります。
(上のコード中の".y"が要素名、つまり、チーム名をあわらし、.xがその要素、つまり、チーム毎のデータが保持されたdata.frameということになります。)

URLハッシュのハンドリング

直接サブメニューを選択した状態で表示させるために、URLハッシュをハンドリングするためのJavaScriptを埋め込みました。
以下のようにURLを指定することで、各メニューを直接表示させることができます。
「勝点推移」画面 => https://tomotagwork.shinyapps.io/JLeagueScheduleResult/#shiny-tab-tab_Point
「日程/結果:一覧」画面 => https://tomotagwork.shinyapps.io/JLeagueScheduleResult/#shiny-tab-tab_ResultAll
「日程/結果:チーム別」画面 => https://tomotagwork.shinyapps.io/JLeagueScheduleResult/#shiny-tab-tab_ResultTeam

詳細は、関連記事およびソースをご参照下さい。
参考:
R - ShinyによるWebアプリケーション作成Tips: shinydashboardでの画面遷移制御
 ui_javaScript.R
ui.R

shinyapps.ioへのデプロイ

作成したアプリは、shinyapps.ioというShinyアプリをホスティングサービスにデプロイしてみました。
自分の環境はWindows上のR Studioを使用しているので、文字コードはデフォルトでSJISベースとなっています。ところが、shinyapp.ioはLinuxベースのようで、UTF-8が前提のようです。
そのため、最初、そのままPublishしたら日本語のコードがうまく解釈できずにアプリがエラーになってしまいました。
iconvで全部UTF-8に変換してからPublishすることでうまく動くようになりました。

おわりに

他にも簡単に可視化しやすいものがあれば適宜追加していくかも。