授業で使用するいいデータがなかったので,作ってしまいました。

作るのにはpsychパッケージを使います。

library(psych)
# 乱数の種
set.seed(17)
# モデルの係数を指定
fx <- matrix(c(0.9,0.8,0.7,rep(0,9),0.7,0.6,0.7,rep(0,9),0.8,0.7,0.6),ncol=3)
fy <- c(0.8,0.7,0.9)
Phi <- matrix(c(1,0.4,0.3,0.2,0.4,1,0.2,0.6,0.3,0.2,1,0.3,0.2,0.6,0.3,1),ncol=4)
# サンプルデータを作成
sample <- sim.structure(fx,Phi,fy)
## Loading required package: MASS
sample$model
##       Vx1   Vx2   Vx3   Vx4   Vx5   Vx6   Vx7   Vx8   Vx9   Vy1   Vy2
## Vx1 1.000 0.720 0.630 0.252 0.216 0.252 0.216 0.189 0.162 0.144 0.126
## Vx2 0.720 1.000 0.560 0.224 0.192 0.224 0.192 0.168 0.144 0.128 0.112
## Vx3 0.630 0.560 1.000 0.196 0.168 0.196 0.168 0.147 0.126 0.112 0.098
## Vx4 0.252 0.224 0.196 1.000 0.420 0.490 0.112 0.098 0.084 0.336 0.294
## Vx5 0.216 0.192 0.168 0.420 1.000 0.420 0.096 0.084 0.072 0.288 0.252
## Vx6 0.252 0.224 0.196 0.490 0.420 1.000 0.112 0.098 0.084 0.336 0.294
## Vx7 0.216 0.192 0.168 0.112 0.096 0.112 1.000 0.560 0.480 0.192 0.168
## Vx8 0.189 0.168 0.147 0.098 0.084 0.098 0.560 1.000 0.420 0.168 0.147
## Vx9 0.162 0.144 0.126 0.084 0.072 0.084 0.480 0.420 1.000 0.144 0.126
## Vy1 0.144 0.128 0.112 0.336 0.288 0.336 0.192 0.168 0.144 1.000 0.560
## Vy2 0.126 0.112 0.098 0.294 0.252 0.294 0.168 0.147 0.126 0.560 1.000
## Vy3 0.162 0.144 0.126 0.378 0.324 0.378 0.216 0.189 0.162 0.720 0.630
##       Vy3
## Vx1 0.162
## Vx2 0.144
## Vx3 0.126
## Vx4 0.378
## Vx5 0.324
## Vx6 0.378
## Vx7 0.216
## Vx8 0.189
## Vx9 0.162
## Vy1 0.720
## Vy2 0.630
## Vy3 1.000
# モデル図
structure.diagram(fx,Phi,fy,cut=0)

