Last updated: 201703 - 20160912. Kajiyama             [ 目次に戻る ]

HairEyeColor   3元表を2元表として対応分析する(パッケージFactoMine)  


  パッケージFactoMineによる2元表に対する対応分析

表1 HairEyeColor 性別(2水準)髪の毛の色(4水準)目の色(4水準)の3次元の多重クロス表 「アンスタック形式」

  @性別Sex
男性male 女性female
A髪の色
hair color
B目の色eye color B目の色eye color
Brown Blue Hazel Green Brown Blue Hazel Green
Black 32 11 10 3 36 9 5 2
Brown 53 50 25 15 66 34 29 14
Red 10 10 7 7 16 7 7 7
Blond 3 30 5 8 4 64 5 8
(1) 表1 の3元表をRのデータにする
 rm(list=ls(all=TRUE))  # 以前作成したオブジェクトの削除

 sex <-c("M","F")  # 性別
 eye <- c("xBrown", "xBlue", "xHazel", "xGreen" )  # 目の色 
 hair <- c("black", "brown", "red", "blond" )  # 髪の色 

 m <- matrix(c(32,11,10,3,
              53,50,25,15,
              10,10,7,7,
              3,30,5,8))   # 男性データ

 f <- matrix(c(36,9,5,2,
              66,34,29,14,
              16,7,7,7,
              4,64,5,8))   # 女性データ

 library(vcdExtra) 

 data <- expand.grid(eye=eye,hair=hair,sex=sex) 
 count <- c(m,f) 
 data <- cbind(data,count); data 
      eye  hair sex count
1  xBrown black   M    32
2   xBlue black   M    11
3  xHazel black   M    10
4  xGreen black   M     3・・・・・・・・・・・・

 str(data)
'data.frame':   32 obs. of  4 variables:
 $ eye  : Factor w/ 4 levels "xBrown","xBlue",..: 1 2 3 4 1 2 3 4 1 2 ...
 $ hair : Factor w/ 4 levels "black","brown",..: 1 1 1 1 2 2 2 2 3 3 ...
 $ sex  : Factor w/ 2 levels "M","F": 1 1 1 1 1 1 1 1 1 1 ...
 $ count: num  32 11 10 3 53 50 25 15 10 10 ...
 .tbl01.1 <- xtabs(count ~ hair + eye + sex, data = data)  
 .tbl01.1 

, , sex = M

       eye
hair    xBrown xBlue xHazel xGreen
  black     32    11     10      3
  brown     53    50     25     15
  red       10    10      7      7
  blond      3    30      5      8

, , sex = F

       eye
hair    xBrown xBlue xHazel xGreen
  black     36     9      5      2
  brown     66    34     29     14
  red       16     7      7      7
  blond      4    64      5      8
(2) 2変数(目の色・性別)を合成して3元表を->2元表に変換 .tbl01.1.M <- .tbl01.1[,,"M"] .tbl01.1.F <- .tbl01.1[,,"F"] .tbl01.1.MF <- cbind(.tbl01.1.M, .tbl01.1.F);.tbl01.1.MF xBrown xBlue xHazel xGreen xBrown xBlue xHazel xGreen black 32 11 10 3 36 9 5 2 brown 53 50 25 15 66 34 29 14 red 10 10 7 7 16 7 7 7 blond 3 30 5 8 4 64 5 8 # 列名付け替え  xBrown->MBrown  xBrown->FBrown dimnames(.tbl01.1.MF)[[2]] <- c(chartr("x","M",colnames(.tbl01.1.M)),chartr("x","F",colnames(.tbl01.1.F))) .tbl01.1.MF # 回り道してつくっている.直接付け替えしたほうが簡単. MBrown MBlue MHazel MGreen FBrown FBlue FHazel FGreen black 32 11 10 3 36 9 5 2 brown 53 50 25 15 66 34 29 14 red 10 10 7 7 16 7 7 7 blond 3 30 5 8 4 64 5 8 (3) CAによる対応分析,図1 に楕円表示 library(FactoMineR) # 毎回ロード res.CA <- CA(.tbl01.1.MF, graph = FALSE) # 対応分析をするが,グラフを表示しない.
plot( res.CA, axes=c(1,2), title="図1-a Dim1-2") # 図1-a 軸 Dim1-2を表示 plot( res.CA, axes=c(2,3), title="図2-a Dim2-3") # 図2-a 軸 Dim2-3で表示




# 図1に,性別のlineを重ね書きする. plot(res.CA,axes=c(1,2), title="図1-b  Dim1-2") # 図1-b Dim1,2を再表示 lines(res.CA$col$coord[1:4,1:2],lty=1) lines(res.CA$col$coord[5:8,1:2],lty=2) # 図2に,性別のlineを重ね書きする. plot( res.CA, axes=c(2,3), title="図2-b Dim2-3") # 図2-b Dim2,3で表示 lines(res.CA$col$coord[1:4,2:3],lty=1) lines(res.CA$col$coord[5:8,2:3],lty=2)




# FactoMineRの関数ellipseCAを使って図1に楕円を重ね表示 ellipseCA(res.CA, title="図1-c Dim1-2") # 図1-c # FactoMineRの関数ellipseCAを使って図2に楕円を重ね表示 ellipseCA(res.CA,axes=c(2,3), title="図2-c Dim2-3") #図2-c




(4) summaryで統計値を表示する. summary(res.CA) Call: CA(X = .tbl01.1.MF, graph = FALSE) The chi square of independence between the two variables is equal to 163.5603 (p-value = 4.487573e-24 ). Eigenvalues Dim.1 Dim.2 Dim.3 Variance 0.242 0.029 0.006 % of var. 87.459 10.383 2.158 Cumulative % of var. 87.459 97.842 100.000 Rows Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr cos2 black | 58.803 | 0.488 17.948 0.738 | -0.284 51.171 0.250 | 0.064 12.637 0.013 | brown | 20.326 | 0.183 6.662 0.792 | 0.064 6.791 0.096 | -0.069 38.236 0.112 | red | 16.856 | 0.158 1.235 0.177 | 0.303 38.275 0.651 | 0.155 48.496 0.172 | blond | 180.300 | -0.914 74.154 0.994 | -0.071 3.763 0.006 | 0.013 0.631 0.000 | Columns Iner*1000 Dim.1 ctr cos2 Dim.2 ctr cos2 Dim.3 ctr cos2 MBrown | 46.526 | 0.501 17.165 0.891 | -0.175 17.600 0.109 | 0.001 0.003 0.000 | MBlue | 11.141 | -0.229 3.690 0.800 | 0.056 1.844 0.047 | -0.100 28.468 0.152 | MHazel | 5.677 | 0.259 2.197 0.935 | 0.065 1.155 0.058 | 0.022 0.622 0.007 | MGreen | 6.806 | -0.124 0.353 0.125 | 0.296 16.978 0.716 | 0.139 18.170 0.159 | FBrown | 47.709 | 0.475 19.220 0.973 | -0.071 3.603 0.022 | 0.034 3.915 0.005 | FBlue | 138.433 | -0.835 55.563 0.970 | -0.146 14.274 0.030 | 0.020 1.308 0.001 | FHazel | 10.537 | 0.189 1.145 0.263 | 0.281 21.335 0.581 | -0.146 27.687 0.157 | FGreen | 9.455 | -0.176 0.668 0.171 | 0.357 23.211 0.704 | 0.150 19.828 0.125 | 10.3 考察

  FactoMineRのCAを利用し3元表を2元表(HairEyeColor) として対応分析する  [ 目次に戻る ]