前後半のゴール数/シュート数/ボール支配率を取得する by rvest

Introduction

rvestでスクレイピングするシリーズ。
今回は、以下記事でふれられている、「グランパスは先行逃げ切り特化型」説を検証するためのデータをこしらえていく。
grapo.net

サッカーって、そもそもリードされてから逆転するのが難しい競技ではありますが、こうも極端だと笑ってしまいます。
ハーフタイムでリードされてたら、勝てないどころか勝点0ってアンタ………そりゃきついぜ。
（上記サイトよりラグ氏）

本当にグランパスが他チームと比較して「先行逃げ切り特化型」なのかは、データにもとづく比較に基づいて判断する必要があるだろう
。

rvestでのスクレイピングに関する、基本的な解説はコチラ↓
ronri-rukeichi.hatenablog.com

どのページからとってくるか

前後半のscoreだけ取得するのであれば、Jリーグ公式記録ページ（例：湘南vs浦和）が手っ取り早い。
一覧ページもおあつらえ向きにあるので、一覧のリンクを取得するのもアホほど楽なのである。

しかし、シュート数を取得するとなると、話はかわってくる。
フットボールラボ*1の試合結果ページ（例：2019年の札幌vs清水）をみると、
得点の時間帯だけでなく、シュート、さらにはポゼッション率についても15分の粒度で得ることができる。

これをとりにいくのが、のちのちの利用機会を考えてもよいだろう。

データ取得の方法：得点編

場合わけ（得点をとってない場合もあるよねという話）

点数に関して、以下のようなテーブルをスクレイピング対象として、時間帯別の得点を取得してくるわけだが、

サッカーにおいてそこまで珍しくないスコアレスドローの試合（例：札幌vs 名古屋）においては、このテーブル自体がなくなる。
ので、デバッグ用のケースとして、以下のみっつの種類のURLを用意しておくのがよいだろう。

1. 無得点
2. いずれかのチームのみが得点
3. Home/Away両方のチームが得点

上の得点テーブルはcssセレクターでいえば".tblCompare+.lineTbl table"*2によって取得することができる。

そして、上のセレクタで取得できる要素数が1であれば得点の入った試合、0であればスコアレスな試合、といった形で場合わけができる。

データ取得to整形

目標のテーブルが取得できたら、以下のような関数をかけばサクっとお目当てのデータがとれる

#####-------===[内部関数：Score tableから前後半/分/Home or Away、を取得する]===-------#####
#[1], tbl : スコア表のテーブル
scoreTimeTbl <- function(tbl){
  
  min_HorA <- function(chr){
    c_n <- nchar(chr)
    half <- substr( chr ,1, 2 ) #前後半のいずれかを判別するための文字列
    min_chr <- substr( chr , 3 , c_n - 1)
    ret_c <- c( half, min_chr)
    names( ret_c) <- c("Half","Minutes")
    return(ret_c)
  }# function
  
  ##--- データフレーム形式に変換する---##
  score_df <- as.data.frame(do.call( what = rbind , args=lapply(tbl[,3], min_HorA )))
  score_df$Half <- factor( score_df$Half , levels=c("前半","後半"))
  score_df$Minutes <-  as.numeric( as.character(score_df$Minutes))
  
  ##--- Home / Awayの変数をつくる---##
  home_idx <-which( tbl[,1] != "")
  away_idx <-which( tbl[,5] != "")
  h_a <-  factor( rep( NA, nrow( tbl)) ,levels=c("Home", "Away"))
  h_a[home_idx] <- "Home"
  h_a[away_idx] <- "Away"
  score_df$HorA <- h_a
  
  return( score_df)
} #function


#####-------===[内部関数：scoreTimeTblの戻り値を前後半のスコアに変換]===-------#####
getHalfScore <- function(score_df){
  df_1st <- dplyr::filter( score_df , Half == "前半")
  df_2nd <- dplyr::filter( score_df , Half == "後半")
  
  #結局欲しいのは、前後半のゴール数/被ゴール数、という形式になってくるといえる。
  goal_h_1st <- length(which( df_1st$HorA == "Home"))
  goal_a_1st <- length(which( df_1st$HorA == "Away"))
  goal_h_2nd <- length(which( df_2nd$HorA == "Home"))
  goal_a_2nd <- length(which( df_2nd$HorA == "Away"))
  
  #どっちが先制したかを判定し、変数として追加する
  goal_first_h <-  ifelse( score_df[1,"HorA" ] == "Home", 1 , 0 )
  goal_first_a <-  ifelse( score_df[1,"HorA" ] == "Away", 1 , 0 )
  
  # 戻り値としてdata frame形式に変換する
  rdf <-  data.frame( Goal_For_1st = c(goal_h_1st , goal_a_1st ), Goal_Against_1st = c( goal_a_1st , goal_h_1st), Goal_For_2nd = c( goal_h_2nd , goal_a_2nd), Goal_Against_2nd = c( goal_a_2nd , goal_h_2nd), Goal_First = c( goal_first_h, goal_first_a))
  rownames( rdf) <- c("Home","Away")
  return( rdf)
} #function

使い方は以下の通り。

scr_page <-    read_html( "https://www.football-lab.jp/sapp/report/?year=2019&month=03&date=09")
st_df <-  getScoreTbl(scr_page)

