Rによる因子分析―プロ野球データを使用した分析例―

因子分析の練習としてどのような分析を行おうかと考えていたところ、以下のブログに面白そうな記事を発見しました。

nijyester.blog.fc2.com
nijyester.blog.fc2.com


 この記事では過去10年間におけるパリーグの打者(規定打席到達に限る)の打撃成績から「長打力」「打撃技術」「走力」といった3つの共通因子を抽出し、それぞれの因子得点が上位の打者を紹介していました。残念ながらコードが記載されていませんでしたので、本記事では2011年から20016年の6年間におけるセパ両リーグの打者(規定打席の1/2以上)の打撃成績にデータを拡張して上記ブログの分析をレプリケートしてみます。

続きを読む

Rによる裁量的発生高の計算方法

実証会計学という財務(管理)会計学ファイナンス、応用ミクロ経済学などの様々な研究領域の知見を援用した学際的な研究分野があります。
その中には、発生主義会計によって生じる会計発生高(accruals)に着目して企業の利益マネジメント行動(earnings management activity)を包括的に捉えようとする研究があります。
ここでいう会計発生高とは費用や収益の見越しや繰延べによって計上される経過勘定項目を集約したようなイメージを抱いていただければ大丈夫だと思います。ですので、発生主義会計を採用することで発生する項目を利用した利益調整は粉飾など法令違反による利益操作のことを全く意味しておらず、企業の1つの経営戦略として位置づけられています。本記事では会計発生高を利用した企業の利益マネジメント行動のうち、発生主義会計により非裁量的に生じる部分を除いた裁量的な部分の計算方法をR言語を使用して以下で例示していきたいと思います。

続きを読む

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月現在)。

Art of R Programming | No Starch Press

  • このページの"Download the data files from the book"のリンクからフォルダをダウンロードする
  • ファイルだ内の"2006.csv.short"ファイルの拡張子をcsvに変更する

『アート・オブ・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
該当なし