工作滿意度組刪題=5 16 18 25 27 26 31 33 15 35 30 32
> #讀進資料
> dta <- read.csv("mid_terma.CSV", header = T)
> class(dta) [1] "data.frame"
> dim(dta) [1] 497 88
> dta_count <- array(dim(dta),1)
> na.fail(dta)
Error in na.fail.default(dta) : missing values in object
> dta_count <- array(dim(dta),1)
> show(apply(apply(dta, 2, is.na), 2, sum)/497)
team no personalily a101 a102R a103 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 a104R a106R a107 a108R a109R a210
0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 a211R a212R a213 a314R a317R a319R
0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 a320 a421 a422R a423 a424 a428
0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 a429 a434R a436R b101 b102 b203
0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.002012072 b104 b105R b206R b307R b308 b209R
0.002012072 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 b310 b211 b212 b313R b314 b215R
0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 c101 c102 c103R c104 c405R c106
0.002012072 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 c107 c108 c109R c110R c111 c212R
0.000000000 0.000000000 0.000000000 0.000000000 0.002012072 0.000000000
c213 c114 c215 c116 c417 c318
0.000000000 0.000000000 0.002012072 0.000000000 0.000000000 0.000000000 c319 c320R c321 c122 c123 c224
0.002012072 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 c125 c226 c327 c328R c429 c230
0.000000000 0.002012072 0.000000000 0.000000000 0.000000000 0.000000000 c331 c432 c433 c434 c435 d101
0.000000000 0.002012072 0.000000000 0.000000000 0.000000000 0.000000000 d102 d103R d204 d205 d206 d207
0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.002012072 d308 d309R d310 d311
0.002012072 0.000000000 0.000000000 0.000000000
> #所有NA請立即離開現場
> nadta<-na.exclude(dta)
> dim(nadta) [1] 487 88
> #以str看一下資料結構、看一下最後六題,確認樣本數是多少
> #程式報表6.1
> str(nadta)
'data.frame': 487 obs. of 88 variables:
$ team : int 2801 2801 2801 2801 2801 2801 2801 2801 2801 2801 ...
$ no : int 1 2 3 4 5 6 7 8 9 10 ...
$ personalily: int 7 9 5 6 6 6 5 8 8 5 ...
$ a101 : int 6 6 3 5 4 3 2 4 6 3 ...
$ a102R : int 4 4 4 4 3 4 4 4 6 1 ...
$ a103 : int 4 3 2 3 6 2 4 3 6 4 ...
$ a104R : int 4 6 4 3 2 2 2 5 6 5 ...
$ a106R : int 4 4 2 3 3 2 2 2 3 2 ...
$ a107 : int 4 3 2 4 3 3 1 2 4 4 ...
$ a108R : int 4 2 4 4 2 4 4 2 3 1 ...
$ a109R : int 5 2 4 4 3 4 4 4 6 2 ...
$ a210 : int 6 7 4 5 6 6 7 5 6 6 ...
$ a211R : int 6 6 4 4 4 7 5 4 6 2 ...
$ a212R : int 6 6 2 5 4 7 5 6 6 4 ...
$ a213 : int 6 6 4 5 4 7 4 4 6 6 ...
$ a314R : int 4 3 3 3 3 2 4 3 6 1 ...
$ a317R : int 5 4 4 4 4 5 4 3 6 1 ...
$ a319R : int 4 5 3 4 3 2 4 2 6 2 ...
$ a320 : int 4 4 2 2 3 4 4 2 6 4 ...
$ a421 : int 6 5 5 5 6 6 4 5 6 7 ...
$ a422R : int 2 5 5 4 4 2 7 3 6 7 ...
$ a423 : int 6 2 4 2 4 4 4 3 6 4 ...
$ a424 : int 4 4 6 4 4 2 4 5 6 7 ...
$ a428 : int 4 5 6 4 4 4 4 4 6 7 ...
$ a429 : int 4 5 6 4 4 4 4 4 6 7 ...
$ a434R : int 3 1 2 4 3 2 4 2 2 1 ...
$ a436R : int 3 2 4 3 3 2 4 4 2 4 ...
$ b101 : int 4 5 7 5 4 4 3 6 6 4 ...
$ b102 : int 4 4 6 4 4 4 4 6 6 4 ...
$ b203 : int 5 2 6 4 4 4 4 6 6 5 ...
$ b104 : int 4 4 6 4 4 4 4 4 6 7 ...
$ b105R : int 4 5 4 4 4 4 4 2 6 4 ...
$ b206R : int 5 5 5 5 4 4 4 4 6 4 ...
$ b307R : int 4 2 3 4 2 2 4 4 6 4 ...
$ b308 : int 3 3 4 3 3 4 3 4 6 4 ...
$ b209R : int 4 5 4 4 5 4 4 6 6 4 ...
$ b310 : int 4 4 4 3 4 4 1 4 6 5 ...
$ b211 : int 4 5 4 5 4 4 2 5 6 5 ...
$ b212 : int 4 4 4 4 4 3 4 6 6 6 ...
$ b313R : int 4 5 4 4 3 4 4 5 6 4 ...
$ b314 : int 4 3 6 4 4 6 4 6 6 6 ...
$ b215R : int 3 4 4 4 2 2 1 3 2 4 ...
$ c101 : int 6 7 4 5 4 6 4 6 6 6 ...
$ c102 : int 5 6 3 4 4 6 4 5 6 6 ...
$ c103R : int 6 6 4 5 5 6 5 3 6 6 ...
$ c104 : int 6 6 4 4 4 5 4 4 6 6 ...
$ c405R : int 6 6 4 6 5 7 5 3 6 6 ...
$ c106 : int 6 7 4 3 4 6 4 5 6 7 ...
$ c107 : int 6 6 4 3 4 6 4 5 6 6 ...
$ c108 : int 6 7 4 5 4 6 4 6 6 7 ...
$ c109R : int 6 6 4 4 4 6 4 3 6 6 ...
$ c110R : int 7 6 4 5 5 4 5 3 2 1 ...
$ c111 : int 6 6 6 4 4 6 4 6 6 7 ...
$ c212R : int 6 6 4 5 4 6 4 2 6 7 ...
$ c213 : int 6 7 5 5 4 6 4 6 6 7 ...
$ c114 : int 6 6 4 4 4 4 4 4 6 6 ...
$ c215 : int 6 7 4 5 4 6 4 6 6 7 ...
$ c116 : int 6 6 3 5 4 6 4 6 6 6 ...
$ c417 : int 5 6 6 5 4 4 4 6 6 6 ...
$ c318 : int 6 5 4 5 4 5 4 6 6 6 ...
$ c319 : int 6 6 4 5 5 4 5 6 6 6 ...
$ c320R : int 7 6 3 5 5 6 5 6 6 7 ...
$ c321 : int 6 6 3 3 4 6 4 6 6 6 ...
$ c122 : int 6 6 3 4 4 6 4 6 6 6 ...
$ c123 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c224 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c125 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c226 : int 6 7 3 5 4 6 4 6 6 6 ...
$ c327 : int 6 6 3 5 4 6 4 6 6 6 ...
$ c328R : int 7 5 3 5 4 6 4 6 6 7 ...
$ c429 : int 6 7 3 5 4 4 4 6 6 6 ...
$ c230 : int 6 6 3 5 5 6 5 6 6 6 ...
$ c331 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c432 : int 5 6 3 4 4 4 4 6 6 6 ...
$ c433 : int 5 6 3 4 4 4 4 4 6 6 ...
$ c434 : int 6 7 3 5 4 4 4 6 6 5 ...
$ c435 : int 6 6 4 3 4 6 4 6 2 6 ...
$ d101 : int 6 6 6 5 5 6 6 5 6 7 ...
$ d102 : int 6 5 6 5 5 6 5 6 6 7 ...
$ d103R : int 5 6 6 5 5 6 7 6 6 2 ...
$ d204 : int 5 6 6 5 5 6 4 5 6 6 ...
$ d205 : int 6 6 6 5 5 6 7 6 6 6 ...
$ d206 : int 5 5 6 5 5 6 5 6 6 7 ...
$ d207 : int 6 6 6 5 5 6 6 6 6 6 ...
$ d308 : int 4 5 5 4 5 4 4 5 6 7 ...
$ d309R : int 3 4 3 5 4 2 4 2 6 1 ...
$ d310 : int 5 5 6 4 4 6 4 6 6 6 ...
$ d311 : int 4 4 4 5 4 6 4 4 6 6 ...
- attr(*, "na.action")=Class 'exclude' Named int [1:10] 149 206 226 285 351 373
385 430 456 472
.. ..- attr(*, "names")= chr [1:10] "149" "206" "226" "285" ...
> tail(nadta)
team no personalily a101 a102R a103 a104R a106R a107 a108R a109R a210 492 3701 615 9 6 6 6 5 6 3 5 6 6
493 3701 616 9 6 6 6 5 6 3 5 6 6
494 3701 619 9 6 6 6 5 6 3 5 6 6
495 3701 620 7 6 6 6 6 3 2 3 4 3
496 3701 621 9 6 6 6 5 6 3 5 6 6
497 3701 622 8 6 6 6 6 3 2 3 4 3
a211R a212R a213 a314R a317R a319R a320 a421 a422R a423 a424 a428 a429 492 6 5 6 5 5 6 6 6 6 5 6 6 6
493 6 5 6 5 5 6 6 6 6 5 6 6 6
494 6 5 6 5 5 6 6 6 6 5 6 6 6
495 6 4 4 6 7 6 5 6 5 5 6 6 6
496 6 5 6 5 5 6 6 6 6 5 6 6 6
497 6 4 4 6 7 6 5 6 5 5 6 6 6
a434R a436R b101 b102 b203 b104 b105R b206R b307R b308 b209R b310 b211 492 4 2 6 5 5 5 6 5 5 6 6 3 5
493 4 2 6 5 5 5 6 5 5 6 6 3 5
494 4 2 6 5 5 5 6 5 5 6 6 3 5
495 4 4 7 6 6 6 7 3 5 4 3 3 7
496 4 2 6 5 5 5 6 5 5 6 6 3 5
497 4 4 7 6 6 6 7 3 5 4 3 3 7
b212 b313R b314 b215R c101 c102 c103R c104 c405R c106 c107 c108 c109R 492 5 6 6 5 6 6 5 5 2 6 6 6 6
493 5 6 6 5 6 6 5 5 2 6 6 6 6
494 5 6 6 5 6 6 5 5 2 6 6 6 6
495 4 3 7 2 5 6 3 6 3 5 5 4 3
496 5 6 6 5 6 6 5 5 2 6 6 6 6
497 4 3 7 2 5 6 3 6 3 5 5 4 3
c110R c111 c212R c213 c114 c215 c116 c417 c318 c319 c320R c321 c122 c123 492 6 6 6 5 5 6 6 6 6 6 5 6 6 6
493 6 6 6 5 5 6 6 6 6 6 5 6 6 6
494 6 6 6 5 5 6 6 6 6 6 5 6 6 6
495 4 5 3 6 5 4 4 4 4 4 3 5 4 4
496 6 6 6 5 5 6 6 6 6 6 5 6 6 6
497 4 5 3 6 5 4 4 4 4 4 3 5 4 4
c224 c125 c226 c327 c328R c429 c230 c331 c432 c433 c434 c435 d101 d102 492 6 6 6 6 6 6 6 6 5 5 6 5 6 6
493 6 6 6 6 6 6 6 6 5 5 6 5 6 6
494 6 6 6 6 6 6 6 6 5 5 6 5 6 6
495 4 4 3 3 4 4 4 3 4 6 4 4
7 7
496 6 6 6 6 6 6 6 6 5 5 6 5 6 6
497 4 4 3 3 4 4 4 3 4 6 4 4 7 7
d103R d204 d205 d206 d207 d308 d309R d310 d311 492 6 6 6 6 6 6 6 6 6 493 6 6 6 6 6 6 6 6 6 494 6 6 6 6 6 6 6 6 6 495 6 6 7 6 7 7 5 5 7 496 6 6 6 6 6 6 6 6 6 497 6 6 7 6 7 7 5 5 7
> #---
> #定義一個函數,可以同時
> #計算題目的平均數、標準差、偏態與峰度
> my_summary <- function(x) { + require(moments)
+ funs <- c(mean, sd, skewness, kurtosis) + sapply(funs, function(f) f(x, na.rm = TRUE)) + }
> #一次算完所有題目前四級動差,並存成資料檔
> dta_desc <- apply(dta[4:39], 2, my_summary)
> rownames(dta_desc) <- c("平均", "標準差", "偏態", "峰度")
> rslt1 <- as.data.frame(t(dta_desc))
> round(rslt1,3)
平均 標準差 偏態 峰度 a101 4.127 1.415 -0.182 2.517 a102R 3.968 1.221 -0.025 3.316 a103 3.543 1.411 0.205 2.445 a104R 3.712 1.341 -0.053 2.680 a106R 3.282 1.275 0.221 2.905 a107 3.451 1.285 0.087 2.935 a108R 3.089 1.218 0.319 2.832 a109R 3.463 1.292 -0.002 2.583 a210 4.952 1.422 -0.736 2.993 a211R 4.726 1.320 -0.361 2.911 a212R 4.507 1.400 -0.394 2.817 a213 4.789 1.307 -0.463 3.056
a314R 3.024 1.410 0.502 2.838 a317R 4.056 1.259 0.003 3.147 a319R 3.795 1.201 -0.097 3.120 a320 3.680 1.259 -0.067 3.195 a421 5.372 1.089 -0.581 2.902 a422R 4.370 1.465 -0.102 2.446 a423 4.167 1.287 -0.029 2.829 a424 4.622 1.305 -0.262 3.055 a428 4.736 1.176 0.031 2.812 a429 4.618 1.273 -0.238 3.211 a434R 3.346 1.183 -0.124 2.799 a436R 3.531 1.171 -0.173 2.885 b101 5.070 1.076 -0.062 2.269 b102 4.491 1.233 -0.053 2.743 b203 4.601 1.267 -0.209 2.867 b104 4.323 1.114 0.033 3.716 b105R 4.380 1.354 -0.068 2.841 b206R 4.185 1.345 -0.046 2.603 b307R 3.668 1.228 0.103 3.235 b308 4.091 1.245 -0.234 3.672 b209R 4.793 1.218 -0.310 3.108 b310 3.877 1.287 0.207 3.215 b211 4.728 1.238 -0.214 2.888 b212 4.485 1.243 -0.278 3.342
>
> #準備畫圖,改成長形資料
> library(reshape)
> dtal_desc <- melt(dta_desc)
> names(dtal_desc)[1:2] <- c("動差", "題目")
> head(dtal_desc)
動差 題目 value 1 平均 a101 4.1267606 2 標準差 a101 1.4149362 3 偏態 a101 -0.1821249 4 峰度 a101 2.5174435 5 平均 a102R 3.9678068 6 標準差 a102R 1.2210229
> #繪製所有題目平均數
> windows()
> require(ggplot2)
> ggplot(data = subset(dtal_desc, 動差 == "平均"),
+ aes(x = reorder(題目, value, max), y = value, group = 動差)) + + geom_point(size = 3)+
+ geom_hline(yintercept = mean(t(dta_desc["平均",])) +
+ c(-1.5, 0, 1.5) * sd(t(dta_desc["平均",])), linetype = "dashed") + + coord_flip() +
+ labs(x = "題目", y = "平均")
> #繪製所有題目標準差
> #圖6.2
> windows()
> ggplot(data = subset(dtal_desc, 動差 == "標準差"),
+ aes(x = reorder(題目, value, max), y = value, group = 動差)) + + geom_point(size = 3)+
+ geom_hline(yintercept = mean(t(dta_desc["標準差",])) +
+ c(-1.5, 0, 1.5) * sd(t(dta_desc["標準差",])), linetype = "dashed") + + coord_flip() +
+ labs(x = "題目", y = "標準差")
> #繪製所有題目偏態
> windows()
> ggplot(data = subset(dtal_desc, 動差 == "偏態"),
+ aes(x = reorder(題目, value, max), y = value, group = 動差)) + + geom_point(size = 3)+
+ geom_hline(yintercept = mean(t(dta_desc["偏態",])) +
+ c(-1.5, 0, 1.5) * sd(t(dta_desc["偏態",])), linetype = "dashed") + + coord_flip() +
+ labs(x = "題目", y = "偏態")
> #繪製所有題目峰度
> windows()
> ggplot(data = subset(dtal_desc, 動差 == "峰度"),
+ aes(x = reorder(題目, value, max), y = value, group = 動差)) + + geom_point(size = 3)+
+ geom_hline(yintercept = mean(t(dta_desc["峰度",])) +
+ c(-1.5, 0, 1.5) * sd(t(dta_desc["峰度",])), linetype = "dashed") + + coord_flip() +
+ labs(x = "題目", y = "峰度")
> #計算區辨度。以總分為準,選取低分組與高分組,比較各題在兩組上的差
異。
> dta$tot <- apply(dta[4:39], 1, sum)
> dta$grp <- NA
> dta$grp[rank(dta$tot) < 485*.27] <- "L"
> dta$grp[rank(dta$tot) > 485*.73] <- "H"
> dta$grp <- factor(dta$grp)
> #算高低分組平均數
> dtam <- aggregate(dta[4:39], by=list(dta$grp), mean)
> #第一欄沒有用,刪掉
> dtam <- t(dtam[,-1])
> #t檢定
> item_t <- sapply(dta[4:39], function(x) t.test(x ~ dta$grp)$statistic)
> #將計算結果存於新資料框架rslt2中
> rslt2 <- data.frame(Item=rownames(dtam),m.l=dtam[,2], m.h=dtam[,1], m.dif=dtam[,1]-dtam[,2], t.stat=item_t)
> #畫出t檢定結果
> #圖6.3
> windows()
> ggplot(data = rslt2, aes(x=reorder(Item, t.stat, max), y=t.stat)) + + geom_point() +
+ geom_hline(yintercept = 2, linetype="dashed") + + coord_flip() +
+ labs(x = "題目", y = "t檢定值") + + theme_bw()
> #整理資料、命名欄位並四捨五入取至小數點後第3位
> #程式報表6.4
> rslt2 <- rslt2[,-1]
> names(rslt2) <- c('低分組平均','高分組平均','差異','t檢定')
> round(rslt2,3)
低分組平均 高分組平均 差異 t檢定
a101 3.109 5.094 1.986 12.983 a102R 3.124 4.775 1.651 11.287 a103 2.597 4.500 1.903 11.383 a104R 2.977 4.413 1.436 8.231 a106R 2.581 3.899 1.317 8.495 a107 2.550 4.239 1.689 11.495 a108R 2.364 3.703 1.339 9.370 a109R 2.612 4.319 1.706 11.404
a210 4.078 5.710 1.633 9.692 a211R 3.868 5.609 1.740 11.599 a212R 3.504 5.326 1.822 11.539 a213 3.891 5.580 1.688 11.181 a314R 2.450 3.623 1.174 6.628 a317R 3.395 4.826 1.431 8.686 a319R 3.016 4.638 1.622 11.234 a320 3.016 4.442 1.427 8.986 a421 4.953 5.964 1.010 7.875 a422R 3.589 5.304 1.715 10.084 a423 3.318 5.109 1.791 12.064 a424 3.698 5.717 2.020 13.466 a428 4.008 5.696 1.688 13.270 a429 3.729 5.674 1.945 13.853 a434R 2.868 3.572 0.704 4.554 a436R 3.178 3.848 0.670 4.260 b101 4.512 5.870 1.358 11.328 b102 3.535 5.464 1.929 14.324 b203 3.667 NA NA 14.218 b104 3.512 NA NA 12.705 b105R 3.465 5.623 2.158 14.566 b206R 3.380 5.145 1.765 11.635 b307R 2.915 4.428 1.513 9.914 b308 3.116 5.029 1.913 13.274 b209R 3.783 5.855 2.072 17.126 b310 3.132 4.536 1.404 8.450 b211 3.930 5.609 1.678 11.626 b212 3.473 5.471 1.998 14.701
> #利用psychometrics套件,計算題目與總分相關
> require(psychometric)
Loading required package: psychometric Attaching package: ‘psychometric’
The following object is masked from ‘package:psych’:
alpha
The following object is masked from ‘package:ggplot2’:
alpha
> itotr <- item.exam(dta[4:39], discrim = TRUE)
> #將資料轉換為包含4個資料框架的列
> ldta <- list(x = dta[4:12], y = dta[13:16], z = dta[17:23],w=dta[24:39])
> #計算題目與分量表總分相關
> isubr <- lapply(ldta, item.exam, discrim = TRUE)
> #整理分析結果並存檔
> rslt3 <- t(rbind(itotr$Item.Tot.woi,
+ c(isubr$x$Item.Tot.woi, isubr$y$Item.Tot.woi, isubr$z$Item.Tot.woi) ) )
Warning message:
In rbind(itotr$Item.Tot.woi, c(isubr$x$Item.Tot.woi, isubr$y$Item.Tot.woi, : number of columns of result is not a multiple of vector length (arg 2)
> #呈現第三部分
> rslt3 <- data.frame(rslt3)
> names(rslt3) <- c('題目總分相關','題目分量表相關')
> row.names(rslt3) <- names(dta[4:39])
> round(rslt3, 3)
題目總分相關 題目分量表相關
a101 0.535 0.576 a102R 0.546 0.584 a103 0.530 0.547 a104R 0.380 0.473 a106R 0.401 0.519 a107 0.487 0.550 a108R 0.418 0.527 a109R 0.509 0.696 a210 0.437 0.302 a211R 0.524 0.668 a212R 0.516 0.681 a213 0.537 0.616 a314R 0.343 0.253 a317R 0.460 0.435 a319R 0.549 0.472 a320 0.422 0.388
a421 0.365 0.337 a422R 0.490 0.445 a423 0.517 0.471 a424 0.588 0.500 a428 0.609 0.576 a429 0.605 0.584 a434R 0.229 0.547 a436R 0.196 0.473 b101 0.496 0.519 b102 0.606 0.550 b203 0.585 0.527 b104 0.600 0.696 b105R 0.584 0.302 b206R 0.477 0.668 b307R 0.524 0.681 b308 0.628 0.616 b209R 0.651 0.253 b310 0.435 0.435 b211 0.528 0.472 b212 0.629 0.388
>
> #題目信度
> isubrel <- c(isubr$x$Item.Rel.woi, isubr$y$Item.Rel.woi, isubr$z$Item.Rel.woi)
> #卸下psychometrics套件
> detach("package:psychometric", unload = TRUE)
> #載入psych,看總量表與分量表的 Cronbach alpha
> require(psych)
> #題目刪除後全量表信度變化
> itotalpha <- alpha(dta[4:39])$alpha.drop[,'raw_alpha']
> #題目刪除後分量表信度變化
> isubalpha <- lapply(ldta, alpha)
> ialphad <- c(isubalpha$x$alpha.drop[,'raw_alpha'], + isubalpha$y$alpha.drop[,'raw_alpha'], + isubalpha$z$alpha.drop[,'raw_alpha'])
> #把分析結果集中
> rslt4 <- as.data.frame(t(rbind(itotalpha, ialphad, isubrel))) Warning message:
In rbind(itotalpha, ialphad, isubrel) :
number of columns of result is not a multiple of vector length (arg 2)
> names(rslt4) <- c('總量表信度(刪題)', '分量表信度(刪題)', '題目信度')
> #加上題目名字、顯示三位
> #程式報表6.5
> row.names(rslt4) <- names(dta[4:39])
> round(rslt4, 3)
總量表信度(刪題) 分量表信度(刪題) 題目信度
a101 0.926 0.800 0.815 a102R 0.926 0.800 0.712 a103 0.926 0.804 0.771 a104R 0.928 0.813 0.634 a106R 0.928 0.807 0.661 a107 0.927 0.804 0.706 a108R 0.928 0.807 0.642 a109R 0.927 0.787 0.897 a210 0.928 0.834 0.429 a211R 0.927 0.615 0.882 a212R 0.927 0.603 0.952 a213 0.926 0.647 0.804 a314R 0.929 0.841 0.356 a317R 0.927 0.692 0.547 a319R 0.926 0.684 0.566 a320 0.928 0.703 0.488 a421 0.928 0.713 0.366 a422R 0.927 0.691 0.650 a423 0.927 0.683 0.606 a424 0.926 0.676 0.652 a428 0.926 0.800 0.815 a429 0.926 0.800 0.712 a434R 0.929 0.804 0.771 a436R 0.930 0.813 0.634 b101 0.927 0.807 0.661 b102 0.926 0.804 0.706 b203 0.926 0.807 0.642 b104 0.926 0.787 0.897 b105R 0.926 0.834 0.429 b206R 0.927 0.615 0.882 b307R 0.927 0.603 0.952
b308 0.925 0.647 0.804 b209R 0.925 0.841 0.356 b310 0.927 0.692 0.547 b211 0.926 0.684 0.566 b212 0.925 0.703 0.488
> #因素分析
> require(psych)
> print.psych(fa(dta[4:39], nfactor = 4, fm = "pa", rotate = "promax"), cut = .3) Factor Analysis using method = pa
Call: fa(r = dta[4:39], nfactors = 4, rotate = "promax", fm = "pa") Standardized loadings (pattern matrix) based upon correlation matrix PA1 PA2 PA3 PA4 h2 u2 com
a101 0.54 0.39 0.61 1.1 a102R 0.61 0.47 0.53 1.1 a103 0.52 0.37 0.63 1.4 a104R 0.61 0.33 0.67 1.2 a106R 0.62 0.32 0.68 1.1 a107 0.52 0.36 0.64 1.3 a108R 0.63 0.42 0.58 1.3 a109R 0.80 0.57 0.43 1.1 a210 0.80 0.53 0.47 1.1 a211R 0.74 0.60 0.40 1.1 a212R 0.84 0.66 0.34 1.2 a213 0.82 0.63 0.37 1.0 a314R 0.64 0.32 0.68 1.1 a317R 0.56 0.35 0.65 1.1 a319R 0.80 0.60 0.40 1.1 a320 0.44 0.25 0.75 1.1 a421 0.34 0.32 0.68 3.0 a422R 0.35 0.29 0.71 2.1 a423 0.31 0.29 0.71 2.1 a424 0.60 0.50 0.50 1.3 a428 0.80 0.66 0.34 1.2 a429 0.74 0.62 0.38 1.2 a434R 0.53 0.33 0.67 1.4 a436R 0.52 0.28 0.72 1.1 b101 0.78 0.50 0.50 1.1 b102 0.89 0.67 0.33 1.1
b203 0.81 0.58 0.42 1.1 b104 0.72 0.52 0.48 1.1 b105R 0.47 0.39 0.61 1.4 b206R 0.47 0.34 0.66 1.6 b307R 0.33 0.67 2.9 b308 0.74 0.59 0.41 1.1 b209R 0.69 0.61 0.39 1.4 b310 0.55 0.35 0.65 1.4 b211 0.84 0.56 0.44 1.1 b212 0.83 0.66 0.34 1.1
PA1 PA2 PA3 PA4 SS loadings 7.57 4.79 2.88 1.34
Proportion Var 0.21 0.13 0.08 0.04 Cumulative Var 0.21 0.34 0.42 0.46 Proportion Explained 0.46 0.29 0.17 0.08 Cumulative Proportion 0.46 0.75 0.92 1.00
With factor correlations of PA1 PA2 PA3 PA4 PA1 1.00 0.46 0.50 0.09 PA2 0.46 1.00 0.54 0.13 PA3 0.50 0.54 1.00 -0.05 PA4 0.09 0.13 -0.05 1.00
Mean item complexity = 1.3
Test of the hypothesis that 4 factors are sufficient.
The degrees of freedom for the null model are 630 and the objective function was 18.87 with Chi Square of 9117.67
The degrees of freedom for the model are 492 and the objective function was 3.33
The root mean square of the residuals (RMSR) is 0.04 The df corrected root mean square of the residuals is 0.05
The harmonic number of observations is 497 with the empirical chi square 1054.2 with prob < 4.8e-43
The total number of observations was 497 with MLE Chi Square = 1598.76 with prob < 4.3e-117
Tucker Lewis Index of factoring reliability = 0.832
RMSEA index = 0.069 and the 90 % confidence intervals are 0.064 0.071 BIC = -1455.86
Fit based upon off diagonal values = 0.98
Measures of factor score adequacy
PA1 PA2 PA3 PA4 Correlation of scores with factors 0.97 0.95 0.94 0.83
Multiple R square of scores with factors 0.95 0.90 0.88 0.69 Minimum correlation of possible factor scores 0.90 0.81 0.77 0.38
> #選題後,以另一個樣本驗證
> dta2 <- read.csv("mid_terma.csv", header = TRUE,sep=",")
> str(dta2)
'data.frame': 497 obs. of 88 variables:
$ team : int 2801 2801 2801 2801 2801 2801 2801 2801 2801 2801 ...
$ no : int 1 2 3 4 5 6 7 8 9 10 ...
$ personalily: int 7 9 5 6 6 6 5 8 8 5 ...
$ a101 : int 6 6 3 5 4 3 2 4 6 3 ...
$ a102R : int 4 4 4 4 3 4 4 4 6 1 ...
$ a103 : int 4 3 2 3 6 2 4 3 6 4 ...
$ a104R : int 4 6 4 3 2 2 2 5 6 5 ...
$ a106R : int 4 4 2 3 3 2 2 2 3 2 ...
$ a107 : int 4 3 2 4 3 3 1 2 4 4 ...
$ a108R : int 4 2 4 4 2 4 4 2 3 1 ...
$ a109R : int 5 2 4 4 3 4 4 4 6 2 ...
$ a210 : int 6 7 4 5 6 6 7 5 6 6 ...
$ a211R : int 6 6 4 4 4 7 5 4 6 2 ...
$ a212R : int 6 6 2 5 4 7 5 6 6 4 ...
$ a213 : int 6 6 4 5 4 7 4 4 6 6 ...
$ a314R : int 4 3 3 3 3 2 4 3 6 1 ...
$ a317R : int 5 4 4 4 4 5 4 3 6 1 ...
$ a319R : int 4 5 3 4 3 2 4 2 6 2 ...
$ a320 : int 4 4 2 2 3 4 4 2 6 4 ...
$ a421 : int 6 5 5 5 6 6 4 5 6 7 ...
$ a422R : int 2 5 5 4 4 2 7 3 6 7 ...
$ a423 : int 6 2 4 2 4 4 4 3 6 4 ...
$ a424 : int 4 4 6 4 4 2 4 5 6 7 ...
$ a428 : int 4 5 6 4 4 4 4 4 6 7 ...
$ a429 : int 4 5 6 4 4 4 4 4 6 7 ...
$ a434R : int 3 1 2 4 3 2 4 2 2 1 ...
$ a436R : int 3 2 4 3 3 2 4 4 2 4 ...
$ b101 : int 4 5 7 5 4 4 3 6 6 4 ...
$ b102 : int 4 4 6 4 4 4 4 6 6 4 ...
$ b203 : int 5 2 6 4 4 4 4 6 6 5 ...
$ b104 : int 4 4 6 4 4 4 4 4 6 7 ...
$ b105R : int 4 5 4 4 4 4 4 2 6 4 ...
$ b206R : int 5 5 5 5 4 4 4 4 6 4 ...
$ b307R : int 4 2 3 4 2 2 4 4 6 4 ...
$ b308 : int 3 3 4 3 3 4 3 4 6 4 ...
$ b209R : int 4 5 4 4 5 4 4 6 6 4 ...
$ b310 : int 4 4 4 3 4 4 1 4 6 5 ...
$ b211 : int 4 5 4 5 4 4 2 5 6 5 ...
$ b212 : int 4 4 4 4 4 3 4 6 6 6 ...
$ b313R : int 4 5 4 4 3 4 4 5 6 4 ...
$ b314 : int 4 3 6 4 4 6 4 6 6 6 ...
$ b215R : int 3 4 4 4 2 2 1 3 2 4 ...
$ c101 : int 6 7 4 5 4 6 4 6 6 6 ...
$ c102 : int 5 6 3 4 4 6 4 5 6 6 ...
$ c103R : int 6 6 4 5 5 6 5 3 6 6 ...
$ c104 : int 6 6 4 4 4 5 4 4 6 6 ...
$ c405R : int 6 6 4 6 5 7 5 3 6 6 ...
$ c106 : int 6 7 4 3 4 6 4 5 6 7 ...
$ c107 : int 6 6 4 3 4 6 4 5 6 6 ...
$ c108 : int 6 7 4 5 4 6 4 6 6 7 ...
$ c109R : int 6 6 4 4 4 6 4 3 6 6 ...
$ c110R : int 7 6 4 5 5 4 5 3 2 1 ...
$ c111 : int 6 6 6 4 4 6 4 6 6 7 ...
$ c212R : int 6 6 4 5 4 6 4 2 6 7 ...
$ c213 : int 6 7 5 5 4 6 4 6 6 7 ...
$ c114 : int 6 6 4 4 4 4 4 4 6 6 ...
$ c215 : int 6 7 4 5 4 6 4 6 6 7 ...
$ c116 : int 6 6 3 5 4 6 4 6 6 6 ...
$ c417 : int 5 6 6 5 4 4 4 6 6 6 ...
$ c318 : int 6 5 4 5 4 5 4 6 6 6 ...
$ c319 : int 6 6 4 5 5 4 5 6 6 6 ...
$ c320R : int 7 6 3 5 5 6 5 6 6 7 ...
$ c321 : int 6 6 3 3 4 6 4 6 6 6 ...
$ c122 : int 6 6 3 4 4 6 4 6 6 6 ...
$ c123 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c224 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c125 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c226 : int 6 7 3 5 4 6 4 6 6 6 ...
$ c327 : int 6 6 3 5 4 6 4 6 6 6 ...
$ c328R : int 7 5 3 5 4 6 4 6 6 7 ...
$ c429 : int 6 7 3 5 4 4 4 6 6 6 ...
$ c230 : int 6 6 3 5 5 6 5 6 6 6 ...
$ c331 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c432 : int 5 6 3 4 4 4 4 6 6 6 ...
$ c433 : int 5 6 3 4 4 4 4 4 6 6 ...
$ c434 : int 6 7 3 5 4 4 4 6 6 5 ...
$ c435 : int 6 6 4 3 4 6 4 6 2 6 ...
$ d101 : int 6 6 6 5 5 6 6 5 6 7 ...
$ d102 : int 6 5 6 5 5 6 5 6 6 7 ...
$ d103R : int 5 6 6 5 5 6 7 6 6 2 ...
$ d204 : int 5 6 6 5 5 6 4 5 6 6 ...
$ d205 : int 6 6 6 5 5 6 7 6 6 6 ...
$ d206 : int 5 5 6 5 5 6 5 6 6 7 ...
$ d207 : int 6 6 6 5 5 6 6 6 6 6 ...
$ d308 : int 4 5 5 4 5 4 4 5 6 7 ...
$ d309R : int 3 4 3 5 4 2 4 2 6 1 ...
$ d310 : int 5 5 6 4 4 6 4 6 6 6 ...
$ d311 : int 4 4 4 5 4 6 4 4 6 6 ...
> names(dta2[4:27])
[1] "a101" "a102R" "a103" "a104R" "a106R" "a107" "a108R" "a109R" "a210"
[10] "a211R" "a212R" "a213" "a314R" "a317R" "a319R" "a320" "a421" "a422R"
[19] "a423" "a424" "a428" "a429" "a434R" "a436R"
> #平行分析看看因素數
> #圖6.5
> fa.parallel(dta2[4:27], fa = "pc", show.legend = FALSE)
Parallel analysis suggests that the number of factors = NA and the number of components = 4
> #設定因素數是4、因素分析結果
> #程式報表6.8, 6.9
> print.psych(fa(dta2[4:27], fm = "pa", nfactor = 4, rotate = "promax"), cut = .3) Factor Analysis using method = pa
Call: fa(r = dta2[4:27], nfactors = 4, rotate = "promax", fm = "pa") Standardized loadings (pattern matrix) based upon correlation matrix PA1 PA2 PA3 PA4 h2 u2 com
a101 0.50 0.40 0.60 1.3 a102R 0.59 0.45 0.55 1.1 a103 0.52 0.37 0.63 1.4 a104R 0.55 0.31 0.69 1.4 a106R 0.63 0.33 0.67 1.1 a107 0.54 0.34 0.66 1.1 a108R 0.69 0.41 0.59 1.2 a109R 0.82 0.59 0.41 1.0 a210 0.78 0.54 0.46 1.0 a211R 0.69 0.58 0.42 1.1 a212R 0.84 0.69 0.31 1.1 a213 0.82 0.66 0.34 1.0 a314R 0.60 0.30 0.70 1.1 a317R 0.54 0.34 0.66 1.1 a319R 0.81 0.61 0.39 1.1 a320 0.42 0.25 0.75 1.1 a421 0.44 0.32 0.68 2.0 a422R 0.47 0.31 0.69 1.2 a423 0.34 0.28 0.72 1.8 a424 0.80 0.61 0.39 1.0 a428 0.87 0.65 0.35 1.0 a429 0.96 0.76 0.24 1.0 a434R 0.72 0.58 0.42 1.1 a436R 0.79 0.61 0.39 1.1
PA1 PA2 PA3 PA4 SS loadings 4.55 2.89 2.62 1.23
Proportion Var 0.19 0.12 0.11 0.05 Cumulative Var 0.19 0.31 0.42 0.47 Proportion Explained 0.40 0.26 0.23 0.11 Cumulative Proportion 0.40 0.66 0.89 1.00
With factor correlations of PA1 PA2 PA3 PA4 PA1 1.00 0.47 0.52 0.18 PA2 0.47 1.00 0.53 0.01 PA3 0.52 0.53 1.00 0.08 PA4 0.18 0.01 0.08 1.00
Mean item complexity = 1.2
Test of the hypothesis that 4 factors are sufficient.
The degrees of freedom for the null model are 276 and the objective function was 10.21 with Chi Square of 4971.9
The degrees of freedom for the model are 186 and the objective function was 1.2
The root mean square of the residuals (RMSR) is 0.04 The df corrected root mean square of the residuals is 0.05
The harmonic number of observations is 497 with the empirical chi square 400.52 with prob < 8.8e-18
The total number of observations was 497 with MLE Chi Square = 580.16 with prob < 4.4e-42
Tucker Lewis Index of factoring reliability = 0.875
RMSEA index = 0.066 and the 90 % confidence intervals are 0.059 0.071 BIC = -574.64
Fit based upon off diagonal values = 0.98
Measures of factor score adequacy
PA1 PA2 PA3 PA4 Correlation of scores with factors 0.95 0.95 0.94 0.87
Multiple R square of scores with factors 0.90 0.90 0.88 0.75 Minimum correlation of possible factor scores 0.80 0.80 0.76 0.50
> #定義分量表
> ldta2 <- list(x = dta2[4:11], y = dta2[12:15], z = dta2[16:19],w=dta2[20:27])
> #分量表信度
> lapply(ldta2, alpha)
$x
Reliability analysis
Call: FUN(x = X[[i]])
raw_alpha std.alpha G6(smc) average_r S/N ase mean sd 0.83 0.83 0.83 0.39 5.1 0.011 3.6 0.89
lower alpha upper 95% confidence boundaries 0.81 0.83 0.86
Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N alpha se a101 0.81 0.81 0.81 0.39 4.4 0.013 a102R 0.81 0.82 0.81 0.39 4.4 0.013 a103 0.82 0.82 0.81 0.39 4.5 0.013 a104R 0.82 0.82 0.82 0.40 4.7 0.012 a106R 0.82 0.82 0.81 0.39 4.5 0.013 a107 0.82 0.82 0.81 0.39 4.5 0.013 a108R 0.82 0.82 0.81 0.39 4.5 0.013 a109R 0.80 0.80 0.78 0.36 3.9 0.014
Item statistics
n raw.r std.r r.cor r.drop mean sd a101 497 0.69 0.68 0.63 0.57 4.1 1.4 a102R 497 0.67 0.68 0.62 0.56 4.0 1.2 a103 497 0.68 0.67 0.60 0.55 3.5 1.4 a104R 497 0.63 0.63 0.55 0.49 3.7 1.3 a106R 497 0.66 0.66 0.60 0.54 3.3 1.3 a107 497 0.67 0.66 0.60 0.54 3.5 1.3 a108R 497 0.65 0.66 0.60 0.54 3.1 1.2 a109R 497 0.79 0.79 0.78 0.70 3.5 1.3
Non missing response frequency for each item
1 2 3 4 5 6 7 miss a101 0.04 0.09 0.15 0.37 0.11 0.21 0.02 0
a102R 0.03 0.09 0.15 0.49 0.11 0.11 0.02 0 a103 0.07 0.17 0.25 0.29 0.08 0.12 0.01 0 a104R 0.05 0.17 0.13 0.43 0.11 0.09 0.01 0 a106R 0.08 0.22 0.23 0.35 0.07 0.04 0.01 0 a107 0.07 0.17 0.23 0.38 0.09 0.05 0.01 0
a108R 0.08 0.27 0.26 0.29 0.06 0.03 0.00 0 a109R 0.06 0.21 0.16 0.41 0.09 0.06 0.00 0
$y
Reliability analysis Call: FUN(x = X[[i]])
raw_alpha std.alpha G6(smc) average_r S/N ase mean sd 0.86 0.86 0.83 0.61 6.2 0.01 4.7 1.1
lower alpha upper 95% confidence boundaries 0.84 0.86 0.88
Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N alpha se a210 0.84 0.84 0.78 0.64 5.3 0.012 a211R 0.83 0.83 0.77 0.62 5.0 0.013 a212R 0.80 0.80 0.74 0.58 4.1 0.015 a213 0.81 0.81 0.75 0.59 4.3 0.015
Item statistics
n raw.r std.r r.cor r.drop mean sd a210 497 0.82 0.81 0.72 0.66 5.0 1.4 a211R 497 0.82 0.82 0.74 0.68 4.7 1.3 a212R 497 0.87 0.87 0.81 0.75 4.5 1.4 a213 497 0.85 0.86 0.79 0.74 4.8 1.3
Non missing response frequency for each item
1 2 3 4 5 6 7 miss a210 0.02 0.05 0.06 0.24 0.15 0.38 0.09 0
a211R 0.02 0.05 0.06 0.37 0.17 0.27 0.07 0 a212R 0.03 0.08 0.06 0.37 0.17 0.24 0.05 0 a213 0.02 0.05 0.04 0.36 0.18 0.30 0.07 0
$z
Reliability analysis
Call: FUN(x = X[[i]])
raw_alpha std.alpha G6(smc) average_r S/N ase mean sd 0.75 0.75 0.7 0.42 3 0.019 3.6 0.97
lower alpha upper 95% confidence boundaries 0.71 0.75 0.78
Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N alpha se a314R 0.67 0.67 0.59 0.41 2.0 0.026 a317R 0.68 0.68 0.59 0.42 2.1 0.025 a319R 0.65 0.65 0.56 0.38 1.9 0.027 a320 0.74 0.75 0.66 0.49 2.9 0.020
Item statistics
n raw.r std.r r.cor r.drop mean sd a314R 497 0.79 0.77 0.66 0.57 3.0 1.4 a317R 497 0.76 0.76 0.65 0.56 4.1 1.3 a319R 497 0.78 0.79 0.70 0.61 3.8 1.2 a320 497 0.68 0.69 0.50 0.44 3.7 1.3
Non missing response frequency for each item
1 2 3 4 5 6 7 miss a314R 0.14 0.29 0.18 0.28 0.05 0.04 0.02 0
a317R 0.02 0.10 0.13 0.47 0.13 0.12 0.03 0 a319R 0.03 0.14 0.14 0.49 0.12 0.08 0.01 0 a320 0.06 0.13 0.16 0.48 0.09 0.07 0.01 0
$w
Reliability analysis Call: FUN(x = X[[i]])
raw_alpha std.alpha G6(smc) average_r S/N ase mean sd 0.75 0.75 0.79 0.27 2.9 0.017 4.3 0.75 lower alpha upper 95% confidence boundaries
0.72 0.75 0.78
Reliability if an item is dropped:
raw_alpha std.alpha G6(smc) average_r S/N alpha se a421 0.74 0.73 0.78 0.28 2.7 0.018 a422R 0.72 0.72 0.77 0.26 2.5 0.019 a423 0.73 0.72 0.78 0.27 2.6 0.018 a424 0.68 0.68 0.73 0.23 2.1 0.022 a428 0.69 0.69 0.73 0.24 2.2 0.021 a429 0.68 0.68 0.72 0.23 2.1 0.022 a434R 0.77 0.77 0.78 0.32 3.4 0.015 a436R 0.76 0.76 0.78 0.31 3.2 0.015
Item statistics
n raw.r std.r r.cor r.drop mean sd a421 497 0.53 0.55 0.44 0.38 5.4 1.1 a422R 497 0.65 0.62 0.53 0.47 4.4 1.5 a423 497 0.59 0.58 0.47 0.42 4.2 1.3 a424 497 0.78 0.77 0.76 0.67 4.6 1.3 a428 497 0.74 0.74 0.74 0.63 4.7 1.2 a429 497 0.78 0.77 0.79 0.67 4.6 1.3 a434R 497 0.34 0.36 0.25 0.16 3.3 1.2 a436R 497 0.39 0.41 0.31 0.21 3.5 1.2
Non missing response frequency for each item
1 2 3 4 5 6 7 miss a421 0.00 0.01 0.03 0.22 0.19 0.44 0.11 0
a422R 0.02 0.10 0.13 0.32 0.18 0.18 0.07 0 a423 0.02 0.08 0.15 0.43 0.13 0.17 0.02 0 a424 0.02 0.04 0.06 0.44 0.13 0.25 0.06 0 a428 0.01 0.02 0.04 0.47 0.15 0.25 0.06 0 a429 0.02 0.04 0.05 0.43 0.17 0.22 0.06 0 a434R 0.07 0.18 0.21 0.44 0.05 0.04 0.00 0 a436R 0.05 0.17 0.18 0.47 0.08 0.06 0.00 0
> #總量表信度
> require(psych)
> omega(dta2[4:27], nfactor = 4)
Omega
Call: omega(m = dta2[4:27], nfactors = 4) Alpha: 0.89
G.6: 0.92 Omega Hierarchical: 0.59 Omega H asymptotic: 0.64 Omega Total 0.92
Schmid Leiman Factor loadings greater than 0.2
g F1* F2* F3* F4* h2 u2 p2 a101 0.46 0.39 0.39 0.61 0.53 a102R 0.49 0.45 0.45 0.55 0.53 a103 0.39 0.40 0.36 0.64 0.43 a104R 0.32 0.43 0.31 0.69 0.34 a106R 0.32 0.48 0.33 0.67 0.31 a107 0.39 0.41 0.33 0.67 0.45 a108R 0.37 0.50 0.41 0.59 0.33 a109R 0.46 0.60 0.57 0.43 0.37 a210 0.55 0.48 0.54 0.46 0.57 a211R 0.62 0.44 0.59 0.41 0.66 a212R 0.65 0.51 0.69 0.31 0.61 a213 0.63 0.50 0.65 0.35 0.60 a314R 0.32 0.45 0.30 0.70 0.34 a317R 0.42 0.40 0.35 0.65 0.51 a319R 0.49 0.59 0.60 0.40 0.39 a320 0.37 0.32 0.25 0.75 0.55 a421 0.34 0.34 0.30 0.70 0.38 a422R 0.37 0.39 0.31 0.69 0.44 a423 0.39 0.28 0.27 0.73 0.59 a424 0.42 0.62 0.57 0.43 0.31 a428 0.40 0.73 0.69 0.31 0.23 a429 0.41 0.79 0.79 0.21 0.21 a434R 0.22 0.67 0.53 0.47 0.09 a436R 0.82 0.69 0.31 0.03
With eigenvalues of:
g F1* F2* F3* F4*
4.4 2.6 2.0 1.0 1.2
general/max 1.71 max/min = 2.56
mean percent general = 0.41 with sd = 0.16 and cv of 0.4 Explained Common Variance of the general factor = 0.39
The degrees of freedom are 186 and the fit is 1.18
The number of observations was 497 with Chi Square = 571.91 with prob <
7.3e-41
The root mean square of the residuals is 0.04
The df corrected root mean square of the residuals is 0.05
RMSEA index = 0.066 and the 90 % confidence intervals are 0.059 0.071 BIC = -582.89
Compare this with the adequacy of just a general factor and no group factors The degrees of freedom for just the general factor are 252 and the fit is 5.03 The number of observations was 497 with Chi Square = 2446.56 with prob <
0
The root mean square of the residuals is 0.15
The df corrected root mean square of the residuals is 0.15
RMSEA index = 0.134 and the 90 % confidence intervals are 0.128 0.137 BIC = 882
Measures of factor score adequacy
g F1* F2* F3*
F4*
Correlation of scores with factors 0.81 0.82 0.89 0.67 0.88 Multiple R square of scores with factors 0.66 0.67 0.79 0.45 0.77 Minimum correlation of factor score estimates 0.32 0.35 0.57 -0.10 0.53
Total, General and Subset omega for each subset
g F1* F2* F3*
F4*
Omega total for total scores and subscales 0.92 0.88 0.82 0.87 0.75 Omega general for total scores and subscales 0.59 0.38 0.29 0.53 0.04 Omega group for total scores and subscales 0.27 0.49 0.53 0.33 0.71
>
> #---
>
> #定義一個函數,可以同時
> #計算題目的平均數、標準差、偏態與峰度
> my_summary <- function(x) { + require(moments)
+ funs <- c(mean, sd, skewness, kurtosis) + sapply(funs, function(f) f(x, na.rm = TRUE)) + }
> #一次算完所有題目前四級動差,並存成資料檔
> dta_desc1 <- apply(dta2[4:27], 2, my_summary)
> rownames(dta_desc1) <- c("平均", "標準差", "偏態", "峰度")
> rslt1 <- as.data.frame(t(dta_desc))
> round(rslt1,3)
平均 標準差 偏態 峰度 a101 4.127 1.415 -0.182 2.517 a102R 3.968 1.221 -0.025 3.316 a103 3.543 1.411 0.205 2.445 a104R 3.712 1.341 -0.053 2.680 a106R 3.282 1.275 0.221 2.905 a107 3.451 1.285 0.087 2.935 a108R 3.089 1.218 0.319 2.832 a109R 3.463 1.292 -0.002 2.583 a210 4.952 1.422 -0.736 2.993 a211R 4.726 1.320 -0.361 2.911 a212R 4.507 1.400 -0.394 2.817 a213 4.789 1.307 -0.463 3.056 a314R 3.024 1.410 0.502 2.838 a317R 4.056 1.259 0.003 3.147 a319R 3.795 1.201 -0.097 3.120 a320 3.680 1.259 -0.067 3.195 a421 5.372 1.089 -0.581 2.902 a422R 4.370 1.465 -0.102 2.446 a423 4.167 1.287 -0.029 2.829 a424 4.622 1.305 -0.262 3.055 a428 4.736 1.176 0.031 2.812 a429 4.618 1.273 -0.238 3.211 a434R 3.346 1.183 -0.124 2.799 a436R 3.531 1.171 -0.173 2.885
b101 5.070 1.076 -0.062 2.269 b102 4.491 1.233 -0.053 2.743 b203 4.601 1.267 -0.209 2.867 b104 4.323 1.114 0.033 3.716 b105R 4.380 1.354 -0.068 2.841 b206R 4.185 1.345 -0.046 2.603 b307R 3.668 1.228 0.103 3.235 b308 4.091 1.245 -0.234 3.672 b209R 4.793 1.218 -0.310 3.108 b310 3.877 1.287 0.207 3.215 b211 4.728 1.238 -0.214 2.888 b212 4.485 1.243 -0.278 3.342
> #CESD 的四因素模型
> #寫法是 因素 =~ 測量指標
> CESD.M1 <- '
+ 薪資福利=~a101+a102R+a103+a104R+a106R+a107+a108R+a109R + 上司互動=~a210+a211R+a212R+a213
+ 公平知覺=~a314R+a317R+a319R+a320
+ 工作特性=~a421+a422R+a423+a424+a428+a429+a434R+a436R'
> #跑 CFA,要註明模型 CESD.M1 與資料名稱 dta
> fit <- cfa(CESD.M1, data=dta2[4:27],std.lv=TRUE)
> #輸出結果
> #程式報表7.3, 7.4
> summary(fit, fit.measures=TRUE)
lavaan (0.5-22) converged normally after 24 iterations
Number of observations 497
Estimator ML Minimum Function Test Statistic 1039.782 Degrees of freedom 246 P-value (Chi-square) 0.000 Model test baseline model:
Minimum Function Test Statistic 5072.256 Degrees of freedom 276 P-value 0.000
User model versus baseline model:
Comparative Fit Index (CFI) 0.834 Tucker-Lewis Index (TLI) 0.814 Loglikelihood and Information Criteria:
Loglikelihood user model (H0) -17912.213 Loglikelihood unrestricted model (H1) -17392.322
Number of free parameters 54 Akaike (AIC) 35932.426 Bayesian (BIC) 36159.690 Sample-size adjusted Bayesian (BIC) 35988.292 Root Mean Square Error of Approximation:
RMSEA 0.081 90 Percent Confidence Interval 0.076 0.086
P-value RMSEA <= 0.05 0.000 Standardized Root Mean Square Residual:
SRMR 0.083 Parameter Estimates:
Information Expected Standard Errors Standard
Latent Variables:
Estimate Std.Err z-value P(>|z|) 薪資福利 =~
a101 0.885 0.060 14.665 0.000 a102R 0.803 0.051 15.631 0.000 a103 0.841 0.061 13.831 0.000 a104R 0.731 0.059 12.407 0.000
a106R 0.741 0.055 13.396 0.000 a107 0.763 0.055 13.765 0.000 a108R 0.754 0.052 14.472 0.000 a109R 0.986 0.052 19.138 0.000 上司互動 =~
a210 1.013 0.058 17.377 0.000 a211R 1.022 0.052 19.482 0.000 a212R 1.160 0.054 21.469 0.000 a213 1.042 0.051 20.321 0.000 公平知覺 =~
a314R 0.854 0.062 13.779 0.000 a317R 0.806 0.055 14.751 0.000 a319R 0.987 0.049 20.347 0.000 a320 0.648 0.057 11.358 0.000 工作特性 =~
a421 0.531 0.048 10.962 0.000 a422R 0.794 0.064 12.416 0.000 a423 0.592 0.058 10.277 0.000 a424 0.989 0.052 19.043 0.000 a428 0.968 0.045 21.420 0.000 a429 1.109 0.048 23.333 0.000 a434R 0.065 0.056 1.157 0.247 a436R 0.116 0.056 2.096 0.036
Covariances:
Estimate Std.Err z-value P(>|z|) 薪資福利 ~~
上司互動 0.530 0.040 13.237 0.000 公平知覺 0.838 0.026 32.300 0.000 工作特性 0.402 0.045 8.986 0.000 上司互動 ~~
公平知覺 0.518 0.043 12.127 0.000 工作特性 0.453 0.042 10.728 0.000 公平知覺 ~~
工作特性 0.309 0.050 6.224 0.000 Variances:
Estimate Std.Err z-value P(>|z|)
.a101 1.215 0.085 14.309 0.000 .a102R 0.844 0.060 14.036 0.000 .a103 1.278 0.088 14.514 0.000 .a104R 1.260 0.085 14.809 0.000 .a106R 1.074 0.073 14.611 0.000 .a107 1.065 0.073 14.529 0.000 .a108R 0.913 0.064 14.359 0.000 .a109R 0.692 0.055 12.565 0.000 .a210 0.991 0.074 13.371 0.000 .a211R 0.695 0.057 12.246 0.000 .a212R 0.610 0.058 10.587 0.000 .a213 0.617 0.053 11.630 0.000 .a314R 1.254 0.090 13.999 0.000 .a317R 0.933 0.068 13.636 0.000 .a319R 0.464 0.051 9.137 0.000 .a320 1.162 0.079 14.679 0.000 .a421 0.902 0.060 15.138 0.000 .a422R 1.510 0.101 14.923 0.000 .a423 1.301 0.085 15.224 0.000 .a424 0.722 0.056 12.940 0.000 .a428 0.444 0.040 11.219 0.000 .a429 0.386 0.043 9.074 0.000 .a434R 1.393 0.088 15.758 0.000 .a436R 1.354 0.086 15.744 0.000 薪資福利 1.000 上司互動 1.000 公平知覺 1.000 工作特性 1.000
> #定義分量表與分量表題號
> scale1 <- c(1,4:11)
> scale2 <- c(2,12:15)
> scale3 <- c(3,16:19)
> scale4 <- c(4,20:27)
>
> #定義如何計算構念信度、題目信度與平均變異抽取量
> my_reli <- function(w){
+ x <- w[-1]
+ y <- w[1]
+ L <- fit@Model@GLIST$lambda[x,y]
+ P <- diag(fit@Model@GLIST$psi)[y]
+ E <- diag(fit@Model@GLIST$theta)[x]
+ reli <- sum(L)^2*P/(sum(L)^2*P+sum(E)) + itemreli <- L*L*P/(L*L*P+E)
+ AVE <- mean(itemreli)
+ show(my_reli <- list(reli=reli,itemreli=itemreli,AVE=AVE)) + }
> my_reli(scale1)
$reli
[1] 0.6840411
$itemreli
[1] 0.2977593 0.3383395 0.3536959 0.3834859 0.5842508 0.0000000 0.0000000 [8] 0.0000000
$AVE
[1] 0.2446914
> scale <- list(scale1,scale2,scale3,scale4)
> lapply(scale,my_reli)
$reli
[1] 0.6840411
$itemreli
[1] 0.2977593 0.3383395 0.3536959 0.3834859 0.5842508 0.0000000 0.0000000 [8] 0.0000000
$AVE
[1] 0.2446914
$reli
[1] 0.2494404
$itemreli
[1] 0.6376169 0.0000000 0.0000000 0.0000000
$AVE
[1] 0.1594042
$reli
[1] 0.07932763
$itemreli
[1] 0.2655302 0.0000000 0.0000000 0.0000000
$AVE
[1] 0.06638254
>
組織承諾刪題=9 11 14 9 11
> #讀進資料
> dta <- read.csv("mid_termb.csv", header = T,sep=",")
> class(dta) [1] "data.frame"
> dim(dta) [1] 497 61
> dta_count <- array(dim(dta),1)
> na.fail(dta)
Error in na.fail.default(dta) : missing values in object
> dta_count <- array(dim(dta),1)
> show(apply(apply(dta, 2, is.na), 2, sum)/497)
team no personalily b101 b102 b104 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.002012072 b105R b203 b206R b212 b215R b307R
0.000000000 0.002012072 0.000000000 0.000000000 0.000000000 0.000000000 b308 b310 b313R c101 c102 c103R
0.000000000 0.000000000 0.000000000 0.002012072 0.000000000 0.000000000 c104 c405R c106 c107 c108 c109R
0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 c110R c111 c212R c213 c114
c215
0.000000000 0.002012072 0.000000000 0.000000000 0.000000000 0.002012072 c116 c417 c318 c319 c320R c321
0.000000000 0.000000000 0.000000000 0.002012072 0.000000000 0.000000000 c122 c123 c224 c125 c226 c327
0.000000000 0.000000000 0.000000000 0.000000000 0.002012072 0.000000000 c328R c429 c230 c331 c432 c433
0.000000000 0.000000000 0.000000000 0.000000000 0.002012072 0.000000000 c434 c435 d101 d102 d103R d204
0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 d205 d206 d207 d308 d309R d310
0.000000000 0.000000000 0.002012072 0.002012072 0.000000000 0.000000000 d311
0.000000000
> #所有NA請立即離開現場
> nadta<-na.exclude(dta)
> dim(nadta) [1] 487 61
> #以str看一下資料結構、看一下最後六題,確認樣本數是多少
> #程式報表6.1
> str(nadta)
'data.frame': 487 obs. of 61 variables:
$ team : int 2801 2801 2801 2801 2801 2801 2801 2801 2801 2801 ...
$ no : int 1 2 3 4 5 6 7 8 9 10 ...
$ personalily: int 7 9 5 6 6 6 5 8 8 5 ...
$ b101 : int 4 5 7 5 4 4 3 6 6 4 ...
$ b102 : int 4 4 6 4 4 4 4 6 6 4 ...
$ b104 : int 4 4 6 4 4 4 4 4 6 7 ...
$ b105R : int 4 5 4 4 4 4 4 2 6 4 ...
$ b203 : int 5 2 6 4 4 4 4 6 6 5 ...
$ b206R : int 5 5 5 5 4 4 4 4 6 4 ...
$ b212 : int 4 4 4 4 4 3 4 6 6 6 ...
$ b215R : int 3 4 4 4 2 2 1 3 2 4 ...
$ b307R : int 4 2 3 4 2 2 4 4 6 4 ...
$ b308 : int 3 3 4 3 3 4 3 4 6 4 ...
$ b310 : int 4 4 4 3 4 4 1 4 6 5 ...
$ b313R : int 4 5 4 4 3 4 4 5 6 4 ...
$ c101 : int 6 7 4 5 4 6 4 6 6 6 ...
$ c102 : int 5 6 3 4 4 6 4 5 6 6 ...
$ c103R : int 6 6 4 5 5 6 5 3 6 6 ...
$ c104 : int 6 6 4 4 4 5 4 4 6 6 ...
$ c405R : int 6 6 4 6 5 7 5 3 6 6 ...
$ c106 : int 6 7 4 3 4 6 4 5 6 7 ...
$ c107 : int 6 6 4 3 4 6 4 5 6 6 ...
$ c108 : int 6 7 4 5 4 6 4 6 6 7 ...
$ c109R : int 6 6 4 4 4 6 4 3 6 6 ...
$ c110R : int 7 6 4 5 5 4 5 3 2 1 ...
$ c111 : int 6 6 6 4 4 6 4 6 6 7 ...
$ c212R : int 6 6 4 5 4 6 4 2 6 7 ...
$ c213 : int 6 7 5 5 4 6 4 6 6 7 ...
$ c114 : int 6 6 4 4 4 4 4 4 6 6 ...
$ c215 : int 6 7 4 5 4 6 4 6 6 7 ...
$ c116 : int 6 6 3 5 4 6 4 6 6 6 ...
$ c417 : int 5 6 6 5 4 4 4 6 6 6 ...
$ c318 : int 6 5 4 5 4 5 4 6 6 6 ...
$ c319 : int 6 6 4 5 5 4 5 6 6 6 ...
$ c320R : int 7 6 3 5 5 6 5 6 6 7 ...
$ c321 : int 6 6 3 3 4 6 4 6 6 6 ...
$ c122 : int 6 6 3 4 4 6 4 6 6 6 ...
$ c123 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c224 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c125 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c226 : int 6 7 3 5 4 6 4 6 6 6 ...
$ c327 : int 6 6 3 5 4 6 4 6 6 6 ...
$ c328R : int 7 5 3 5 4 6 4 6 6 7 ...
$ c429 : int 6 7 3 5 4 4 4 6 6 6 ...
$ c230 : int 6 6 3 5 5 6 5 6 6 6 ...
$ c331 : int 5 6 3 4 4 6 4 6 6 6 ...
$ c432 : int 5 6 3 4 4 4 4 6 6 6 ...
$ c433 : int 5 6 3 4 4 4 4 4 6 6 ...
$ c434 : int 6 7 3 5 4 4 4 6 6 5 ...
$ c435 : int 6 6 4 3 4 6 4 6 2 6 ...
$ d101 : int 6 6 6 5 5 6 6 5 6 7 ...
$ d102 : int 6 5 6 5 5 6 5 6 6 7 ...
$ d103R : int 5 6 6 5 5 6 7 6 6 2 ...
$ d204 : int 5 6 6 5 5 6 4 5 6 6 ...
$ d205 : int 6 6 6 5 5 6 7 6 6 6 ...
$ d206 : int 5 5 6 5 5 6 5 6 6 7 ...
$ d207 : int 6 6 6 5 5 6 6 6 6 6 ...
$ d308 : int 4 5 5 4 5 4 4 5 6 7 ...
$ d309R : int 3 4 3 5 4 2 4 2 6 1 ...
$ d310 : int 5 5 6 4 4 6 4 6 6 6 ...
$ d311 : int 4 4 4 5 4 6 4 4 6 6 ...
- attr(*, "na.action")=Class 'exclude' Named int [1:10] 149 206 226 285 351 373 385 430 456 472
.. ..- attr(*, "names")= chr [1:10] "149" "206" "226" "285" ...
> tail(nadta)
team no personalily b101 b102 b104 b105R b203 b206R b212 b215R b307R 492 3701 615 9 6 5 5 6 5 5 5 5 5
493 3701 616 9 6 5 5 6 5 5 5 5 5
494 3701 619 9 6 5 5 6 5 5 5 5 5
495 3701 620 7 7 6 6 7 6 3 4 2 5
496 3701 621 9 6 5 5 6 5 5 5 5 5
497 3701 622 8 7 6 6 7 6 3 4 2 5
b308 b310 b313R c101 c102 c103R c104 c405R c106 c107 c108 c109R c110R 492 6 3 6 6 6 5 5 2 6 6 6 6 6
493 6 3 6 6 6 5 5 2 6 6 6 6 6
494 6 3 6 6 6 5 5 2 6 6 6 6 6
495 4 3 3 5 6 3 6 3 5 5 4 3 4
496 6 3 6 6 6 5 5 2 6 6 6 6 6
497 4 3 3 5 6 3 6 3 5 5 4 3 4
c111 c212R c213 c114 c215 c116 c417 c318 c319 c320R c321 c122 c123 c224 492 6 6 5 5 6 6 6 6 6 5 6 6 6 6
493 6 6 5 5 6 6 6 6 6 5 6 6 6 6
494 6 6 5 5 6 6 6 6 6 5 6 6 6 6
495 5 3 6 5 4 4 4 4 4 3 5 4 4 4
496 6 6 5 5 6 6 6 6 6 5 6 6 6 6
497 5 3 6 5 4 4 4 4 4 3 5 4 4 4
c125 c226 c327 c328R c429 c230 c331 c432 c433 c434 c435 d101 d102 d103R 492 6 6 6 6 6 6 6 5 5 6 5 6 6 6
493 6 6 6 6 6 6 6 5 5 6 5 6 6 6
494 6 6 6 6 6 6 6 5 5 6 5 6 6 6
495 4 3 3 4 4 4 3 4 6 4 4 7 7 6
496 6 6 6 6 6 6 6 5 5 6 5 6 6 6
497 4 3 3 4 4 4 3 4 6 4 4 7 7 6
d204 d205 d206 d207 d308 d309R d310 d311 492 6 6 6 6 6 6 6 6 493 6 6 6 6 6 6 6 6 494 6 6 6 6 6 6 6 6 495 6 7 6 7 7 5 5 7 496 6 6 6 6 6 6 6 6 497 6 7 6 7 7 5 5 7
> #---
> #定義一個函數,可以同時
> #計算題目的平均數、標準差、偏態與峰度
> my_summary <- function(x) { + require(moments)
+ funs <- c(mean, sd, skewness, kurtosis) + sapply(funs, function(f) f(x, na.rm = TRUE)) + }
> #一次算完所有題目前四級動差,並存成資料檔
> dta_desc <- apply(dta[4:15], 2, my_summary)
> rownames(dta_desc) <- c("平均", "標準差", "偏態", "峰度")
> rslt1 <- as.data.frame(t(dta_desc))
> round(rslt1,3)
平均 標準差 偏態 峰度 b101 5.070 1.076 -0.062 2.269 b102 4.491 1.233 -0.053 2.743 b104 4.323 1.114 0.033 3.716 b105R 4.380 1.354 -0.068 2.841 b203 4.601 1.267 -0.209 2.867 b206R 4.185 1.345 -0.046 2.603 b212 4.485 1.243 -0.278 3.342 b215R 3.577 1.260 0.343 2.908 b307R 3.668 1.228 0.103 3.235 b308 4.091 1.245 -0.234 3.672 b310 3.877 1.287 0.207 3.215 b313R 4.284 1.305 -0.257 3.101
>
> #準備畫圖,改成長形資料
> library(reshape)
> dtal_desc <- melt(dta_desc)
> names(dtal_desc)[1:2] <- c("動差", "題目")
> head(dtal_desc)
動差 題目 value 1 平均 b101 5.07042254 2 標準差 b101 1.07626071 3 偏態 b101 -0.06241307 4 峰度 b101 2.26863663 5 平均 b102 4.49094567 6 標準差 b102 1.23311929
> #繪製所有題目平均數
> windows()
> require(ggplot2)
> ggplot(data = subset(dtal_desc, 動差 == "平均"),
+ aes(x = reorder(題目, value, max), y = value, group = 動差)) + + geom_point(size = 3)+
+ geom_hline(yintercept = mean(t(dta_desc["平均",])) +
+ c(-1.5, 0, 1.5) * sd(t(dta_desc["平均",])), linetype = "dashed") + + coord_flip() +
+ labs(x = "題目", y = "平均")
> #繪製所有題目標準差
> #圖6.2
> windows()
> ggplot(data = subset(dtal_desc, 動差 == "標準差"),
+ aes(x = reorder(題目, value, max), y = value, group = 動差)) + + geom_point(size = 3)+
+ geom_hline(yintercept = mean(t(dta_desc["標準差",])) +
+ c(-1.5, 0, 1.5) * sd(t(dta_desc["標準差",])), linetype = "dashed") + + coord_flip() +
+ labs(x = "題目", y = "標準差")
> #繪製所有題目偏態
> windows()
> ggplot(data = subset(dtal_desc, 動差 == "偏態"),
+ aes(x = reorder(題目, value, max), y = value, group = 動差)) + + geom_point(size = 3)+
+ geom_hline(yintercept = mean(t(dta_desc["偏態",])) +
+ c(-1.5, 0, 1.5) * sd(t(dta_desc["偏態",])), linetype = "dashed") + + coord_flip() +
+ labs(x = "題目", y = "偏態")
> #繪製所有題目峰度
> windows()
> ggplot(data = subset(dtal_desc, 動差 == "峰度"),
+ aes(x = reorder(題目, value, max), y = value, group = 動差)) + + geom_point(size = 3)+
+ geom_hline(yintercept = mean(t(dta_desc["峰度",])) +
+ c(-1.5, 0, 1.5) * sd(t(dta_desc["峰度",])), linetype = "dashed") + + coord_flip() +
+ labs(x = "題目", y = "峰度")
> #計算區辨度。以總分為準,選取低分組與高分組,比較各題在兩組上的差 異。
> dta$tot <- apply(dta[4:15], 1, sum)
> dta$grp <- NA
> dta$grp[rank(dta$tot) < 485*.27] <- "L"
> dta$grp[rank(dta$tot) > 485*.73] <- "H"
> dta$grp <- factor(dta$grp)
> #算高低分組平均數
> dtam <- aggregate(dta[4:15], by=list(dta$grp), mean)
> #第一欄沒有用,刪掉
> dtam <- t(dtam[,-1])
> #t檢定
> item_t <- sapply(dta[4:15], function(x) t.test(x ~ dta$grp)$statistic)
> #將計算結果存於新資料框架rslt2中
> rslt2 <- data.frame(Item=rownames(dtam),m.l=dtam[,2], m.h=dtam[,1], m.dif=dtam[,1]-dtam[,2], t.stat=item_t)
> #畫出t檢定結果
> #圖6.3
> windows()
> ggplot(data = rslt2, aes(x=reorder(Item, t.stat, max), y=t.stat)) + + geom_point() +
+ geom_hline(yintercept = 2, linetype="dashed") + + coord_flip() +
+ labs(x = "題目", y = "t檢定值") + + theme_bw()
> #整理資料、命名欄位並四捨五入取至小數點後第3位
> #程式報表6.4
> rslt2 <- rslt2[,-1]
> names(rslt2) <- c('低分組平均','高分組平均','差異','t檢定')
> round(rslt2,3)
低分組平均 高分組平均 差異 t檢定
b101 4.271 5.972 1.701 15.442 b102 3.339 5.704 2.365 19.190 b104 3.407 NA NA 15.319 b105R 3.331 5.620 2.289 14.956 b203 3.458 NA NA 18.082 b206R 3.169 5.324 2.154 14.751 b212 3.280 5.577 2.298 17.438