さて,ここからデータセットを作ります。自作関数を準備(この辺の話は http://kosugitti.net/archives/112 を参照)。

# 任意の相関行列をもつデータセットを作る関数
corMatVal <- function(size,n.vals,cor.mat,corvec=FALSE){
  Rmat <- matrix(rnorm(n=size*n.vals),nrow=size)
  #if given cor.mat is just vector,make correlational matrix
  if(corvec==TRUE){
    temp.mat <- diag(n.vals)
    temp.mat[(upper.tri)(temp.mat,diag=FALSE)] <- cor.mat
    temp.cor <- (t(temp.mat)+temp.mat)
    diag(temp.cor) <- 1
  }else{
    temp.cor <- cor.mat
  }
  Upper <- chol(temp.cor)
  result <- as.data.frame(Rmat %*% Upper)
  return(result)
}

この関数は,サンプルサイズ,変数の数,行列を渡してやるとデータセットを作るというもの。使い方は以下の通り。

sampledata <- corMatVal(500,12,sample$model)
summary(sampledata)
##       Vx1                 Vx2                 Vx3          
##  Min.   :-3.556136   Min.   :-3.267431   Min.   :-2.88423  
##  1st Qu.:-0.714150   1st Qu.:-0.588818   1st Qu.:-0.78146  
##  Median :-0.000591   Median : 0.009451   Median :-0.09036  
##  Mean   :-0.029510   Mean   : 0.023383   Mean   :-0.04252  
##  3rd Qu.: 0.673071   3rd Qu.: 0.659493   3rd Qu.: 0.65921  
##  Max.   : 3.330153   Max.   : 4.258519   Max.   : 2.98409  
##       Vx4                Vx5                Vx6           
##  Min.   :-2.77290   Min.   :-3.02830   Min.   :-3.172601  
##  1st Qu.:-0.62570   1st Qu.:-0.53395   1st Qu.:-0.575488  
##  Median : 0.02396   Median : 0.05308   Median : 0.001294  
##  Mean   : 0.02385   Mean   : 0.04205   Mean   : 0.012784  
##  3rd Qu.: 0.62457   3rd Qu.: 0.62317   3rd Qu.: 0.684504  
##  Max.   : 2.98966   Max.   : 2.78232   Max.   : 2.418963  
##       Vx7               Vx8               Vx9          
##  Min.   :-2.8903   Min.   :-3.2256   Min.   :-2.41139  
##  1st Qu.:-0.7673   1st Qu.:-0.7430   1st Qu.:-0.73895  
##  Median :-0.1329   Median :-0.1395   Median :-0.08882  
##  Mean   :-0.1276   Mean   :-0.1055   Mean   :-0.10181  
##  3rd Qu.: 0.5445   3rd Qu.: 0.5705   3rd Qu.: 0.60653  
##  Max.   : 2.3493   Max.   : 2.7647   Max.   : 2.89852  
##       Vy1                 Vy2                Vy3          
##  Min.   :-3.843148   Min.   :-3.13183   Min.   :-2.85006  
##  1st Qu.:-0.670198   1st Qu.:-0.60068   1st Qu.:-0.64280  
##  Median :-0.047808   Median : 0.06205   Median : 0.03828  
##  Mean   :-0.000494   Mean   : 0.06736   Mean   : 0.02538  
##  3rd Qu.: 0.671363   3rd Qu.: 0.75519   3rd Qu.: 0.70597  
##  Max.   : 2.968449   Max.   : 3.82201   Max.   : 4.18128
print(cor(sampledata),digit=2)
##      Vx1   Vx2   Vx3   Vx4   Vx5      Vx6      Vx7   Vx8    Vx9   Vy1  Vy2
## Vx1 1.00 0.731 0.634 0.203 0.191  2.0e-01  1.7e-01 0.217  0.106 0.101 0.16
## Vx2 0.73 1.000 0.597 0.234 0.161  2.1e-01  1.4e-01 0.194  0.118 0.099 0.13
## Vx3 0.63 0.597 1.000 0.217 0.125  2.0e-01  1.4e-01 0.204  0.114 0.099 0.10
## Vx4 0.20 0.234 0.217 1.000 0.321  4.5e-01  7.4e-02 0.075  0.043 0.293 0.25
## Vx5 0.19 0.161 0.125 0.321 1.000  4.0e-01  6.2e-02 0.054  0.036 0.267 0.19
## Vx6 0.20 0.209 0.195 0.454 0.400  1.0e+00 -1.1e-06 0.029 -0.072 0.284 0.25
## Vx7 0.17 0.140 0.140 0.074 0.062 -1.1e-06  1.0e+00 0.520  0.524 0.198 0.20
## Vx8 0.22 0.194 0.204 0.075 0.054  2.9e-02  5.2e-01 1.000  0.417 0.192 0.22
## Vx9 0.11 0.118 0.114 0.043 0.036 -7.2e-02  5.2e-01 0.417  1.000 0.154 0.15
## Vy1 0.10 0.099 0.099 0.293 0.267  2.8e-01  2.0e-01 0.192  0.154 1.000 0.53
## Vy2 0.16 0.127 0.104 0.253 0.194  2.5e-01  2.0e-01 0.216  0.150 0.530 1.00
## Vy3 0.12 0.094 0.080 0.373 0.258  3.7e-01  2.2e-01 0.196  0.149 0.687 0.65
##       Vy3
## Vx1 0.120
## Vx2 0.094
## Vx3 0.080
## Vx4 0.373
## Vx5 0.258
## Vx6 0.371
## Vx7 0.219
## Vx8 0.196
## Vx9 0.149
## Vy1 0.687
## Vy2 0.654
## Vy3 1.000

これで完成でもいいんですが,カバーストーリーとして基礎体力が野球のパフォーマンスにどういう影響があるか,というものを考えているので,適当な変数名をつけたり,単位をそれっぽいものにしたりします。 ここで丸め誤差などが生じてくるので,理想的なモデルが再現できるとは限りません。

colnames(sampledata)<-c("Run50M","Run500M","Run1500M","Kensui","Entoh","Udetate","Hanpuku","Kiritsu","Habatobi","Hit","Homerun","Choda")
sampledata$Run50M <- round(sampledata$Run50M+8,3)
sampledata$Run500M <- round(sampledata$Run500M*10,3)+120
sampledata$Run1500M <- round(sampledata$Run1500M*10,3)+240
sampledata$Kensui <- round(sampledata$Kensui*5+30)
sampledata$Entoh <- round(sampledata$Entoh*5+30)
sampledata$Udetate <- round(sampledata$Udetate*10+34)
sampledata$Hanpuku <- round(sampledata$Hanpuku*10+30)
sampledata$Kiritsu <- round(sampledata$Kiritsu+5,3)
sampledata$Habatobi <- round(sampledata$Habatobi+10,2)
sampledata$Hit <- round(sampledata$Hit*10+100)
sampledata$Homerun <- round(sampledata$Homerun*2+20)
sampledata$Choda <- round(sampledata$Choda*10+35)
summary(sampledata)
##      Run50M          Run500M          Run1500M         Kensui     
##  Min.   : 4.444   Min.   : 87.33   Min.   :211.2   Min.   :16.00  
##  1st Qu.: 7.286   1st Qu.:114.11   1st Qu.:232.2   1st Qu.:27.00  
##  Median : 7.999   Median :120.09   Median :239.1   Median :30.00  
##  Mean   : 7.970   Mean   :120.23   Mean   :239.6   Mean   :30.12  
##  3rd Qu.: 8.673   3rd Qu.:126.59   3rd Qu.:246.6   3rd Qu.:33.00  
##  Max.   :11.330   Max.   :162.59   Max.   :269.8   Max.   :45.00  
##      Entoh          Udetate         Hanpuku         Kiritsu     
##  Min.   :15.00   Min.   : 2.00   Min.   : 1.00   Min.   :1.774  
##  1st Qu.:27.00   1st Qu.:28.00   1st Qu.:22.00   1st Qu.:4.257  
##  Median :30.00   Median :34.00   Median :29.00   Median :4.861  
##  Mean   :30.23   Mean   :34.12   Mean   :28.72   Mean   :4.894  
##  3rd Qu.:33.00   3rd Qu.:41.00   3rd Qu.:35.00   3rd Qu.:5.571  
##  Max.   :44.00   Max.   :58.00   Max.   :53.00   Max.   :7.765  
##     Habatobi           Hit            Homerun          Choda      
##  Min.   : 7.590   Min.   : 62.00   Min.   :14.00   Min.   : 6.00  
##  1st Qu.: 9.260   1st Qu.: 93.00   1st Qu.:19.00   1st Qu.:29.00  
##  Median : 9.910   Median :100.00   Median :20.00   Median :35.00  
##  Mean   : 9.898   Mean   : 99.98   Mean   :20.14   Mean   :35.25  
##  3rd Qu.:10.605   3rd Qu.:107.00   3rd Qu.:22.00   3rd Qu.:42.00  
##  Max.   :12.900   Max.   :130.00   Max.   :28.00   Max.   :77.00

一応,丸まったデータがどういう推定値を出すか,見てみます。SEMにはlavaanパッケージを使います。

library(lavaan)
## This is lavaan 0.5-17
## lavaan is BETA software! Please report any bugs.
model <- '
Ashi =~ Run50M + Run500M + Run1500M
Ude =~ Kensui + Entoh + Udetate
Shunbin =~ Hanpuku+Kiritsu+Habatobi
Performance =~ Hit + Homerun + Choda
Performance ~ Ashi + Ude + Shunbin
'
fit <- sem(model,data=sampledata)
summary(fit,standardized=TRUE)
## lavaan (0.5-17) converged normally after 136 iterations
## 
##   Number of observations                           500
## 
##   Estimator                                         ML
##   Minimum Function Test Statistic               44.970
##   Degrees of freedom                                48
##   P-value (Chi-square)                           0.598
## 
## Parameter estimates:
## 
##   Information                                 Expected
##   Standard Errors                             Standard
## 
##                    Estimate  Std.err  Z-value  P(>|z|)   Std.lv  Std.all
## Latent variables:
##   Ashi =~
##     Run50M            1.000                               0.928    0.876
##     Run500M           8.839    0.457   19.330    0.000    8.205    0.832
##     Run1500M          8.067    0.471   17.120    0.000    7.489    0.723
##   Ude =~
##     Kensui            1.000                               3.161    0.646
##     Entoh             0.769    0.087    8.814    0.000    2.430    0.521
##     Udetate           2.179    0.211   10.348    0.000    6.889    0.716
##   Shunbin =~
##     Hanpuku           1.000                               7.312    0.789
##     Kiritsu           0.086    0.008   11.281    0.000    0.631    0.662
##     Habatobi          0.087    0.008   11.182    0.000    0.636    0.648
##   Performance =~
##     Hit               1.000                               7.259    0.746
##     Homerun           0.188    0.012   15.180    0.000    1.363    0.697
##     Choda             1.265    0.073   17.437    0.000    9.181    0.920
## 
## Regressions:
##   Performance ~
##     Ashi             -1.215    0.433   -2.804    0.005   -0.155   -0.155
##     Ude               1.407    0.174    8.071    0.000    0.613    0.613
##     Shunbin           0.313    0.056    5.617    0.000    0.315    0.315
## 
## Covariances:
##   Ashi ~~
##     Ude               1.071    0.190    5.645    0.000    0.365    0.365
##     Shunbin           1.762    0.389    4.526    0.000    0.260    0.260
##   Ude ~~
##     Shunbin           1.396    1.442    0.969    0.333    0.060    0.060
## 
## Variances:
##     Run50M            0.261    0.037                      0.261    0.232
##     Run500M          29.861    3.189                     29.861    0.307
##     Run1500M         51.250    3.926                     51.250    0.477
##     Kensui           13.984    1.223                     13.984    0.583
##     Entoh            15.847    1.165                     15.847    0.729
##     Udetate          45.118    4.789                     45.118    0.487
##     Hanpuku          32.370    4.410                     32.370    0.377
##     Kiritsu           0.510    0.044                      0.510    0.561
##     Habatobi          0.558    0.047                      0.558    0.580
##     Hit              42.043    3.427                     42.043    0.444
##     Homerun           1.966    0.147                      1.966    0.514
##     Choda            15.341    3.440                     15.341    0.154
##     Ashi              0.862    0.076                      1.000    1.000
##     Ude               9.994    1.494                      1.000    1.000
##     Shunbin          53.464    6.367                      1.000    1.000
##     Performance      30.163    3.925                      0.572    0.572

これでオッケー。

実は,こんな面倒なことをしなくても,sim.structure関数で仮想データを作ることも可能なのです。

# 5件法のデータセットをN=500で作る(itemsオプションをTに)
sample <- sim.structure(fx,Phi,fy,n=500,items=T,cat=5)
sample
## Call: sim.structure(fx = fx, Phi = Phi, fy = fy, n = 500, items = T, 
##     cat = 5)
## 
##  $model (Population correlation matrix) 
##      Vx1  Vx2   Vx3   Vx4   Vx5   Vx6   Vx7   Vx8   Vx9  Vy1   Vy2  Vy3
## Vx1 1.00 0.72 0.630 0.252 0.216 0.252 0.216 0.189 0.162 0.14 0.126 0.16
## Vx2 0.72 1.00 0.560 0.224 0.192 0.224 0.192 0.168 0.144 0.13 0.112 0.14
## Vx3 0.63 0.56 1.000 0.196 0.168 0.196 0.168 0.147 0.126 0.11 0.098 0.13
## Vx4 0.25 0.22 0.196 1.000 0.420 0.490 0.112 0.098 0.084 0.34 0.294 0.38
## Vx5 0.22 0.19 0.168 0.420 1.000 0.420 0.096 0.084 0.072 0.29 0.252 0.32
## Vx6 0.25 0.22 0.196 0.490 0.420 1.000 0.112 0.098 0.084 0.34 0.294 0.38
## Vx7 0.22 0.19 0.168 0.112 0.096 0.112 1.000 0.560 0.480 0.19 0.168 0.22
## Vx8 0.19 0.17 0.147 0.098 0.084 0.098 0.560 1.000 0.420 0.17 0.147 0.19
## Vx9 0.16 0.14 0.126 0.084 0.072 0.084 0.480 0.420 1.000 0.14 0.126 0.16
## Vy1 0.14 0.13 0.112 0.336 0.288 0.336 0.192 0.168 0.144 1.00 0.560 0.72
## Vy2 0.13 0.11 0.098 0.294 0.252 0.294 0.168 0.147 0.126 0.56 1.000 0.63
## Vy3 0.16 0.14 0.126 0.378 0.324 0.378 0.216 0.189 0.162 0.72 0.630 1.00
## 
## $reliability (population reliability) 
##  Vx1  Vx2  Vx3  Vx4  Vx5  Vx6  Vx7  Vx8  Vx9  Vy1  Vy2  Vy3 
## 0.81 0.64 0.49 0.49 0.36 0.49 0.64 0.49 0.36 0.64 0.49 0.81 
## 
## $r  (Sample correlation matrix  for sample size =  500 )
##       Vx1      Vx2    Vx3    Vx4    Vx5    Vx6    Vx7    Vx8    Vx9
## Vx1 1.000  0.37352  0.181  0.048  0.086  0.126  0.103  0.115  0.095
## Vx2 0.374  1.00000  0.285  0.086  0.124  0.137  0.018  0.089  0.112
## Vx3 0.181  0.28517  1.000  0.102  0.123  0.246  0.029  0.088  0.073
## Vx4 0.048  0.08556  0.102  1.000  0.183  0.131  0.049 -0.036 -0.058
## Vx5 0.086  0.12417  0.123  0.183  1.000  0.268  0.057  0.014 -0.108
## Vx6 0.126  0.13742  0.246  0.131  0.268  1.000  0.064 -0.015 -0.018
## Vx7 0.103  0.01794  0.029  0.049  0.057  0.064  1.000  0.237  0.135
## Vx8 0.115  0.08917  0.088 -0.036  0.014 -0.015  0.237  1.000  0.226
## Vx9 0.095  0.11240  0.073 -0.058 -0.108 -0.018  0.135  0.226  1.000
## Vy1 0.035 -0.00079 -0.023  0.125  0.130  0.099  0.106  0.071 -0.017
## Vy2 0.061  0.09508  0.065  0.113  0.060  0.142  0.060  0.116 -0.032
## Vy3 0.023  0.07774  0.090  0.136  0.105  0.123 -0.030  0.076  0.028
##          Vy1    Vy2    Vy3
## Vx1  0.03491  0.061  0.023
## Vx2 -0.00079  0.095  0.078
## Vx3 -0.02332  0.065  0.090
## Vx4  0.12480  0.113  0.136
## Vx5  0.12989  0.060  0.105
## Vx6  0.09867  0.142  0.123
## Vx7  0.10578  0.060 -0.030
## Vx8  0.07095  0.116  0.076
## Vx9 -0.01669 -0.032  0.028
## Vy1  1.00000  0.205  0.183
## Vy2  0.20529  1.000  0.263
## Vy3  0.18276  0.263  1.000
summary(sample$observed)
##       Vx1             Vx2             Vx3             Vx4       
##  Min.   :0.000   Min.   :0.000   Min.   :0.000   Min.   :0.000  
##  1st Qu.:4.750   1st Qu.:1.000   1st Qu.:0.000   1st Qu.:5.000  
##  Median :5.000   Median :2.000   Median :0.000   Median :5.000  
##  Mean   :4.588   Mean   :2.442   Mean   :0.422   Mean   :4.644  
##  3rd Qu.:5.000   3rd Qu.:4.000   3rd Qu.:1.000   3rd Qu.:5.000  
##  Max.   :5.000   Max.   :5.000   Max.   :5.000   Max.   :5.000  
##       Vx5            Vx6             Vx7             Vx8       
##  Min.   :0.00   Min.   :0.000   Min.   :0.000   Min.   :0.000  
##  1st Qu.:1.00   1st Qu.:0.000   1st Qu.:5.000   1st Qu.:1.000  
##  Median :2.00   Median :0.000   Median :5.000   Median :2.000  
##  Mean   :2.48   Mean   :0.384   Mean   :4.598   Mean   :2.382  
##  3rd Qu.:4.00   3rd Qu.:1.000   3rd Qu.:5.000   3rd Qu.:4.000  
##  Max.   :5.00   Max.   :5.000   Max.   :5.000   Max.   :5.000  
##       Vx9             Vy1             Vy2             Vy3       
##  Min.   :0.000   Min.   :0.000   Min.   :0.000   Min.   :0.000  
##  1st Qu.:0.000   1st Qu.:5.000   1st Qu.:1.000   1st Qu.:0.000  
##  Median :0.000   Median :5.000   Median :3.000   Median :0.000  
##  Mean   :0.342   Mean   :4.672   Mean   :2.626   Mean   :0.412  
##  3rd Qu.:0.000   3rd Qu.:5.000   3rd Qu.:4.000   3rd Qu.:1.000  
##  Max.   :5.000   Max.   :5.000   Max.   :5.000   Max.   :5.000

まあ5件法っていってるのに0が入っていたり,全部の変数が同じスケールになってしまうという点が引っかかるのであれば,上の自作関数の法を使ってください。

あとは,こうやって作ったデータセットを保存して配布すれば終わり。

write.table(sampledata,"sports.csv",sep=",",quote=F,row.names=F,col.names=T)

以上です。