st_df
# Goal_For_1st Goal_Against_1st Goal_For_2nd Goal_Against_2nd Goal_First
# Home            2                1            3                1          1
# Away            1                2            1                3          0

また、ここから、先制したかorされたかという変数も作成することができる。

時間帯別のポゼッション/シュート数を取得する

時間帯別のシュート/ポゼッションもfootball labのページでは15分刻みで記載されている。

これらの情報も、以下の方法で取得できる。

Possessionを取得する

cssセレクタ的には、".homePoss em"や".awayPoss em"で、ポゼッションの情報にアクセスする。
以下のような関数を用意する。

getPossession <- function( gpage ){
  
  ##--- Home --- ##
  hm_ps_l <-  html_nodes(gpage, css= ".homePoss em") #タグで取得
  hm_ps_v <-  sapply( hm_ps_l  , function( ps_node){
    pos_txt <- html_text( ps_node) #XX%
    pos_n <- nchar( pos_txt)
    return( as.numeric( substr( pos_txt , 1, pos_n- 1)))
  }) #sapply
  
  
  ##--- Away --- ##
  aw_ps_l <-  html_nodes(gpage, css= ".awayPoss em") #タグで取得
  aw_ps_v <-  sapply( aw_ps_l  , function( ps_node){
  pos_txt <- html_text( ps_node) #XX%
  pos_n <- nchar( pos_txt)
  return( as.numeric( substr( pos_txt , 1, pos_n- 1)))
  }) #sapply
  
  return( list(Home = hm_ps_v ,  Away = aw_ps_v))
} #Function

つかった結果はこちら、

> getPossession( scr_page)
# $Home
# [1] 42.4 42.8 50.5 50.0 45.8 65.6
# $Away
# [1] 57.6 57.2 49.5 50.0 54.2 34.4

ポゼッションも時間帯別に取得できている。

シュート数

シュート数も上と同じ要領で時間帯別に取得できる。
cssセレクタに"td.homeShot"/"td.awayShot"を指定し、imgタグあるいはspanタグを幾つ含んでいるのか..
という感じでみていけばいい。

Conclusion

これで、時間帯別の各データがそろった。
次の記事で実際の分析を行いたいが、その前に差分を取得するプログラムを実装しなくては。

Astral Chain OP(オープニングテーマ)Savior Full Version

Enjoy!!

*1:前回記事で書いた通り、個人ブログでのデータ利用に関しては許容されている

*2:tblCompareクラスに隣接したlineTblクラスの子孫階層にあるtableタグ、を取りに行っている

Jリーグをデータから分析する準備

猫背、なかなか直らんすな....

Introduction

サッカーをデータ面から楽しもうという一般peopleのためにFootball Labという神サイトがある。その利用規約には、

なお、個人の方のブログやSNSアカウントでは、引用元を明記していただければFootball LAB内のデータやキャプチャをお使いいただけます。

とあり、個人利用については許容されているので、われわれfootballファンが「データによりfootballを楽しむ」ためのプラットフォームを提供してくれているといえる。

しかし、データを引っこ抜いて分析可能にするのがなかなかに骨なのが、こういうデータ分析に共通する課題なので、
そこの部分をHadley神のつくりたもうたrvest+selectorGadgetを使って、楽にできないかと企てる。

参考URL

1. rvestのreference
2. SelectorGadget(chromeの拡張機能)

Scrapingの流れ

使うソフトなりライブラリなりによって細かい技術的プロセスはかわってくるだろうが、だいたいscrapingは以下のような流れによってなされる。

1. 対象ページへのアクセス
2. ページ内の対象ノードへのアクセス
3. 生データの取得
4. データの整形

んでもって、たいていの場合は複数のページからデータを引き抜きたいので*1、
対象ページを走査するためのルールのロジックをかく必要がある。
また、対象ページからどの情報を引き抜いていくか、という点にも人間がロジックを指定しなければならない（ここを省力化するのに役立つのがSelectorGadget）。

つまり

1. 走査ロジック
2. データ取得ロジック

の2つが、人間のアタマで考えなくてはならない部分である、といえよう。

欲しいデータの要件の定義

データ要件の定義が大事な理由

とりあえずできるテクノロジーが手元にあるから、すぐにコードを書き始めてしまうのはだいたい悪手であることが多い。
まず着手すべきは、欲しいデータの完成形を定義することである。

もっといえば、データは分析のために作るものだから、分析の目的が定まっていないのであれば、そこからしっかりと言葉で定義しておいたほうがいい。

• 検証したい仮説
• 比較したい対象
• どういった規則性が見出されるとウレシイか

といったことが、自分のアタマの中で（さらに望ましくは言語媒体にoutputされたカタチで）定義されている
ここで、「規則性を見つける」っていうのは、要するに混沌と生起しているグラウンド上の事象に対する漸近模型であるデータの中に
一定のルールを見出すことが、事象=footballの理解につながる、ということである。

Dr.STONEの名言を引用すれば

「科学ではわからないこともある」じゃねえ、
"わからねえことにルールを探す"、そのクッソ地道な努力を科学って呼んでるだけだ……!!

ってことである。

話がそれたが、要するに分析の目的に合致した形でデータを引っこ抜いてこないと意味ない（少なくともムダが多い）よね、って話でした。

データの要件の定義@Football Lab

ということで、実際につくりたいデータの構造をきめていく
具体的には

