【R言語】プロ野球データを例にして試みるコレスポンデンス分析の解釈の仕方ーデータ収集から視覚化までー
コレスポンデンス分析（Correspondence Analysis）とは、クロス集計表の表頭項目（列）と表側項目（行）の関係性を視覚的に表現する手法だそうです。クロス集計表を視覚化できるのは便利そうだと思ったのですが、列項目と行項目の両方をプロットした図（同時布置図）の解釈について色々と判断に迷うところがあったので、備忘録を兼ねてまとめておこうと思います。
続きを読む【因子分析, R言語, スクレイピング】プロ野球選手の打撃成績を「長打力」「打撃技術」「走力」に要約すると上位の選手は誰になるのか！？
因子分析の練習としてどのような分析を行おうかと考えていたところ、以下のブログに面白そうな記事を発見しました。
nijyester.blog.fc2.com
nijyester.blog.fc2.com
この記事では過去10年間におけるパリーグの打者（規定打席到達に限る）の打撃成績から「長打力」「打撃技術」「走力」といった3つの共通因子を抽出し、それぞれの因子得点が上位の打者を紹介していました。残念ながらコードが記載されていませんでしたので、本記事では2011年から20016年の6年間におけるセパ両リーグの打者（規定打席の1/2以上）の打撃成績にデータを拡張して上記ブログの分析を再現してみます。
続きを読むRによる簡単な組合せシミュレーション
以下の組合せの確率をシミュレーションで求めてみたいです。
R小学校の6年1組は遠足で京都に行くことになりました。クラスの総数は30人であり、そこからくじ引き（無作為）に5人選んで6つの班を作ります。Aくんが同じクラスのBさんと同じ班になる確率はいくつでしょうか。
コード
simulation <- function(nreps) { team_info <- list() team_info$count_same_team <- 0 for (rep in 1:nreps) { team_info$num_class <- 1:30 team_info$chosen <- 0 team_info <- choose_team(team_info, 5) if (team_info$chosen > 0) next team_info <- choose_team(team_info, 5) if (team_info$chosen > 0) next team_info <- choose_team(team_info, 5) if (team_info$chosen > 0) next team_info <- choose_team(team_info, 5) if (team_info$chosen > 0) next team_info <- choose_team(team_info, 5) if (team_info$chosen > 0) next team_info <- choose_team(team_info, 5) } print(team_info$count_same_team / nreps) } choose_team <- function(han, size){ team <- sample(han$num_class, size) han$chosen <- length(intersect(1:2, team)) if (han$chosen == 2) han$count_same_team <- han$count_same_team + 1 han$num_class <- setdiff(han$num_class, team) return(han) }
> simulation(100) [1] 0.14
【参考文献】
『アート・オブ・Rプログラミング』8.6.3 応用例：組合せシミュレーション（PP.203-204）
アート・オブ・Rプログラミング 応用例5.2.5を{dplyr}パッケージを使用して書き換えてみた
『アート・オブ・Rプログラミング』の5.2.5「応用例：給与調査」（PP.105-107）ではデータクリーニング時に必要となるコードを記載しているのですが、近年{dplyr}や{stringr}など前処理に役立つパッケージがデファクトスタンダートになっているように思われます。
なので、タイトルのとおり{dplyr}パッケージを使用してテキストのコードを書き替えてようと思います。
目次
データ
『アート・オブ・Rプログラミング』のデータセットは以下のサイトから取得できます（2017年3月現在）。
『アート・オブ・Rプログラミング』に記載されている元のコード
# データの読込み > all2006 <- read.csv("2006.csv", header=TRUE, as.is=TRUE) # データクリーニング > all2006 <- all2006[all2006$Wage_Per=="Year",] # 時間給労働者を除外する > all2006 <- all2006[all2006$Wage_Offered_From > 2000,] # 不自然な事例を除外する > all2006 <- all2006[all2006$Prevailing_Wage_Amount > 200,] # 時間給現行賃金を除外する # サブデータフレームを抽出 > se2006 <- all2006[grep("Software Engineer", all2006),] > prg2006 <- all2006[grep("programmer", all2006),] > ee2006 <- all2006[grep("Electronics Engineer", all2006),]
パッケージを使用したコード
データの読込み、クリーニング、抽出の3つを以下のように書き換えてみます。
# 利用するパッケージ > library(readr) > library(dplyr) > library(magrittr) > library(stringr) # データの読込み > all2006 <- read_csv("2006.csv", col_names=TRUE, na="na") > glimpse(all2006) Observations: 99 Variables: 24 $ Case_No <chr> "A-05243-28497", "A-05275-38245", "A-0... $ Processing_Center <chr> "Atlanta Processing Center", "Atlanta ... $ Final_Case_Status <chr> "Denied", "Denied", "Denied", "Denied"... $ Received_Date <chr> "10/1/2005 0:00:00", "10/2/2005 0:00:0... $ Certified_Date <chr> "", "", "", "", "", "", "", "", "", ""... $ Denied_Date <chr> "10/1/2005 10:00:32", "10/2/2005 2:48:... $ Employer_Name <chr> "QAMAR UL ZAMAN, MD", "HYGIA INDUSTRIE... $ Employer_Address_1 <chr> "1035 RICHWOOD AVENUE", "BOX 25", "226... $ Employer_Address_2 <chr> "", "", "", "SUITE 2401", "", "", "", ... $ Employer_City <chr> "CUMBERLAND", "TALLMAN", "SCOTCH PLAIN... $ Employer_State <chr> "MARYLAND", "NEW YORK", "NEW JERSEY", ... $ Employer_Postal_Code <chr> "21502", "10982-0025", "7076", "10022"... $ Alien_Citizenship_Country <chr> "PAKISTAN", "POLAND", "ECUADOR", "JAPA... $ Employer_Job_Title <chr> "Hematologist / Oncologist / Internist... $ Wage_Offered_From <dbl> 178000.00, 29.52, 13.35, 62000.00, 1.7... $ Wage_Offered_To <dbl> NA, NA, NA, NA, NA, NA, 26.00, NA, NA,... $ Wage_Per <chr> "Year", "Year", "Hour", "Year", "Hour"... $ Prevailing_Wage_Job_Title <chr> "Physician", "COMPUTER PROGRAMMER", "L... $ Prevailing_Wage_Amount <dbl> 163800.00, 29.52, 13.35, 61818.00, 8.6... $ Prevailing_Wage_Level <chr> "Level III", "Level II", "Level IV", "... $ Prevailing_Wage_SOC_CODE <chr> "29-1062.00", "15-1021.00", "37-3011.0... $ Prevailing_Wage_SOC_Title <chr> "Family and General Practitioners", "C... $ Prevailing_Wage_Source <chr> "OES", "OES", "OES", "OES", "Other", "... $ Prevailing_Wage_Other_Source <chr> "", "", "", "", "Prevailing Wage Speci...
# データクリーニング > all2006 %<>% dplyr::filter(Wage_Per == "Year" & Wage_Offered_From > 20000 & Prevailing_Wage_Amount > 200)
# サブデータフレームを抽出 > all2006 %>% { se2006 <<- filter(., stringr::str_detect(Employer_Job_Title, fixed("Software Engineer", ignore_case=TRUE))) prg2006 <<- filter(., stringr::str_detect(Employer_Job_Title, fixed("programmer", ignore_case=TRUE))) ee2006 <<- filter(., stringr::str_detect(Employer_Job_Title, fixed("Electronics Engineer", ignore_case=TRUE))) } # 確認 > se2006 %>% select(Employer_Job_Title) > prg2006 %>% select(Employer_Job_Title) > ee2006 %>% select(Employer_Job_Title)
サブデータフレームを抽出した結果をみると以下のようになります。
se2006
| Employer_Job_Title |
|---|
| Software Engineer |
| Computer Software Engineer |
| Software Engineer |
| Software Engineer |
prg2006
| Employer_Job_Title |
|---|
| 該当なし |
ee2006
| Employer_Job_Title |
|---|
| 該当なし |
ちなみに、クリーニング前のデータによる結果は以下のとおりです。
se2006
| Employer_Job_Title |
|---|
| Software Engineer |
| Computer Software Engineer |
| Software Engineer |
| Software Engineer, Application Development |
| Software Engineer |
prg2006
| Employer_Job_Title |
|---|
| COMPUTER PROGRAMMER |
| Programmer Analyst |
ee2006
| Employer_Job_Title |
|---|
| 該当なし |
