Scale analysis with R
邱浩恩
2016年12月13日
Reading data
item <-read.csv("D:/104/ML_R/scale_test.csv",
header=TRUE, sep=",")
head(item)## self_1 self_2 self_3 self_4 self_5 self_6 self_7 self_8 self_9 self_10
## 1 4 2 4 4 1 2 4 3 1 4
## 2 4 2 4 4 2 1 4 3 2 4
## 3 4 2 5 5 2 2 4 4 1 4
## 4 4 2 4 4 1 1 4 4 1 4
## 5 4 2 3 3 2 3 4 4 2 3
## 6 4 2 4 3 2 1 4 3 1 4建立選項
choices = c("完全不同意","大部分不同意",
"有些同意","大部分同意","完全同意")將所有人的數字選項替換成文字
for(i in 1:ncol(item)) {
item[,i] = factor(item[,i], levels=1:5, labels=choices, ordered=TRUE)}
head(item)## self_1 self_2 self_3 self_4 self_5 self_6
## 1 大部分同意 大部分不同意 大部分同意 大部分同意 完全不同意 大部分不同意
## 2 大部分同意 大部分不同意 大部分同意 大部分同意 大部分不同意 完全不同意
## 3 大部分同意 大部分不同意 完全同意 完全同意 大部分不同意 大部分不同意
## 4 大部分同意 大部分不同意 大部分同意 大部分同意 完全不同意 完全不同意
## 5 大部分同意 大部分不同意 有些同意 有些同意 大部分不同意 有些同意
## 6 大部分同意 大部分不同意 大部分同意 有些同意 大部分不同意 完全不同意
## self_7 self_8 self_9 self_10
## 1 大部分同意 有些同意 完全不同意 大部分同意
## 2 大部分同意 有些同意 大部分不同意 大部分同意
## 3 大部分同意 大部分同意 完全不同意 大部分同意
## 4 大部分同意 大部分同意 完全不同意 大部分同意
## 5 大部分同意 大部分同意 大部分不同意 有些同意
## 6 大部分同意 有些同意 完全不同意 大部分同意題項重新命名
library(plyr)
item<- rename(item, c( "self_1" = "整體而言我對自己感到滿意。",
"self_2" = "有時我覺得自己一點可取之處也沒有。",
"self_3" = "我覺得自己有許多良好的特質。",
"self_4" = "我可以把事情做得如同大多數人一樣好。",
"self_5" = "我覺得自己沒有什麼值得自豪的地方。",
"self_6" = "我有時候覺得自己一無用處。",
"self_7" = "我覺得自己是個有價值的人，至少和別人差不多。",
"self_8" = "我希望能更尊重自己一些。",
"self_9" = "我傾向於覺得自己是個完全的失敗者。",
"self_10" = "我對自己抱持著正向的態度。" ))Loading packages
library(ggplot2)
library(reshape2)
library(RColorBrewer)
library(devtools)
library(likert)
library(plotly)設定顏色
color<-brewer.pal(5, "RdYlGn")Plots
選項比例
plot(likert(item), centered = FALSE, wrap = 20, ordered=T,col=color)
選項密度
plot(likert(item), type = "density")
熱圖
plot(likert(item), type = "heat")
Item analysis
定義一個函數，可以同時計算題目的平均數、標準差、偏態與峰度
item1 <-read.csv("D:/104/ML_R/scale_test.csv",
header=TRUE, sep=",")
my_summary <- function(x) {
require(moments)
funs <- c(mean, sd, skewness, kurtosis)
sapply(funs, function(f) f(x, na.rm = TRUE))
}
item_desc <- apply(item1, 2, my_summary)## Loading required package: moments為變項命名後XY變項互換
rownames(item_desc) <- c("平均", "標準差", "偏態", "峰度")檢查一下資料是否常態 偏態處於-2到2之間，峰度處於-7到7之間
rslt1 <- as.data.frame(t(item_desc))
head(rslt1)## 平均 標準差 偏態 峰度
## self_1 3.477901 0.7559976 -0.31019443 3.229307
## self_2 2.129834 0.8914767 0.63607830 3.217165
## self_3 3.574586 0.7225804 0.13546768 2.657662
## self_4 3.604972 0.7302545 0.03886553 2.896763
## self_5 2.187845 0.8950874 0.59805014 3.237557
## self_6 2.160221 0.9513181 0.60403170 3.083855T檢定
計算低分組與高分組，比較各題在兩組上的差異
item1$tot <- apply(item1, 1, sum)
item1$grp <- NA
item1$grp[rank(item1$tot) < 362*.27] <- "L"
item1$grp[rank(item1$tot) > 362*.73] <- "H"
head(item1)## self_1 self_2 self_3 self_4 self_5 self_6 self_7 self_8 self_9 self_10
## 1 4 2 4 4 1 2 4 3 1 4
## 2 4 2 4 4 2 1 4 3 2 4
## 3 4 2 5 5 2 2 4 4 1 4
## 4 4 2 4 4 1 1 4 4 1 4
## 5 4 2 3 3 2 3 4 4 2 3
## 6 4 2 4 3 2 1 4 3 1 4
## tot grp
## 1 29 <NA>
## 2 30 <NA>
## 3 33 H
## 4 29 <NA>
## 5 30 <NA>
## 6 28 <NA>計算題項的高分組、低分組均值
item1$grp <- factor(item1$grp)
item2 <- aggregate(item1[,1:10], by=list(item1$grp), mean)
head(item2)## Group.1 self_1 self_2 self_3 self_4 self_5 self_6 self_7
## 1 H 3.764706 2.529412 4.009804 4.049020 2.431373 2.539216 4.186275
## 2 L 3.079545 1.818182 3.090909 3.068182 2.000000 1.886364 3.136364
## self_8 self_9 self_10
## 1 4.284314 1.852941 4.127451
## 2 2.965909 1.556818 3.329545第一欄沒有用，刪掉
item2 <- t(item2[,-1])t檢定
item_t <- sapply(item1[,1:10], function(x) t.test(x ~ item1$grp)$statistic)將計算結果存於新資料框架rslt2中
rslt2 <- data.frame(Item=rownames(item2),m.l=item2[,2],
m.h=item2[,1], m.dif=item2[,1]-item2[,2], t.stat=item_t)
head(rslt2)## Item m.l m.h m.dif t.stat
## self_1 self_1 3.079545 3.764706 0.6851604 6.821372
## self_2 self_2 1.818182 2.529412 0.7112299 5.830006
## self_3 self_3 3.090909 4.009804 0.9188948 10.825035
## self_4 self_4 3.068182 4.049020 0.9808378 10.456410
## self_5 self_5 2.000000 2.431373 0.4313725 3.480757
## self_6 self_6 1.886364 2.539216 0.6528520 4.818768畫出t檢定結果
p1<-ggplot(data = rslt2, aes(x=reorder(Item, t.stat, max), y=t.stat,size=t.stat)) +
geom_point(color= "#E69F00") +
geom_hline(yintercept = 2, linetype="dashed",color="red") +
coord_flip() +
labs(x = "題項", y = "t值")
ggplotly(p1)rslt2 <- rslt2[,-1]
names(rslt2) <- c('低分組平均','高分組平均','差異','t檢定')
round(rslt2,3)## 低分組平均 高分組平均 差異 t檢定
## self_1 3.080 3.765 0.685 6.821
## self_2 1.818 2.529 0.711 5.830
## self_3 3.091 4.010 0.919 10.825
## self_4 3.068 4.049 0.981 10.456
## self_5 2.000 2.431 0.431 3.481
## self_6 1.886 2.539 0.653 4.819
## self_7 3.136 4.186 1.050 10.045
## self_8 2.966 4.284 1.318 11.674
## self_9 1.557 1.853 0.296 2.608
## self_10 3.330 4.127 0.798 7.440