Dữ liệu sử dụng trong hướng dẫn này là của PGS.TS Trần Văn Trang (Đại học Thương mại).
Bài báo gốc lấy tại: http://tckhtm.tmu.edu.vn/vi/news/cac-so-tap-chi/tap-chi-khoa-hoc-thuong-mai-so-141-153.html
Dữ liệu tải tại google diver: https://drive.google.com/drive/folders/1Npip6h8WyZjI9JGf5wonnU_scBUYj4sP?usp=sharing
setwd("D:/Tap huan VIASM/HoiThao_KHXH_2021/Projects/Y_Dinh_Hanh_Vi")
library(foreign) # to read .sav
require(tidyverse)
library(psych) # KMO, Barletet, cronbach alpha, fa
library(GPArotation)
library(readxl) # Read xlsx file
library(writexl) # write xlsx file
d <- read.spss("Case study Behavior Intention.sav",
use.value.label=TRUE, to.data.frame=TRUE)
Questionnaire <- read_excel("Questionnaires.xlsx", sheet = 1)
d1 <- d %>% select(-c("STT", "FAM", "Formation",
"Work", "Year",
"BI1", "BIRecode", "BI4"))
dim(d1)
## [1] 826 29
names(d1)
## [1] "BI1R" "BI2" "BI3" "BI4R" "BI5" "BI6" "REL1" "REL2" "REL3" "REL4"
## [11] "EDU1" "EDU2" "EDU3" "EDU4" "EDU5" "EDU6" "EDU7" "EDU8" "GOV1" "GOV2"
## [21] "GOV3" "GOV4" "GOV5" "GOV6" "END1" "END2" "END3" "END4" "END5"
alpha(d1 %>% select(BI1R, BI2, BI3, BI4R, BI5, BI6 ))
##
## Reliability analysis
## Call: alpha(x = d1 %>% select(BI1R, BI2, BI3, BI4R, BI5, BI6))
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.78 0.79 0.79 0.38 3.7 0.012 4.7 0.97 0.32
##
## lower alpha upper 95% confidence boundaries
## 0.76 0.78 0.81
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## BI1R 0.77 0.77 0.75 0.41 3.4 0.013 0.015 0.42
## BI2 0.74 0.74 0.74 0.37 2.9 0.015 0.018 0.31
## BI3 0.74 0.74 0.73 0.36 2.8 0.015 0.019 0.30
## BI4R 0.77 0.77 0.75 0.41 3.4 0.013 0.016 0.42
## BI5 0.74 0.74 0.73 0.37 2.9 0.014 0.012 0.31
## BI6 0.75 0.75 0.74 0.38 3.0 0.014 0.018 0.31
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## BI1R 826 0.65 0.63 0.54 0.46 5.4 1.5
## BI2 826 0.71 0.73 0.66 0.58 4.6 1.2
## BI3 826 0.73 0.74 0.67 0.58 4.8 1.4
## BI4R 826 0.66 0.63 0.53 0.46 4.9 1.5
## BI5 826 0.72 0.73 0.67 0.57 4.3 1.3
## BI6 826 0.71 0.71 0.63 0.55 4.4 1.5
##
## Non missing response frequency for each item
## 1 2 3 4 5 6 7 miss
## BI1R 0.01 0.03 0.07 0.20 0.15 0.23 0.31 0
## BI2 0.01 0.04 0.11 0.28 0.31 0.18 0.05 0
## BI3 0.02 0.05 0.09 0.21 0.30 0.26 0.08 0
## BI4R 0.02 0.04 0.11 0.23 0.20 0.19 0.21 0
## BI5 0.03 0.06 0.15 0.30 0.27 0.14 0.04 0
## BI6 0.04 0.08 0.11 0.30 0.24 0.18 0.05 0
#------------------------------------Cronback alpha with function-----------------------
#------------ Show alpha and drop items
fun1 <- function(dauvao, tennhanto)
{
#dauvao: dữ liệu gồm các biến quan sát để tính alpha
# Tên nhóm nhân tố, dạng kí tự
tempt <- data.frame(value = c(round(dauvao[[1]]$std.alpha, 2),
round(dauvao[[2]][, "std.alpha"],2) ),
row.names = c(paste0(tennhanto),
paste0( names(dauvao[["keys"]]))))
return(tempt)
}
c1 <- fun1(alpha(d1 %>% select("EDU1", "EDU2", "EDU3", "EDU4", "EDU5", "EDU6", "EDU7", "EDU8")), "EDU")
c2 <- fun1(alpha(d1 %>% select("END1", "END2", "END3", "END4", "END5" )), "END")
c3 <- fun1(alpha(d1 %>% select("BI2" , "BI3", "BI5", "BI6" )), "BI")
c4 <- fun1(alpha(d1 %>% select("GOV2", "GOV3", "GOV4", "GOV5")), "GOV")
c5 <- fun1(alpha(d1 %>%select("REL1", "REL2", "REL3", "REL4")), "REL")
Tab2_Alpha <- data.frame(Code = c(row.names(c1), row.names(c2), row.names(c3),
row.names(c4), row.names(c5)), #,
Alpha = c(c1$value, c2$value, c3$value, c4$value, c5$value))
Tab2_Alpha <- left_join(Tab2_Alpha, Questionnaire)
## Joining, by = "Code"
Tab2_Alpha<- Tab2_Alpha[, c("Code", "Meaning", "Alpha")]
write_xlsx(Tab2_Alpha, "Tab2_Alpha.xlsx")