• 分析単位(cases)
• データに含む変数(variables)

を何にするのか、という点を決めていくのである。
ここで、変数としては独立変数/従属変数が何になるのか、ということをイメージできているとよい。

まず従属変数についてだが、わたしが特に関心があるのは、
「どういった場合にグランパスは多くチャンスを生み出しているか」「どういった場合に多くチャンスをつくられているか」という2点につきる。

独立変数については、そこまで決め打ちしたいような仮説があるわけではないが、ぼやっとした言葉でいえば

• こちらの選手として誰が出ているか
• 相手のチームがどういった特徴をもつか

といった点は重視したい。

こういった条件から、ひとまず分析単位は「X節のチームY」になる、といえる。
つまり、ID的な変数としては「クラブ」「節」をとることになるだろう。

「こちらの選手として誰がでているか」に関しては、試合ページ（例：名古屋vs神戸）を参照すればよい。
「相手のチームがどういった特徴をもつか」については、

rvestの使用手順を簡単におさらい

rvestはマジで使い方がシンプル*2なので、わざわざ解説するようなこともないのだが、一応おさらいしとく。

基本的な使い方

だいたい、以下のような流れで使うと考えて、さしつかえない。

1. read_html()を使って、URLにアクセス
2. html_nodes()にCSSセレクタ等を指定して、必要なノードにアクセス
3. html_text()やhtml_attr()などを使って、必要なテキストをとってくる
4. (あるいは手順2-3の代わりにhtml_table()を使って直接tableをdata frameとして読み込む）
5. 取得した情報を、Rで使いやすいような形式に変換する

実行例

①football labのtopページから、各チームのページのURLをとってくる

library(rvest)
top_p  <- read_html("https://www.football-lab.jp/")
club_nodes <- html_nodes(top_p , css="#teamMenu span")
club_nodes <- club_nodes[c(4:61)]

team_name <- c()
team_alp <- c()

for( i in 1:58){
  team_name <- c(team_name , html_text( html_node(club_nodes[[i]],"span")))
  alp <- html_attr(club_nodes[[i]] , "href")
  alp_n <- nchar(alp)
  team_alp <- c( team_alp , substr( alp ,2 , alp_n-1 ))
}#

jclub_names <- data.frame( JP = team_name, ALPH =team_alp)
head( jclub_names)

#   JP ALPH
# 1   札幌 sapp
# 2   仙台 send
# 3   鹿島 kasm
# 4   浦和 uraw
# 5     柏 kasw
# 6 FC東京 fctk

二行目、html_nodes()におけるCSSセレクタの指定部分においてSelectorGadgetを使ってラクをしている。

② 選手データ(例：チョンソンリョンの2019年）から、出場記録をぶっこぬいてくる

gk_page <- read_html("https://www.football-lab.jp/player/605028/?year=2019")
gk_tbl <- html_table( (html_nodes( gk_page , css="#plLog"))[[1]], fill=TRUE)
gk_tbl <- gk_tbl[-1, ]

head( gk_tbl)

# 節 開催日   相手 スコア   出場時間 Pos. ゴール アシスト    セーブP パスCBP 奪取P
# 2  1   2/23 FC東京    0-0 H       90   GK      0        0 NA    0.09    0.27  0.15
# 3  2    3/1   鹿島    1-1 H       90   GK      0        0 NA    0.00    0.12  0.99
# 4  3   3/10 横浜FM    2-2 A       90   GK      0        0 NA    0.19    0.32  1.39
# 守備P チーム
# 2  0.34 川崎Ｆ
# 3  2.19 川崎Ｆ
# 4  1.83 川崎Ｆ

fill=Tで、中身がない場合にNAで埋められる。

データをとっていく（クラブ編）

本節においては、各ゲームにおける各クラブの主要指標を取得（し、データフレーム形式にまとめる）ためのコードを実装していく。

走査ルール編

まず、必要情報を含むページのURLを適切にとるための関数をつくる

引数として「節」「西暦」「チーム名の略称」をとり、戻り値としてURLを返すような関数を考える。

get_gURL <- function( mday = 1, team ="sapp",year = 2020){
  #---Target URLをつくる---#
  tgt_url <- paste0("https://www.football-lab.jp/", team,"/match/?year=", year )
  t_page <- read_html(tgt_url)
  match_links <- html_nodes( t_page , "table em+a") #emタグに隣接するaタグだけ取得してくる
  print(paste("取得可能な試合数＝", length(match_links)))
  tgt_links <- match_links[mday]
  
  ret_links <- sapply(tgt_links , function(mnode){
    link_text <-  html_attr( mnode, "href")
    if(! substr(link_text ,1 , 1) == "h"){
      link_text <- paste0("https://www.football-lab.jp" , link_text) #full URL に変換する
    }
    return( link_text)
  }) #sapply
    return( ret_links)
} #func

# 2019年, 23節, 札幌の試合をとってくる
sapp_url <- get_gURL( mday  = 23  , year = 2019 , team="sapp")
# >sapp_url
# [1] "https://www.football-lab.jp/sapp/report/?year=2019&month=08&date=17"

お目当てのURLが取得できている。

データ取得編①：基本情報編

index（節、クラブ）を指定すれば、必要情報をとってくるような関数をつくる。
例として、20/9/23に行われたG大阪vs名古屋の試合情報ページからデータをとってくるとしよう。

欲しい情報は大きくわけて3つのエリアにわかれて記載されている。
①出場選手に関する情報...ページ上部「メンバー」のエリアに記載
②チャンスビルディングポイントに関する情報...ページ中部「チャンスビルディングポイント」のエリアに記載
③その他スタッツに関する情報...ページ下部「スタッツ」のエリアに記載

これらの情報を取得してくるには、html_text()やhtml_table()をつかう。

上記情報を具体的に取得してくるコードはあえて書かないが、
たとえば、J1の順位表をJリーグ公式から取得してくるには、以下のようなコードをかけばよい。

#URL読み込み
j1std_page <- read_html("https://www.jleague.jp/standings/j1/")
#CSSセレクタによる要素の取得
j1std_node <-  (html_nodes(j1std_page ,css = "table.scoreTable01.J1table"))[[1]]
j1std_tbl <- html_table( j1std_node , fill=T , header=T)

head( j1std_tbl,3)
# 順位                         クラブ名 勝点 試合数 勝 分 負 得点 失点 得失点
# 1 NA    1 川崎フロンターレ川崎フロンターレ   53     20 17  2  1   59   18     41
# 2 NA    2         セレッソ大阪セレッソ大阪   42     20 13  3  4   30   20     10
# 3 NA    3                 ＦＣ東京ＦＣ東京   38     21 11  5  5   35   27      8
# 直近5試合
# 1        NA
# 2        NA
# 3        NA

この要領で、必要情報を取得していく。

上記のテーブル群をさらっていくことで、ひとまず20/9/27時点で取得可能な情報をさらうことができた。

データ取得編②：AGI/KAGIなどを取りに行く

Football Labの魅力として、多くの独自指標がある*3。
そのなかのAGI/KAGI（参考：AGI/KGIについての解説）は、サマリーページのほうにしかない。

したがってAGI/KAGIのデータをとりにいくためには、わざわざサマリーページを訪問していくしかない。
たとえば、大分トリニータの、2020年についてのAGI/KAGIをサマリページからとってくるには、以下のような関数をかくといい。

#[1], url : summary pageのURL
smr_tbl_get <- function(url){
    smr_page <- read_html( url)
    tbl_node <- html_table((html_nodes( smr_page, css="table.statsTbl10"))[[1]], fill=T)[-1,]
    colnames(tbl_node) <- c("MatchDay", "Date", "Youbi","Opponent", "Score", "HorA", "Stadium", "Audience","Tenki", "AGI","KAGI", "Chance_Rate","Shot","Shot_Rate","Possesion","Offense_CBP","Pass_CBP","Steal_CBP","Deffense_CBP", "Scorer","Manager")
    
    ###----AGI/KAGIをnumeric化する---###
    tbl_node$AGI <- as.numeric(tbl_node$AGI)
    tbl_node$KAGI <- as.numeric(tbl_node$KAGI)
    
    ###---得点/失点の情報取得----###
    score_l <-  lapply( tbl_node$Score , function(scr){
      scr_c  <- (strsplit( scr , "-"))[[1]]
      if( length(scr_c) == 0 ){
        return( c( NA , NA ))
      }else{
        return( as.numeric(scr_c)) #
      } #if
    }) #lapply

    score_mat <-  do.call( what = rbind, args = score_l)
    score_df <- as.data.frame( score_mat) #for
    colnames( score_df) <- c("Goal_For", "Goal_Against")
    
    ####---必要な部分だけ選んで、戻り値する---####
    stat_df <-  cbind( dplyr::select(  tbl_node , MatchDay , Opponent , HorA , AGI, KAGI) , score_df) 
    return( stat_df)
} #get_url

#実際にはこうやって使う
oita_smr <- smr_tbl_get( "https://www.football-lab.jp/oita/match/")
head( oita_smr, 4)
# MatchDay Opponent HorA AGI KAGI Goal_For Goal_Against
# 2        1   Ｃ大阪    A  52   58        0            1
# 3        2     鳥栖    H  36   58        2            0
# 4        3     広島    A  40   46        2            1
# 5        4     神戸    H  33   60        1            1

Conclusion

だいたいの分析用の基盤はできたので満足。
次の課題は、①差分取得のProgram②前後半など時間帯をわけたデータの整備、かな。

野猿 / Fish Fight!

Enjoy!!

*1:対象が1ページだったらコピペのほうが早いよね

*2:referenceをみても、そもそも関数の数自体がめちゃ少ない

*3:おそらく機械学習や統計学にまつわる諸知識を動員して、つくったんだろうけど

最近印象に残った言葉 part2

うぐひすに　人は落ち目が　大事かな

久保田万太郎

黒澤は少し黙り、そのまま車を走らせていたが、やがて、
「罪は引力みたいなものだ、と書いてあったな」とぼそりと言った。
「罪が引力？どういうことだ」
「地上にあるものは罪から逃れられない。罪をゼロにはできない、生きてれば誰だって罪がある、という意味かもしれない。 　
生きてれば誰だって罪がある、という意味かもしれない。罪のない人間なんてありえない 」

（伊坂幸太郎, 2017, 「ホワイトラビット」新潮社、p.257）

ホワイトラビット（新潮文庫）

「科学ではわからないこともある」じゃねぇ
わからねえことにルールを探す　そのクッソ地道な努力を科学と呼んでるだけだ

（稲垣理一郎/Boichi『Dr. Stone』、第1巻）

Dr.STONE 1 (ジャンプコミックスDIGITAL)

まず始めに、本書にオリジナルな要素はない。
私自身の独創に由来するアイディアは皆無である。
私は、多くの研究史料を吟味し、そこに内在する法則を発見し、それをどの程度まで展開することができるかを試みたにすぎない。
創造的側面があるとすれば、全体性のあるまとまりのある構造としてこの形態を見定め、数々の点と点と結んだところにある。

（Scott , James C. 2009=2013『ゾミア：脱国家の世界史』みすず書房、p.xi）

ゾミア―― 脱国家の世界史

「普通なら芸術に必要なのは感性とか感覚だと考えますよね。 でも、僕は圧倒的な計算力だと思います。
音楽なら、どういう風に曲を始めるか、どう展開させるか、そろそろ聴く人が飽きてくるタイミングでどう終わらせるか。
それは計算して先を見越していないとできません。」
「「天才とは論理的なものである」という言葉が、彼にはぴったりくる気がします。
非常に派手な技を使っているように見えて、ひとつひとつ論理的な思考で成り立っているんです」

(スポーツグラフィック　ナンバー　vol.1010, p.23, 佐藤天彦九段の発言)

Number(ナンバー)1010号［雑誌］

小津を見たまえ。 あいつは確かに底抜けの阿呆ではあるが、腰が据わっている。
腰の据わっていない秀才よりも、腰の座っている阿呆のほうが、結局は人生を有意義に過ごすものだよ。

（森見登美彦『四畳半神話体系』）

四畳半神話大系 (角川文庫)

川上「いまは、やっぱり、分業がよくないなって思ってるんですよね。
分業しないで、物事を設計するひとが生まれるにはどうしたらいいんだろう」

岩田「私は別に、分業したら人が育たなくなるかというと、そんなことはないと思うんです。
私が思うに、成長する人っていうのは、「自分の担当領域部分以外にどれくらいの野次馬根性と興味があるのか」って部分が結構重要な気がしていまして」
...（中略） ...
岩田「もっと言えば、「人が変わっていく」ということの重要な構成要素として、野次馬根性ーーすなわち「好奇心」っていうものが、すごく重要な要素になっているなと、よく思うんです。」

（任天堂・岩田氏をゲストに送る「ゲーマーはもっと経営者を目指すべき！」最終回――経営とは「コトとヒト」の両方について考える「最適化ゲーム」より）

川上「宮崎駿さんなんかは、「こういうシーンがあったらいいな」っていうものを、まずイメージボードにどんどん書いていくらしいんですね。

とにかく「素敵だな」ってシーンをたくさん書いて、そのあとで、その間を繋げていくストーリーを作るっていう。宮崎さんは、そういう作り方をしているみたいなんです」
岩田「見せたいものが先にあって，その見せたいシーンを作るために、「後から文脈を作りあげていく」みたいな作り方をされているってことですよね。」

...(中略)...

岩田「宮本さんのゲームのつくり方は、ストーリーや設定からは入らないですね。
一番最初は、それこそ記号のようなものが動いて、その手触り感や遊びの構造みたいなものを部分を作りこむんですよ。

で、あとからキャラクターだったり、世界とかを貼りつけてゲームにしていきます。

まさに、まず「見せたいもの」や「提示したい遊び」を作って、「この構造は面白い、これは勝算がある」って、例えば宮本さんが思う。
そうしたら、「じゃあこれはゼルダでやろうか、マリオでやろうか」みたいな話をするんです」
...(中略)...
岩田「宮本さんはもともとインダストリアルデザイナーですから、エンジニアリングとアートの中間にいるような人なんですよね。
で、ゲーム作りっていうのは、まさにアートとエンジニアリング、両方の素養が必要な仕事で、

宮本さんの場合は、まずは機能面から作りこんで、デザインはその機能にあったものを後で作るんです。
で、「ストーリーや設定は最初に作らない」っていうのが、宮本さんや、その弟子にあたる人たちの作り方なんです」

川上「いや、ものづくり全般において、それが正しいやり方だと思うんですよね。
ドワンゴも、新しいサイトのデザイン案とか、新サービスの提案とかが、企画書で来るんですけど、本当につまらないが多いわけですよ。

つまらない確率が高すぎてそれはなぜだろうって考えると、たぶん先に「表現したいもの」があるんじゃなくて、理屈で案を作ってるからだと思うんですよね」

岩田「「要件定義はなんですか？」みたいなね。
でも、その意味でも、やっぱり「見せたいものがある」というのは強いんですよ。だって、それを軸にモノを考えられますし」

www.4gamer.net

【備忘】逆引きXLConnect

Introduction

意外と色々やれるXLConnect、すごいぞXLConnect。

でもちょっと仕組みがわかりにくくて、初見さんに優しくない感じなので
色々な用途別で、こう書けばいいのよっていうのを備忘

<参考URL>

1. vignettes
2. reference
3. RでExcelファイルの読み込み・編集・出力 (XLConnect) - Qiita

セルの背景色をつける

createCellStyle(cellStyleの初期化)→setFillgroundColor(色の指定) →setFillPattern(色の塗り方の指定)→setCellStyle（cell styleの適用）
といった順番

cst1 <- XLConnect::createCellStyle(wb3)
XLConnect::setFillForegroundColor(cst1 , XLC$COLOR.SKY_BLUE)
XLConnect::setFillPattern(cst1, fill = XLC$FILL.SOLID_FOREGROUND) #だいたいこれでいい。
XLConnect::setCellStyle(wb3 , sheet="TestSheet", row = 1 , col = 1, cellstyle = cst1)

※ちなみに文字色を簡単に変える方法はXLConnectにはないようだ。残念。あらかじめExcel側で設定しておくしかない。

セルを結合する

mergeCells()を使う。referenceにセル参照を入れる

XLConnect::mergeCells(wb3, sheet = "TestSheet", reference = "A2:A3")

セルの罫線を設定する

setBorder()をつかう。
全体の流れとしては、createCellStyle()→setBorder()→setCellStyle()という流れ。
第二引数(side)にはbottom/top/left/right/allを指定。
typeには罫線のタイプを、colorには罫線の色を指定

#セルの上側を破線赤線、下側を実線黒線にする。
cst2 <- XLConnect::createCellStyle(wb3)
XLConnect::setBorder(cst2 , side= c("top","bottom"),color=c(XLC$COLOR.RED ,XLC$COLOR.BLACK), type=c(XLC$BORDER.DOTTED , XLC$BORDER.THIN))
XLConnect::setCellStyle( wb3 , sheet="NS2", row=7 , col=2 , cellstyle = cst2)

↓実行結果

オートフィルタを設定する

setAutofilter()を使う。sheetにシート名orインデックスを、referenceにセル参照を指定

XLConnect::setAutoFilter( wb3 , "NS2", "B1:C1")

↓実行結果

Conclusion

setなんちゃら系に戻り値がないのが、Rの文法に慣れていると少し気持ち悪いね。

BLUE ENCOUNT 『バッドパラドックス』Music Video【日本テレビ系土曜ドラマ「ボイス 110緊急指令室」主題歌】

Enjoy!

XLConnectでハマったこと備忘

Introduction

VBAも一応かけるけど、あまり言語的な仕様が好きでない*1ので、なるべくRから制御することでVBAを書かずにすませたいという欲求がある。

RからExcelを利用する際に使えるパッケージはいくつかある（参考：RでExcelのデータを読む方法）がXLConnectを使っていく。
単なるデータの書き込みだけでなく、書式の設定等にも使える。
（openxlsxはなぜか文字化け*2の問題が解決できなかった）

Java依存なのもあり、別のアプリケーション制御をする系ライブラリ特有のわかりにくさもあり、ハマったことがあったのでいくつか備忘。

参考URL

• reference
• vignettes
• RでExcelファイルの読み込み・編集・出力 (XLConnect) - Qiita

罠①：日本語を含んだfile pathが指定できない

XLConnectにおいては、ファイルの読み書きをするさいにその対象となるpathに日本語が含まれていると、Error(FileNotFoundException)が吐かれてしまう。
はじめは、文字コードの問題なのだと思っていたが、pathの文字コードを変換して渡してもずっとErrorが吐かれ続けるので、頭を抱えた。
まぁ全て英語のディレクトリ・ファイル名のものだけ対象にしてプログラムを使えばいいじゃん、っていう考え方もあるが、やはり使い勝手が悪い。

何か助けになる情報がないかとさまよい出たネットの情報の海で、「readrパッケージがWindows上だと日本語のパスを読めない問題の現状 - Technically, technophobic.」という記事を発見し、tmpfileを作成してそこにリンクを貼る、という方法でこのErrorを回避できることを発見した。

具体的には、以下のようなやり方によって回避する

#Errorが出る方法
test_dir <- "C:/Users/usr1/デスクトップ/test.xlsx" #日本語を含む
wb <- XLConnect::loadWorkbook(filename = test_dir) #読み込み →エラーが出る

#回避方法
tmp <- tempfile(fileext=".xlsx") #一時fileの作成
file.link(test_dir, tmp)  #一時ファイルにリンクを貼る
wb <- XLConnect::loadWorkbook(filename =tmp) #これならErrorが出ない！

※Rでのtempfile, tempdirの扱い方は以下の記事に詳しい。
qiita.com

罠②：値だけ書き込むためには、事前にsetStyleAction()での指定が必要

主にRからデータをExcelファイルに書き込むときには、writeWorksheet()関数を使う。
しかし単純にこの関数を使ってしまうと、セルその枠線に設定されていた書式はすべてclearされてしまう。

こういった仕様は、たとえばすでに表の見た目や体裁のstyleはExcelのほうでテンプレートとして整えてあって、XLConnectに求めているのは値をそこに入れるということだけ、といったケースで邪魔になる。

このような状態を回避するには、setStyleAction()関数を事前に使っておく必要がある。
setStyleAction-methods function | R Documentation

この関数の引数のtypeに、予め用意されているstyle actionの種類の指定定数のうち、XLC$"STYLE_ACTION.NONE"を使う。
上記URLには、このtypeについて以下のような説明がなされている

XLC$"STYLE_ACTION.NONE":
This style action instructs XLConnect to apply no cell styles when writing data. Cell styles are kept as they are. This is useful in a scenario where all styling is predefined in an Excel template which is then only filled with data.

下線部にあるように、styleはすでにExcel側で設定していて、データはあと入れるだけになっているとき（XLConnect側でStyleを設定する必要がないとき）これを使う。
以下のように使う。

#セルの書式はそのままにデータだけ入れるようにするよう指定
XLConnect::setStyleAction(wb, type=XLC$STYLE_ACTION.NONE)
#データの書き込み
XLConnect::writeWorksheet( wb, sheet  = sheet , data =test_data ,startCol=5 , startRow=2,header=F)

罠③：xlcFreeMemory()を忘れると直接編集したExcelの変更が直接保存できない。

これは罠というかついうっかりやってしまう初歩的なミス、といった類のものなのだが、
loadWorkbook()して一度XLConnectによる編集の対象としてしまうと、その間にExcelファイルに直接施した変更は（ロックされているので）そのまま保存できない。
必要な処理が終わったら、xlcFreeMemory()をしてメモリを解放しましょう。。。。

Conclusion

まぁ色々分かりにくいところはあるんだけど、こうやってなじみのあるアプリケーションを自動制御できるのはプログラミングを学び始めたころのwktk感を思い出させてくれる感じがしてなかなか新鮮ではあった。

Enjoy!

*1:配列の扱いがいちいち冗長であるなど

*2:というかなぜか漢字の読み仮名を表示してしまう

StataのデータをRでつくる（sjlabelledパッケージ）

とてもマニアックな備忘録シリーズ。

Introduction

Rにおけるデータフレームは他の統計ソフトのおけるデータ形式に比して、必要最小限の情報しか入っていない。
したがって、他の統計ソフト(SPSS , Stataなど）向けのデータを出力する時には、データ本体に加え必要な付加情報（値ラベル,変数ラベルなど）を与えてやる必要がある。

この記事ではデータをCSVから読み込んで、必要な情報をsjlabelledパッケージを利用して付加したうえでdta形式で出力するまでの手続きを述べる。

参考URL

• Reference
• Vignettes

参考過去記事
ronri-rukeichi.hatenablog.com

sjlabelled(R側)でやること。

前提として、CSV形式の原データと、値/変数ラベルに関するデータが別々に与えられていて、
CSVをデータフレームとして読み込んだうえでそこにラベル情報を付加してStata用に変換する、みたいな流れを想定する。

変数ラベルの付与

変数ラベル（変数名に関する情報）を与えるには、sjlabelled::set_label()を使う

sjlabelled::set_label(dta$var1 , "変数1") #方法1
sjlabelled::set_label(dta$var1 ) <-  "変数1" #方法2

 str(hs_df$var1)
# int [1:2970] 0 0 0 0 0 0 1 0 1 0 ...
# - attr(*, "label")= chr "変数1"

値ラベルの付与

値ラベルを与えるには、sjlabelled::set_labels()を使う*1。

指定の方法はいくつかあるけれども、named vectorを使う方法が一番確実。
（値ベクトルの値の種類の数と、与えたラベルの数が合わない時に挙動がぶれない）

dummy <- sample(1:4 , 40 , replace=T)
dummy <- set_labels(dummy,labels= c("A"=1 , "B"=2, "C"=3, "D"=4))

 str(dummy)
# int [1:40] 4 3 3 1 3 1 1 1 1 1 ...
#- attr(*, "labels")= Named num [1:4] 1 2 3 4
#  ..- attr(*, "names")= chr [1:4] "A" "B" "C" "D"

Stata形式への変換と確認

Stata形式への変換・書き出し

write_stata(test_data ,path="/Users/user/Desktop/test1.dta", version =14)

versionは8～14がsupportedだが、一応ver16でも確認できている。

Enjoy!!!

*1:関数名が紛らわしい

将棋棋士の全盛期はいつか？それは居飛車/振り飛車党によって違うのか

色んなことに疲れ果てて魔が差したシリーズ。

Introduction

将棋のプロ棋士はみな矜持をもった勝負師であるだろうから、「お前の全盛期はいつだ？」と聞かれたら、多くの棋士が桜木花道のごとく「俺は今なんだよ！」って答えるかもしれない。
しかし、まぁ理想と現実は常に乖離するものだから、統計的に見た場合の規則性は何かを語ってはくれるだろう。

ということで、簡単な分析で以下の問いを解く。

1. 将棋棋士の全盛期はいつか？
2. 全盛期は戦型によって違うのか？

ふたつめの問いは、「大山康晴名人がキャリア後半に振り飛車を指していたのは、研究時間があまり必要がなかったから」などの言説に着想を得ている。
これはあくまでも現時点でのクロスセクショナルな年齢効果/時代効果/コホート効果を区別できていないので、あくまでも素描でしかないのだが。

データ元URL

1. 将棋棋士一覧 - Wikipedia
2. 将棋棋士レーティングランキング shogidata.info
3. 居飛車党・オールラウンダー・振り飛車党 早見表(順位戦別) shogidata.info

①は生年とプロ入り年の、②はRatingの、③は戦型分類*1のデータを取得させていただいた。

作り上げたデータはこんな感じ*2

> rate_df[1:3,]
  Rank          Name Rate Age Class Class2    Class3 Age2_div100 Age3_div10000
1    1 藤井聡太 七段 1945  17    B2     B2    B級2組        2.89        0.4913
2    2   渡辺明 三冠 1937  36     A      A 名人・A級       12.96        4.6656
3    3 永瀬拓矢 二冠 1925  27    B1     B1    B級1組        7.29        1.9683
    Shimei   type  No    Ken Birth Debut Debut_Age
1 藤井聡太 居飛車 307   愛知  2002  2016        14
2   渡辺明 居飛車 235   東京  1984  2000        16
3 永瀬拓矢 居飛車 276 神奈川  1992  2009        17

分析①：お前の全盛期はいつだ？

才能の代理変数としてのデビュー時期

個人の才能のようなものを測ることができればいいのだが、直接の指標はないので、
デビュー時期（「20歳以降にプロになったものはタイトルをとれない」言説などに依拠）を代理指標とする。

具体的には、デビュー年齢（プロ入り年- 生年の簡便法なので正確な年齢ではないが）を以下のカテゴリに区分する。

• 17歳以前
• 18-19歳
• 20-21歳
• 22-23歳
• 24-26歳
• 27歳以降（アマからの編入など）

基本モデル

そして、以下の基本モデルにより推定をおこなう。

はレーティング、は年齢、はデビュー時期である。
年齢は一次近似や三次近似も試みたが、二次項までの投入が一番モデル適合率が良かった。

全盛期は約24歳

推定結果は以下の通りであった

Coefficients:
                 Estimate Std. Error  t value   Pr(>|t|)    
(Intercept)    1514.48442   91.11204 16.62222 < 2.22e-16 ***
Age              10.70958    4.51992  2.36942  0.0189864 *  
Age2_div100     -22.41058    5.33156 -4.20338 4.3232e-05 ***
debut_cat-17    143.33211   28.60160  5.01133 1.3958e-06 ***
debut_cat18-19   65.56900   22.16516  2.95820  0.0035551 ** 
debut_cat22-23  -36.01991   24.79990 -1.45242  0.1483067    
debut_cat24-26  -54.89761   22.20743 -2.47204  0.0144617 *  
debut_cat27-    -35.31097   40.79510 -0.86557  0.3879987  

デビュー時期は最頻カテゴリであった20-21歳を基準にしてある。
やはり早期デビュー組はレーティングが高く、17以前にデビューしたものは20-21歳でデビューした者に比べ、143.3ほどレーティングが高くなる計算だ。

ちなみにそこにカテゴライズされる棋士は

藤井聡太,渡辺明,永瀬拓矢,豊島将之,羽生善治,山崎隆之,増田康宏,佐々木勇気,谷川浩司,阿久津主税,屋敷伸之,阿部光瑠,森内俊之,森下卓,塚田泰明,先崎学,島朗(現Rating順)

であり、さすがに各時代を彩った棋士が顔を並べている*3。

年齢の一次項の係数は10.70958、二次項の係数は -0.2241058なので
歳が推定された「全盛期」となる。

「ピークは20代半ば」との藤井七段の言葉もあり、また羽生九段が七冠制覇したのは25歳だと考えると、おおむね正しい推定値なのではないだろうか。
mainichi.jp

分析②：戦型によって全盛期は異なるか？

先ほどのモデルに戦型の主効果と戦型×年齢、戦型×年齢二乗項、の交互作用を足して推定する*4。
するとこうなる。

Coefficients:
                                   Estimate Std. Error t value Pr(>|t|)    
(Intercept)                         1548.39      15.98   96.87  < 2e-16 ***
Age_c                                 12.70       5.61    2.26  0.02502 *  
Age2_div100_c                        -24.75       6.73   -3.67  0.00033 ***
debut_cat-17                         135.85      28.90    4.70  5.7e-06 ***
debut_cat18-19                        72.12      22.86    3.15  0.00193 ** 
debut_cat22-23                       -36.79      25.79   -1.43  0.15566    
debut_cat24-26                       -56.67      22.62   -2.51  0.01325 *  
debut_cat27-                         -41.85      41.01   -1.02  0.30905    
type振り飛車                          -9.81      20.99   -0.47  0.64103    
typeオールラウンダー                 -53.75      24.80   -2.17  0.03169 *  
Age_c:type振り飛車                     1.71      14.21    0.12  0.90457    
Age_c:typeオールラウンダー           -21.52      13.47   -1.60  0.11195    
Age2_div100_c:type振り飛車            -1.60      17.11   -0.09  0.92572    
Age2_div100_c:typeオールラウンダー    23.42      14.86    1.58  0.11698    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

年齢や年齢二乗項と戦型との交互作用は有意ではなく、戦型によって全盛期は異ならないという結論が導き出される。
プロットしても居飛車党と振り飛車党の間に、明確な差異は見受けられない。

Conclusion

棋士の全盛期は24歳で、それは居飛車党でも振り飛車党でも変わらない、ってのが結論。

まぁあくまでも回帰による予測っていうのは「条件付き平均」を求めるものなので、こういう当たり前の結果に落ち着きがち。
でも年齢効果／時代効果／コホート効果を区別できるデータをつかったら「羽生世代効果」とかが強烈に見出されるんだろう。

Mr.Children 「innocent world」 MUSIC VIDEO

Enjoy!!!

*1:居飛車率が80%以上なら居飛車党、振り飛車党率が80%なら振り飛車党、それ以外はオールラウンダーとなっている

*2:デビュー年齢はデビュー年-生年の簡便法

*3:光瑠先生もっと頑張って欲しい。やれるハズ

*4:交互作用の解釈上年齢変数は中心化