Final - 150426 - KABP_Analysis
Chuong, Nguyen-Dinh-nguyen
2026-04-15
#CREATE K-A-B-P-F-W_DOMAIN CSV FILE (N=441)
KABP_Cleaned_441 <- read.csv("/Users/dr.ndnchuong/KAPB_Cleaned_441.csv")
# 1. Khai báo danh sách các biến
vars_K <- c("R_K1_REV", "R_K2_REV", "R_K3", "R_K4", "R_K5", "R_K6", "R_K7", "R_K8", "R_K9")
vars_A <- c("R_A1_REV", "R_A2_REV", "R_A3", "R_A4", "R_A5", "R_A6", "R_A7", "R_A8", "R_A9", "R_A10", "R_A11", "R_A12", "R_A13")
vars_B <- c("R_B1_REV", "R_B2_REV", "R_B3", "R_B4", "R_B5", "R_B6")
vars_P <- c("R_P1", "R_P2", "R_P3", "R_P4", "R_P5", "R_P6", "R_P7", "R_P8", "R_P9", "R_P10", "R_P11", "R_P12", "R_P13", "R_P14")
vars_F <- c("R_F1", "R_F2", "R_F3", "R_F4", "R_F5", "R_F6", "R_F7", "R_F8", "R_F9", "R_F10", "R_F11", "R_F12", "R_F13", "R_F14")
vars_W <- c("R_W1_REV", "R_W2_REV", "R_W3_REV", "R_W4_REV", "R_W5_REV", "R_W6_REV", "R_W7_REV", "R_W8_REV", "R_W9_REV")
# 2. Tạo tập dữ liệu con (Subset)
data_K_subset <- KABP_Cleaned_441[, vars_K]
data_A_subset <- KABP_Cleaned_441[, vars_A]
data_B_subset <- KABP_Cleaned_441[, vars_B]
data_P_subset <- KABP_Cleaned_441[, vars_P]
data_F_subset <- KABP_Cleaned_441[, vars_F]
data_W_subset <- KABP_Cleaned_441[, vars_W]
# 3. Xuất tập dữ liệu này ra file CSV mới
# File sẽ được lưu vào thư mục làm việc (Working Directory) của bạn
write.csv(data_K_subset, "K_Domain_441.csv", row.names = FALSE)
write.csv(data_A_subset, "A_Domain_441.csv", row.names = FALSE)
write.csv(data_B_subset, "B_Domain_441.csv", row.names = FALSE)
write.csv(data_P_subset, "P_Domain_441.csv", row.names = FALSE)
write.csv(data_F_subset, "F_Domain_441.csv", row.names = FALSE)
write.csv(data_W_subset, "W_Domain_441.csv", row.names = FALSE)
cat("Đã xuất file thành công! Bạn hãy kiểm tra trong thư mục dự án của mình nhé.")## Đã xuất file thành công! Bạn hãy kiểm tra trong thư mục dự án của mình nhé.#CREATE .DAT FILE FOR K-A-B-P-F-W DOMAIN
# ==============================================================================
# TẠO 6 FILE .DAT ĐẦU VÀO ĐỂ CHẠY SOLOMON SPLIT RIÊNG CHO TỪNG DOMAIN (N=441)
# ==============================================================================
data_K <- read.csv("K_Domain_441.csv")
data_A <- read.csv("A_Domain_441.csv")
data_B <- read.csv("B_Domain_441.csv")
data_P <- read.csv("P_Domain_441.csv")
data_F <- read.csv("F_Domain_441.csv")
data_W <- read.csv("W_Domain_441.csv")
# Ghi chú: col.names = FALSE là yêu cầu bắt buộc để chạy thuật toán ma trận
write.table(data_K, file = "K_Solomon_Input_441.dat", row.names = FALSE, col.names = FALSE)
write.table(data_A, file = "A_Solomon_Input_441.dat", row.names = FALSE, col.names = FALSE)
write.table(data_B, file = "B_Solomon_Input_441.dat", row.names = FALSE, col.names = FALSE)
write.table(data_P, file = "P_Solomon_Input_441.dat", row.names = FALSE, col.names = FALSE)
write.table(data_F, file = "F_Solomon_Input_441.dat", row.names = FALSE, col.names = FALSE)
write.table(data_W, file = "W_Solomon_Input_441.dat", row.names = FALSE, col.names = FALSE)
cat("- K_Solomon_Input_441.dat (", ncol(data_K), "cột )\n")## - K_Solomon_Input_441.dat ( 9 cột )cat("- A_Solomon_Input_441.dat (", ncol(data_A), "cột )\n")## - A_Solomon_Input_441.dat ( 13 cột )cat("- B_Solomon_Input_441.dat (", ncol(data_B), "cột )\n")## - B_Solomon_Input_441.dat ( 6 cột )cat("- P_Solomon_Input_441.dat (", ncol(data_P), "cột )\n")## - P_Solomon_Input_441.dat ( 14 cột )cat("- F_Solomon_Input_441.dat (", ncol(data_F), "cột )\n")## - F_Solomon_Input_441.dat ( 14 cột )cat("- W_Solomon_Input_441.dat (", ncol(data_W), "cột )\n")## - W_Solomon_Input_441.dat ( 9 cột )cat("Tất cả đều có đúng", nrow(data), "dòng, ma trận số học hoàn hảo sẵn sàng cho thuật toán.\n")## Tất cả đều có đúng dòng, ma trận số học hoàn hảo sẵn sàng cho thuật toán.#SOLOMON SPLIT FOR EACH DOMAIN
# ==============================================================================
# CHẠY THUẬT TOÁN SOLOMON SPLIT CHO TỪNG DOMAIN (K, A, B, P, F, W)
# ==============================================================================
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# ------------------------------------------------------------------------------
# 1. ĐÓNG GÓI THUẬT TOÁN SOLOMON THÀNH HÀM (FUNCTION)
# ------------------------------------------------------------------------------
run_solomon <- function(filein, fileout) {
X <- read.table(filein, quote="\"", comment.char="")
N <- nrow(X)
m <- ncol(X)
mc <- colMeans(X)
sx <- sqrt(colSums(X^2)/N - mc^2)
ones <- as.matrix(numeric(N)+1)
Z <- as.matrix((X - ones %*% mc)/(ones %*% sx))
R <- cor(X)
eigen_res <- eigen(R)
ld <- 1
for (i in 1:m){
if (eigen_res$values[i] > 1) {
ld <- ld + 1
}
}
s_svd <- svd(R)
Kq <- as.matrix(s_svd$v[1:m,1:ld])
Dq <- as.matrix(diag(s_svd$d[1:ld]))
B <- Kq %*% solve(Dq)^(0.5)
A <- t(solve(t(B)%*%R%*%B) %*% t(B) %*% R )
A <- A * as.matrix(numeric(m)+1)%*%sign(colSums(A))
pc_ld <- Z %*% A
w <- eigen_res$values/m
w_ld <- w[1:ld]
s_val <- pc_ld %*% w_ld
ss <- sort(s_val, method = "quick", index.return = TRUE)
sss <- numeric(N) + 2
pos <- seq(1,N,2)
sss[pos] <- 1
Xs <- X[ss$ix,]
ids <- ss$ix
SX <- t(rbind(t(sss),t(Xs)))
colnames(SX)[1] <- c("SG")
sid <- sort(ids,method = "quick", index.return = TRUE)
solomon <- SX[sid$ix,]
# Lưu file .dat chứa nhóm cho giáo sư kiểm tra
write.table(solomon, file=fileout, row.names=FALSE, col.names=FALSE)
# Trả về cột đầu tiên (Cột chia nhóm 1 và 2) để dùng luôn
return(solomon[,1])
}
# ------------------------------------------------------------------------------
# 2. ÁP DỤNG HÀM CHO 4 DOMAIN VÀ LẤY MÃ NHÓM (1=EFA, 2=CFA)
# ------------------------------------------------------------------------------
cat("\n--- SOLOMON SPLIT PROCESSING ---\n")##
## --- SOLOMON SPLIT PROCESSING ---sg_K <- run_solomon("K_Solomon_Input_441.dat", "K_solomon_subsamples_441.dat")
sg_A <- run_solomon("A_Solomon_Input_441.dat", "A_solomon_subsamples_441.dat")
sg_B <- run_solomon("B_Solomon_Input_441.dat", "B_solomon_subsamples_441.dat")
sg_P <- run_solomon("P_Solomon_Input_441.dat", "P_solomon_subsamples_441.dat")
sg_F <- run_solomon("F_Solomon_Input_441.dat", "F_solomon_subsamples_441.dat")
sg_W <- run_solomon("W_Solomon_Input_441.dat", "W_solomon_subsamples_441.dat")
cat(">> Đã tính toán xong và xuất 6 file kết quả subsamples (.dat)!\n")## >> Đã tính toán xong và xuất 6 file kết quả subsamples (.dat)!# ------------------------------------------------------------------------------
# 3. TÁCH DỮ LIỆU EFA VÀ CFA CHO TỪNG DOMAIN
# ------------------------------------------------------------------------------
# Đọc lại 4 file CSV sạch gốc để gắn nhóm
df_K <- read.csv("K_Domain_441.csv")
df_A <- read.csv("A_Domain_441.csv")
df_B <- read.csv("B_Domain_441.csv")
df_P <- read.csv("P_Domain_441.csv")
df_F <- read.csv("F_Domain_441.csv")
df_W <- read.csv("W_Domain_441.csv")
# Nhóm K
data_K_EFA <- df_K %>% mutate(SG = sg_K) %>% filter(SG == 1) %>% select(-SG)
data_K_CFA <- df_K %>% mutate(SG = sg_K) %>% filter(SG == 2) %>% select(-SG)
# Nhóm A
data_A_EFA <- df_A %>% mutate(SG = sg_A) %>% filter(SG == 1) %>% select(-SG)
data_A_CFA <- df_A %>% mutate(SG = sg_A) %>% filter(SG == 2) %>% select(-SG)
# Nhóm B
data_B_EFA <- df_B %>% mutate(SG = sg_B) %>% filter(SG == 1) %>% select(-SG)
data_B_CFA <- df_B %>% mutate(SG = sg_B) %>% filter(SG == 2) %>% select(-SG)
# Nhóm P
data_P_EFA <- df_P %>% mutate(SG = sg_P) %>% filter(SG == 1) %>% select(-SG)
data_P_CFA <- df_P %>% mutate(SG = sg_P) %>% filter(SG == 2) %>% select(-SG)
# Nhóm F
data_F_EFA <- df_F %>% mutate(SG = sg_F) %>% filter(SG == 1) %>% select(-SG)
data_F_CFA <- df_F %>% mutate(SG = sg_F) %>% filter(SG == 2) %>% select(-SG)
# Nhóm P
data_W_EFA <- df_W %>% mutate(SG = sg_W) %>% filter(SG == 1) %>% select(-SG)
data_W_CFA <- df_W %>% mutate(SG = sg_W) %>% filter(SG == 2) %>% select(-SG)
cat("\n--- SOLOMON SPLIT RESULTS ---\n")##
## --- SOLOMON SPLIT RESULTS ---cat("Domain K | EFA:", nrow(data_K_EFA), "mẫu | CFA:", nrow(data_K_CFA), "mẫu\n")## Domain K | EFA: 221 mẫu | CFA: 220 mẫucat("Domain A | EFA:", nrow(data_A_EFA), "mẫu | CFA:", nrow(data_A_CFA), "mẫu\n")## Domain A | EFA: 221 mẫu | CFA: 220 mẫucat("Domain B | EFA:", nrow(data_B_EFA), "mẫu | CFA:", nrow(data_B_CFA), "mẫu\n")## Domain B | EFA: 221 mẫu | CFA: 220 mẫucat("Domain P | EFA:", nrow(data_P_EFA), "mẫu | CFA:", nrow(data_P_CFA), "mẫu\n")## Domain P | EFA: 221 mẫu | CFA: 220 mẫucat("Domain F | EFA:", nrow(data_F_EFA), "mẫu | CFA:", nrow(data_F_CFA), "mẫu\n")## Domain F | EFA: 221 mẫu | CFA: 220 mẫucat("Domain W | EFA:", nrow(data_W_EFA), "mẫu | CFA:", nrow(data_W_CFA), "mẫu\n")## Domain W | EFA: 221 mẫu | CFA: 220 mẫuA. DOMAIN K - ANALYSIS
# ==============================================================================
# BƯỚC 1: KMO-BARTLETT & XÁC ĐỊNH SỐ NHÂN TỐ CHO DOMAIN K (TẬP EFA)
# ==============================================================================
library(psych)
cat("\n--- 1. KIỂM ĐỊNH KMO VÀ BARTLETT ---\n")##
## --- 1. KIỂM ĐỊNH KMO VÀ BARTLETT ---# Chạy KMO
kmo_K <- KMO(data_K_EFA)
cat("=> KẾT LUẬN KMO: Chỉ số Overall MSA là:", round(kmo_K$MSA, 3), "\n")## => KẾT LUẬN KMO: Chỉ số Overall MSA là: 0.817# Chạy Bartlett's Test
bartlett_K <- cortest.bartlett(cor(data_K_EFA, use = "pairwise.complete.obs"), n = nrow(data_K_EFA))
cat("=> BARTLETT: Chi-square =", round(bartlett_K$chisq, 1), "| p-value =", bartlett_K$p.value, "| df =", bartlett_K$df, "\n")## => BARTLETT: Chi-square = 598.5 | p-value = 3.994177e-103 | df = 36cat("\n--- 2. XÁC ĐỊNH SỐ NHÂN TỐ ---\n")##
## --- 2. XÁC ĐỊNH SỐ NHÂN TỐ ---# Tiêu chí Kaiser (Eigenvalue > 1)
eigen_K <- eigen(cor(data_K_EFA, use = "pairwise.complete.obs"))$values
cat("Danh sách Eigenvalues:", round(eigen_K, 3), "\n")## Danh sách Eigenvalues: 3.508 1.566 0.892 0.764 0.592 0.529 0.48 0.36 0.31cat("=> Gợi ý Kaiser (Eigenvalue > 1):", sum(eigen_K > 1), "nhân tố\n\n")## => Gợi ý Kaiser (Eigenvalue > 1): 2 nhân tố# Tiêu chí VSS và MAP (Velicer)
# Thử nghiệm tối đa 4 nhân tố để so sánh
vss_K <- vss(data_K_EFA, n = 4, fm = "pa", cor = "cor", plot = FALSE)
print(vss_K)##
## Very Simple Structure
## Call: vss(x = data_K_EFA, n = 4, fm = "pa", plot = FALSE, cor = "cor")
## VSS complexity 1 achieves a maximimum of 0.77 with 2 factors
## VSS complexity 2 achieves a maximimum of 0.85 with 4 factors
##
## The Velicer MAP achieves a minimum of 0.04 with 1 factors
## BIC achieves a minimum of -65.72 with 2 factors
## Sample Size adjusted BIC achieves a minimum of -12.33 with 3 factors
##
## Statistics by number of factors
## vss1 vss2 map dof chisq prob sqresid fit RMSEA BIC SABIC complex eChisq
## 1 0.70 0.00 0.038 27 113 1.7e-12 5.2 0.70 0.120 -33 52.9 1.0 83.4
## 2 0.77 0.82 0.046 19 37 8.3e-03 3.1 0.82 0.065 -66 -5.5 1.1 13.4
## 3 0.62 0.83 0.078 12 14 2.7e-01 2.6 0.85 0.030 -50 -12.3 1.4 3.7
## 4 0.63 0.85 0.127 6 7 3.2e-01 2.0 0.88 0.027 -25 -6.3 1.5 1.4
## SRMR eCRMS eBIC
## 1 0.0724 0.084 -62
## 2 0.0290 0.040 -89
## 3 0.0152 0.026 -61
## 4 0.0095 0.023 -31cat("\n--- 3. PARALLEL ANALYSIS (PA) ---\n")##
## --- 3. PARALLEL ANALYSIS (PA) ---# Biểu đồ và chỉ định của PA
pa_K <- fa.parallel(data_K_EFA,
cor = "cor",
fm = "pa",
fa = "fa",
main = "Parallel Analysis - Domain K (EFA Subset)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NA#> EFA ANALYSIS
# ==============================================================================
# BƯỚC 5: CHẠY EFA 2 NHÂN TỐ
# ==============================================================================
library(psych)
cat("\n--- CHẠY EFA 2 NHÂN TỐ CHO DOMAIN K (TẬP EFA) ---\n")##
## --- CHẠY EFA 2 NHÂN TỐ CHO DOMAIN K (TẬP EFA) ---# Chạy EFA 2 nhân tố, dùng phép xoay promax (vì các nhân tố có thể tương quan)
efa_K_2 <- fa(data_K_EFA, nfactors = 2, cor = "poly", fm = "pa", rotate = "promax")## Loading required namespace: GPArotation# Xuất ma trận hệ số tải (chỉ hiển thị những số > 0.3 để dễ nhìn sự phân nhóm)
cat("\nMA TRẬN HỆ SỐ TẢI (FACTOR LOADINGS) VỚI 2 NHÂN TỐ:\n")##
## MA TRẬN HỆ SỐ TẢI (FACTOR LOADINGS) VỚI 2 NHÂN TỐ:print(efa_K_2$loadings, cutoff = 0.3, sort = TRUE)##
## Loadings:
## PA1 PA2
## R_K3 0.553
## R_K5 0.617
## R_K6 0.917
## R_K7 0.937
## R_K8 0.821
## R_K9 0.762
## R_K1_REV 0.602
## R_K2_REV 0.899
## R_K4 -0.392
##
## PA1 PA2
## SS loadings 3.722 1.390
## Proportion Var 0.414 0.154
## Cumulative Var 0.414 0.568# ==============================================================================
# BƯỚC 5: ÉP EFA 1 NHÂN TỐ & KIỂM TRA ĐỘ HỘI TỤ (COMMUNALITY) CHO DOMAIN K
# ==============================================================================
library(psych)
cat("\n--- 1. CHẠY EFA 1 NHÂN TỐ (DÙNG POLYCHORIC) ---\n")##
## --- 1. CHẠY EFA 1 NHÂN TỐ (DÙNG POLYCHORIC) ---# Chạy thuật toán với 1 nhân tố
efa_K_1 <- fa(data_K_EFA, nfactors = 1, cor = "poly", fm = "pa")
cat("\n--- 2. Loadings và Communality SUMMARY ---\n")##
## --- 2. Loadings và Communality SUMMARY ---# Tạo bảng tóm tắt Loadings và Communality
health_check_K <- data.frame(
Loadings = round(as.numeric(efa_K_1$loadings), 2),
Communality = round(efa_K_1$communality, 2)
)
# Gắn tên câu hỏi
rownames(health_check_K) <- rownames(efa_K_1$loadings)
# Sắp xếp Communality từ thấp đến cao
health_check_K <- health_check_K[order(health_check_K$Communality), ]
print(health_check_K)## Loadings Communality
## R_K1_REV -0.14 0.02
## R_K2_REV -0.19 0.04
## R_K4 0.34 0.12
## R_K3 0.62 0.39
## R_K5 0.62 0.39
## R_K9 0.74 0.55
## R_K8 0.83 0.68
## R_K6 0.84 0.71
## R_K7 0.90 0.80# ==============================================================================
# BƯỚC 3 (DOMAIN K): CẮT BỎ TỪNG BƯỚC VÀ CHẠY LẠI PARALLEL ANALYSIS (PA)
# Thứ tự loại bỏ: K1_REV -> K2_REV -> K5 -> K3 -> K4
# ==============================================================================
library(psych)
cat("\n=================================================================\n")##
## =================================================================cat(" LẦN 1: LOẠI BỎ R_K1_REV VÀ KIỂM TRA LẠI CẤU TRÚC (PA) \n")## LẦN 1: LOẠI BỎ R_K1_REV VÀ KIỂM TRA LẠI CẤU TRÚC (PA)cat("=================================================================\n")## =================================================================# 1. Tạo tập dữ liệu 8 câu (Đã loại K1_REV)
data_K_drop1 <- data_K_EFA[, !(names(data_K_EFA) %in% c("R_K1_REV"))]
# 2. Chạy lại PA (Dùng fm = "pa")
cat("\n--- CHẠY LẠI PA CHO 8 CÂU (ĐÃ LOẠI K1_REV) ---\n")##
## --- CHẠY LẠI PA CHO 8 CÂU (ĐÃ LOẠI K1_REV) ---pa_K_v1 <- fa.parallel(data_K_drop1, cor = "cor", fm = "pa", fa = "fa", main = "PA - Lần 1 (Loại K1)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_K_v1$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2# 3. Chạy EFA theo số nhân tố PA gợi ý
cat("\n--- CHẠY EFA LẦN 1 (SỐ NHÂN TỐ =", pa_K_v1$nfact, ") ---\n")##
## --- CHẠY EFA LẦN 1 (SỐ NHÂN TỐ = 2 ) ---efa_K_v1 <- fa(data_K_drop1, nfactors = pa_K_v1$nfact, cor = "poly", fm = "pa", rotate = "promax")
loadings_1 <- round(as.data.frame(unclass(efa_K_v1$loadings)), 3)
loadings_1$Communality <- round(efa_K_v1$communality, 3)
loadings_1$Complexity <- round(efa_K_v1$complexity, 3)
print(loadings_1[order(-abs(loadings_1[,1])), , drop = FALSE])## PA1 PA2 Communality Complexity
## R_K7 0.936 -0.064 0.832 1.009
## R_K6 0.934 -0.149 0.783 1.051
## R_K8 0.825 0.004 0.683 1.000
## R_K9 0.785 -0.084 0.569 1.023
## R_K5 0.576 0.094 0.385 1.053
## R_K3 0.495 0.270 0.426 1.548
## R_K2_REV 0.065 -0.513 0.240 1.033
## R_K4 0.013 0.756 0.580 1.001cat("\n=================================================================\n")##
## =================================================================cat(" LẦN 2: LOẠI TIẾP R_K2_REV VÀ KIỂM TRA LẠI CẤU TRÚC (PA) \n")## LẦN 2: LOẠI TIẾP R_K2_REV VÀ KIỂM TRA LẠI CẤU TRÚC (PA)cat("=================================================================\n")## =================================================================# 1. Tạo tập dữ liệu 7 câu (Đã loại K1, K2)
data_K_drop2 <- data_K_drop1[, !(names(data_K_drop1) %in% c("R_K2_REV"))]
# 2. Chạy lại PA
cat("\n--- CHẠY LẠI PA CHO 7 CÂU (ĐÃ LOẠI K1, K2) ---\n")##
## --- CHẠY LẠI PA CHO 7 CÂU (ĐÃ LOẠI K1, K2) ---pa_K_v2 <- fa.parallel(data_K_drop2, cor = "cor", fm = "pa", fa = "fa", main = "PA - Lần 2 (Loại K1, K2)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_K_v2$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2# 3. Chạy EFA
cat("\n--- CHẠY EFA LẦN 2 (SỐ NHÂN TỐ =", pa_K_v2$nfact, ") ---\n")##
## --- CHẠY EFA LẦN 2 (SỐ NHÂN TỐ = 2 ) ---efa_K_v2 <- fa(data_K_drop2, nfactors = pa_K_v2$nfact, cor = "poly", fm = "pa", rotate = "promax")
loadings_2 <- round(as.data.frame(unclass(efa_K_v2$loadings)), 3)
loadings_2$Communality <- round(efa_K_v2$communality, 3)
loadings_2$Complexity <- round(efa_K_v2$complexity, 3)
print(loadings_2[order(-abs(loadings_2[,1])), , drop = FALSE])## PA1 PA2 Communality Complexity
## R_K6 0.903 -0.032 0.778 1.002
## R_K7 0.901 0.024 0.841 1.001
## R_K8 0.873 -0.038 0.719 1.004
## R_K9 0.707 0.058 0.558 1.013
## R_K5 0.284 0.436 0.437 1.719
## R_K4 -0.041 0.450 0.180 1.016
## R_K3 -0.007 0.836 0.690 1.000cat("\n=================================================================\n")##
## =================================================================cat(" LẦN 3: LOẠI TIẾP R_K5 VÀ KIỂM TRA LẠI CẤU TRÚC (PA) \n")## LẦN 3: LOẠI TIẾP R_K5 VÀ KIỂM TRA LẠI CẤU TRÚC (PA)cat("=================================================================\n")## =================================================================# 1. Tạo tập dữ liệu 6 câu (Đã loại K1, K2, K5)
data_K_drop3 <- data_K_drop2[, !(names(data_K_drop2) %in% c("R_K5"))]
# 2. Chạy lại PA
cat("\n--- CHẠY LẠI PA CHO 6 CÂU ---\n")##
## --- CHẠY LẠI PA CHO 6 CÂU ---pa_K_v3 <- fa.parallel(data_K_drop3, cor = "cor", fm = "pa", fa = "fa", main = "PA - Lần 3 (Bỏ K5)")
## Parallel analysis suggests that the number of factors = 1 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_K_v3$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 1# 3. Chạy EFA
cat("\n--- CHẠY EFA LẦN 3 (SỐ NHÂN TỐ =", pa_K_v3$nfact, ") ---\n")##
## --- CHẠY EFA LẦN 3 (SỐ NHÂN TỐ = 1 ) ---efa_K_v3 <- fa(data_K_drop3, nfactors = pa_K_v3$nfact, cor = "poly", fm = "pa", rotate = "promax")
loadings_3 <- round(as.data.frame(unclass(efa_K_v3$loadings)), 3)
loadings_3$Communality <- round(efa_K_v3$communality, 3)
loadings_3$Complexity <- round(efa_K_v3$complexity, 3)
print(loadings_3[order(-abs(loadings_3[,1])), , drop = FALSE])## PA1 Communality Complexity
## R_K7 0.909 0.827 1
## R_K8 0.863 0.745 1
## R_K6 0.856 0.733 1
## R_K9 0.745 0.555 1
## R_K3 0.576 0.332 1
## R_K4 0.300 0.090 1cat("\n=================================================================\n")##
## =================================================================cat(" LẦN 4: LOẠI TIẾP R_K3 VÀ KIỂM TRA LẠI CẤU TRÚC (PA) \n")## LẦN 4: LOẠI TIẾP R_K3 VÀ KIỂM TRA LẠI CẤU TRÚC (PA)cat("=================================================================\n")## =================================================================# 1. Tạo tập dữ liệu 5 câu (Đã loại K1, K2, K5, K3)
data_K_drop4 <- data_K_drop3[, !(names(data_K_drop3) %in% c("R_K3"))]
# 2. Chạy lại PA
cat("\n--- CHẠY LẠI PA CHO 5 CÂU ---\n")##
## --- CHẠY LẠI PA CHO 5 CÂU ---pa_K_v4 <- fa.parallel(data_K_drop4, cor = "cor", fm = "pa", fa = "fa", main = "PA - Lần 4 (Bỏ K3)")
## Parallel analysis suggests that the number of factors = 1 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_K_v4$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 1# 3. Chạy EFA
cat("\n--- CHẠY EFA LẦN 4 (SỐ NHÂN TỐ =", pa_K_v4$nfact, ") ---\n")##
## --- CHẠY EFA LẦN 4 (SỐ NHÂN TỐ = 1 ) ---efa_K_v4 <- fa(data_K_drop4, nfactors = pa_K_v4$nfact, cor = "poly", fm = "pa", rotate = "promax")
loadings_4 <- round(as.data.frame(unclass(efa_K_v4$loadings)), 3)
loadings_4$Communality <- round(efa_K_v4$communality, 3)
loadings_4$Complexity <- round(efa_K_v4$complexity, 3)
print(loadings_4[order(-abs(loadings_4[,1])), , drop = FALSE])## PA1 Communality Complexity
## R_K7 0.915 0.838 1
## R_K8 0.870 0.757 1
## R_K6 0.867 0.751 1
## R_K9 0.739 0.545 1
## R_K4 0.262 0.068 1cat("\n=================================================================\n")##
## =================================================================cat(" LẦN 5: LOẠI TIẾP R_K4 VÀ KIỂM TRA LẠI CẤU TRÚC (PA CHỐT) \n")## LẦN 5: LOẠI TIẾP R_K4 VÀ KIỂM TRA LẠI CẤU TRÚC (PA CHỐT)cat("=================================================================\n")## =================================================================# 1. Tạo tập dữ liệu 4 câu chốt (Đã loại K1, K2, K5, K3, K4)
data_K_drop5 <- data_K_drop4[, !(names(data_K_drop4) %in% c("R_K4"))]
# 2. Chạy lại PA
cat("\n--- CHẠY LẠI PA CHO 4 CÂU CUỐI CÙNG ---\n")##
## --- CHẠY LẠI PA CHO 4 CÂU CUỐI CÙNG ---pa_K_v5 <- fa.parallel(data_K_drop5, cor = "cor", fm = "pa", fa = "fa", main = "PA - Lần 5 (4 items)")
## Parallel analysis suggests that the number of factors = 1 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT CHO 4 CÂU CUỐI LÀ:", pa_K_v5$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT CHO 4 CÂU CUỐI LÀ: 1# 3. Chạy EFA chốt hạ (LƯU Ý: Chạy trên data_K_drop5)
cat("\n--- CHẠY EFA CHỐT HẠ LẦN 5 (SỐ NHÂN TỐ =", pa_K_v5$nfact, ") ---\n")##
## --- CHẠY EFA CHỐT HẠ LẦN 5 (SỐ NHÂN TỐ = 1 ) ---efa_K_v5 <- fa(data_K_drop5, nfactors = pa_K_v5$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Xuất bảng đẹp
loadings_K_final <- round(as.data.frame(unclass(efa_K_v5$loadings)), 3)
loadings_K_final$Communality <- round(efa_K_v5$communality, 3)
loadings_K_final$Complexity <- round(efa_K_v5$complexity, 3)
print(loadings_K_final[order(-abs(loadings_K_final[,1])), , drop = FALSE])## PA1 Communality Complexity
## R_K7 0.912 0.832 1
## R_K6 0.871 0.759 1
## R_K8 0.866 0.751 1
## R_K9 0.741 0.550 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH CUỐI CÙNG (LẦN 5) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH CUỐI CÙNG (LẦN 5) ---print(round(efa_K_v5$Vaccounted, 3))## PA1
## SS loadings 2.891
## Proportion Var 0.723#>CFA Analysis
# ==============================================================================
# CFA - KIỂM ĐỊNH MÔ HÌNH ĐO LƯỜNG CHO DOMAIN K (TẬP CFA)
# ==============================================================================
library(lavaan)## This is lavaan 0.6-21
## lavaan is FREE software! Please report any bugs.##
## Attaching package: 'lavaan'## The following object is masked from 'package:psych':
##
## cor2covcat("\n--- 1. CHẠY CFA CHO MÔ HÌNH 4 CÂU KIẾN THỨC ---\n")##
## --- 1. CHẠY CFA CHO MÔ HÌNH 4 CÂU KIẾN THỨC ---# 1. Khai báo 6 biến sau khi chạy EFA
vars_K_final <- c("R_K6", "R_K7", "R_K8", "R_K9")
# 2. Viết phương trình mô hình (1 nhân tố Kiến thức đo bằng 6 câu)
model_K <- '
Knowledge =~ R_K6 + R_K7 + R_K8 + R_K9
'
# 3. Chạy CFA trên tập data_K_CFA
# Sử dụng ordered để báo cho máy biết đây là biến thứ bậc -> tự động kích hoạt WLSMV
fit_K <- cfa(model_K,
data = data_K_CFA,
ordered = vars_K_final,
estimator = "WLSMV")
# 4. Xuất kết quả tổng thể
summary(fit_K, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 13 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 17
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 2.062 5.281
## Degrees of freedom 2 2
## P-value (Unknown) NA 0.071
## Scaling correction factor 0.391
## Shift parameter 0.003
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 2340.558 1759.497
## Degrees of freedom 6 6
## P-value NA 0.000
## Scaling correction factor 1.331
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.998
## Tucker-Lewis Index (TLI) 1.000 0.994
##
## Robust Comparative Fit Index (CFI) 0.993
## Robust Tucker-Lewis Index (TLI) 0.978
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.012 0.087
## 90 Percent confidence interval - lower 0.000 0.000
## 90 Percent confidence interval - upper 0.135 0.180
## P-value H_0: RMSEA <= 0.050 0.533 0.181
## P-value H_0: RMSEA >= 0.080 0.277 0.640
##
## Robust RMSEA 0.103
## 90 Percent confidence interval - lower 0.000
## 90 Percent confidence interval - upper 0.235
## P-value H_0: Robust RMSEA <= 0.050 0.178
## P-value H_0: Robust RMSEA >= 0.080 0.713
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.021 0.021
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Knowledge =~
## R_K6 1.000 0.875 0.875
## R_K7 1.038 0.039 26.799 0.000 0.908 0.908
## R_K8 1.044 0.035 30.239 0.000 0.913 0.913
## R_K9 0.740 0.054 13.826 0.000 0.647 0.647
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_K6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_K6|t2 -0.674 0.092 -7.325 0.000 -0.674 -0.674
## R_K6|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_K7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_K7|t2 -0.265 0.086 -3.091 0.002 -0.265 -0.265
## R_K7|t3 1.855 0.166 11.171 0.000 1.855 1.855
## R_K8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_K8|t2 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_K8|t3 -0.337 0.086 -3.894 0.000 -0.337 -0.337
## R_K8|t4 1.740 0.153 11.410 0.000 1.740 1.740
## R_K9|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_K9|t2 -0.385 0.087 -4.428 0.000 -0.385 -0.385
## R_K9|t3 1.335 0.119 11.245 0.000 1.335 1.335
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_K6 0.235 0.235 0.235
## .R_K7 0.175 0.175 0.175
## .R_K8 0.166 0.166 0.166
## .R_K9 0.581 0.581 0.581
## Knowledge 0.765 0.039 19.816 0.000 1.000 1.000cat("\n--- 2. MODIFICATION INDICES (MI) ---\n")##
## --- 2. MODIFICATION INDICES (MI) ---mi_K <- modindices(fit_K)
mi_K_res <- mi_K[mi_K$op == "~~", ] # Chỉ lấy phần dư
mi_K_sorted <- mi_K_res[order(-mi_K_res$mi), ]
print(head(mi_K_sorted, 10))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 34 R_K6 ~~ R_K9 2.051 0.090 0.090 0.245 0.245
## 35 R_K7 ~~ R_K8 2.051 0.132 0.132 0.777 0.777
## 36 R_K7 ~~ R_K9 0.557 -0.050 -0.050 -0.157 -0.157
## 33 R_K6 ~~ R_K8 0.557 -0.068 -0.068 -0.344 -0.344
## 32 R_K6 ~~ R_K7 0.496 -0.063 -0.063 -0.309 -0.309
## 37 R_K8 ~~ R_K9 0.496 -0.047 -0.047 -0.150 -0.150B. DOMAIN A - ANALYSIS
# ==============================================================================
# BƯỚC 1 (DOMAIN A): KHÁM SÀNG LỌC & XÁC ĐỊNH SỐ NHÂN TỐ CHO DOMAIN A (TẬP EFA)
# ==============================================================================
library(psych)
cat("\n--- 1. KIỂM ĐỊNH KMO VÀ BARTLETT CHO 13 CÂU THÁI ĐỘ ---\n")##
## --- 1. KIỂM ĐỊNH KMO VÀ BARTLETT CHO 13 CÂU THÁI ĐỘ ---kmo_A <- KMO(data_A_EFA)
cat("=> KẾT LUẬN KMO: Chỉ số Overall MSA là:", round(kmo_A$MSA, 3), "\n")## => KẾT LUẬN KMO: Chỉ số Overall MSA là: 0.925bartlett_A <- cortest.bartlett(cor(data_A_EFA, use = "pairwise.complete.obs"), n = nrow(data_A_EFA))
cat("=> BARTLETT: Chi-square =", round(bartlett_A$chisq, 1),
"| df =", bartlett_A$df,
"| p-value =", bartlett_A$p.value, "\n")## => BARTLETT: Chi-square = 2151.3 | df = 78 | p-value = 0cat("\n--- 2. SỐ NHÂN TỐ ---\n")##
## --- 2. SỐ NHÂN TỐ ---# Tiêu chí Kaiser (Eigenvalue > 1)
eigen_A <- eigen(cor(data_A_EFA, use = "pairwise.complete.obs"))$values
cat("Danh sách Eigenvalues:", round(eigen_A, 3), "\n")## Danh sách Eigenvalues: 7.476 1.492 0.706 0.593 0.52 0.451 0.395 0.334 0.268 0.246 0.222 0.176 0.12cat("=> Gợi ý Kaiser (Eigenvalue > 1):", sum(eigen_A > 1), "nhân tố\n\n")## => Gợi ý Kaiser (Eigenvalue > 1): 2 nhân tố# Tiêu chí VSS và MAP
# Lần này nhóm A đông (13 câu) nên ta thử dò đến 5 nhân tố
vss_A <- vss(data_A_EFA, n = 5, fm = "pa", cor = "cor", plot = FALSE)
print(vss_A)##
## Very Simple Structure
## Call: vss(x = data_A_EFA, n = 5, fm = "pa", plot = FALSE, cor = "cor")
## VSS complexity 1 achieves a maximimum of 0.94 with 2 factors
## VSS complexity 2 achieves a maximimum of 0.96 with 2 factors
##
## The Velicer MAP achieves a minimum of 0.03 with 1 factors
## BIC achieves a minimum of -114.21 with 4 factors
## Sample Size adjusted BIC achieves a minimum of -13.29 with 5 factors
##
## Statistics by number of factors
## vss1 vss2 map dof chisq prob sqresid fit RMSEA BIC SABIC complex
## 1 0.93 0.00 0.029 65 310 1.4e-33 4.2 0.93 0.130 -41 165 1.0
## 2 0.94 0.96 0.036 53 224 8.1e-23 2.2 0.96 0.121 -63 105 1.1
## 3 0.60 0.96 0.044 42 122 1.1e-09 1.8 0.97 0.093 -105 28 1.5
## 4 0.48 0.90 0.060 32 59 2.9e-03 1.6 0.97 0.061 -114 -13 1.8
## 5 0.47 0.87 0.095 23 38 2.6e-02 1.4 0.98 0.054 -86 -13 2.0
## eChisq SRMR eCRMS eBIC
## 1 88.8 0.0508 0.056 -262
## 2 26.0 0.0274 0.033 -260
## 3 11.0 0.0179 0.024 -216
## 4 5.5 0.0126 0.020 -167
## 5 2.9 0.0092 0.017 -121cat("\n--- 3. PARALLEL ANALYSIS (PA) ---\n")##
## --- 3. PARALLEL ANALYSIS (PA) ---pa_A <- fa.parallel(data_A_EFA,
cor = "cor",
fm = "pa",
fa = "fa",
main = "Parallel Analysis - Domain A (13 Items)")
## Parallel analysis suggests that the number of factors = 3 and the number of components = NA# ==============================================================================
# BƯỚC 2 (DOMAIN A): THỬ NGHIỆM EFA 2 VÀ 3 NHÂN TỐ (XOAY PROMAX)
# ==============================================================================
library(psych)
cat("\n--- MÔ HÌNH 2 NHÂN TỐ (Theo gợi ý Kaiser & VSS & Parallel Analysis) ---\n")##
## --- MÔ HÌNH 2 NHÂN TỐ (Theo gợi ý Kaiser & VSS & Parallel Analysis) ---efa_A_2 <- fa(data_A_EFA, nfactors = 2, cor = "poly", fm = "pa", rotate = "promax")## Warning in cor.smooth(mat): Matrix was not positive definite, smoothing was
## done# In ma trận hệ số tải, ẩn số < 0.3 để dễ nhìn
print(efa_A_2$loadings, cutoff = 0.3, sort = TRUE)##
## Loadings:
## PA1 PA2
## R_A3 0.840
## R_A4 0.885
## R_A5 0.889
## R_A6 0.857
## R_A7 0.955
## R_A8 0.730
## R_A9 0.875
## R_A10 0.953
## R_A11 0.833
## R_A12 0.873
## R_A13 0.883
## R_A1_REV 0.669
## R_A2_REV 0.824
##
## PA1 PA2
## SS loadings 8.373 1.254
## Proportion Var 0.644 0.096
## Cumulative Var 0.644 0.741cat("\n--------------------------------------------------\n")##
## --------------------------------------------------cat("\n--- MÔ HÌNH 3 NHÂN TỐ (Theo gợi ý Parallel Analysis) ---\n") #Tuy nhiên chạy lại lần 2 lại gợi ý 2 factors?##
## --- MÔ HÌNH 3 NHÂN TỐ (Theo gợi ý Parallel Analysis) ---efa_A_3 <- fa(data_A_EFA, nfactors = 3, cor = "poly", fm = "pa", rotate = "promax")## Warning in cor.smooth(mat): Matrix was not positive definite, smoothing was
## done# In ma trận hệ số tải, ẩn số < 0.3 để dễ nhìn
print(efa_A_3$loadings, cutoff = 0.3, sort = TRUE)##
## Loadings:
## PA1 PA3 PA2
## R_A3 0.884
## R_A4 0.849
## R_A5 1.039
## R_A6 0.834
## R_A7 0.778
## R_A8 0.681
## R_A9 0.621
## R_A10 0.793
## R_A11 0.742
## R_A12 0.675
## R_A13 0.911
## R_A1_REV 0.680
## R_A2_REV 0.802
##
## PA1 PA3 PA2
## SS loadings 5.491 2.041 1.231
## Proportion Var 0.422 0.157 0.095
## Cumulative Var 0.422 0.579 0.674cat("\n--- MÔ HÌNH 1 NHÂN TỐ (Theo gợi ý MAP) ---\n")##
## --- MÔ HÌNH 1 NHÂN TỐ (Theo gợi ý MAP) ---efa_A_1 <- fa(data_A_EFA, nfactors = 1, cor = "poly", fm = "pa", rotate = "promax")## Warning in cor.smooth(mat): Matrix was not positive definite, smoothing was
## done# In ma trận hệ số tải, ẩn số < 0.3 để dễ nhìn
print(efa_A_1$loadings, cutoff = 0.3, sort = TRUE)##
## Loadings:
## PA1
## R_A3 0.854
## R_A4 0.924
## R_A5 0.919
## R_A6 0.854
## R_A7 0.917
## R_A8 0.654
## R_A9 0.898
## R_A10 0.912
## R_A11 0.852
## R_A12 0.904
## R_A13 0.900
## R_A1_REV
## R_A2_REV
##
## PA1
## SS loadings 8.524
## Proportion Var 0.656# ==============================================================================
# BƯỚC 1 (DOMAIN A): LOẠI BỎ R_A1_REV VÀ KIỂM TRA LẠI CẤU TRÚC (PA)
# ==============================================================================
library(psych)
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI R_A1_REV (CÒN 12 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI R_A1_REV (CÒN 12 CÂU) ---data_A_drop1 <- data_A_EFA[, !(names(data_A_EFA) %in% c("R_A1_REV"))]
cat("\n--- 2. CHẠY PARALLEL ANALYSIS (PA) ---\n")##
## --- 2. CHẠY PARALLEL ANALYSIS (PA) ---pa_A_v1 <- fa.parallel(data_A_drop1, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain A (Loại A1_REV)")
## Parallel analysis suggests that the number of factors = 1 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_A_v1$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 1cat("\n--- 3. CHẠY EFA VỚI SỐ NHÂN TỐ PA GỢI Ý ---\n")##
## --- 3. CHẠY EFA VỚI SỐ NHÂN TỐ PA GỢI Ý ---efa_A_v1 <- fa(data_A_drop1, nfactors = pa_A_v1$nfact, cor = "poly", fm = "pa", rotate = "promax")## Warning in cor.smooth(mat): Matrix was not positive definite, smoothing was
## done# 3.1. Trích xuất dữ liệu gốc
loadings_A1 <- round(as.data.frame(unclass(efa_A_v1$loadings)), 3)
loadings_A1$Communality <- round(efa_A_v1$communality, 3)
loadings_A1$Complexity <- round(efa_A_v1$complexity, 3)
# 3.2. Tạo bảng hiển thị: Ẩn các hệ số tải < 0.3
display_A1 <- loadings_A1
n_factors <- pa_A_v1$nfact
# Vòng lặp dò qua các cột nhân tố, nếu trị tuyệt đối < 0.3 thì biến thành khoảng trắng
for(i in 1:n_factors) {
display_A1[, i] <- ifelse(abs(loadings_A1[, i]) < 0.3, "", as.character(loadings_A1[, i]))
}
# 3.3. Sắp xếp giảm dần theo hệ số tải nhân tố 1
display_A1 <- display_A1[order(-abs(loadings_A1[, 1])), , drop = FALSE]
cat("\n--- BẢNG HỆ SỐ TẢI (ĐÃ ẨN < 0.3) ---\n")##
## --- BẢNG HỆ SỐ TẢI (ĐÃ ẨN < 0.3) ---# Dùng quote = FALSE để bảng in ra không bị dính dấu ngoặc kép ""
print(display_A1, quote = FALSE)## PA1 Communality Complexity
## R_A4 0.922 0.851 1
## R_A5 0.918 0.842 1
## R_A7 0.918 0.843 1
## R_A10 0.914 0.835 1
## R_A12 0.904 0.817 1
## R_A13 0.901 0.811 1
## R_A9 0.897 0.805 1
## R_A6 0.855 0.731 1
## R_A3 0.854 0.729 1
## R_A11 0.852 0.725 1
## R_A8 0.657 0.432 1
## R_A2_REV 0.079 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (LẦN 1) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (LẦN 1) ---print(round(efa_A_v1$Vaccounted, 3))## PA1
## SS loadings 8.501
## Proportion Var 0.708# ==============================================================================
# BƯỚC 2 (DOMAIN A): LOẠI TIẾP R_A2_REV VÀ KIỂM TRA LẠI CẤU TRÚC (PA)
# ==============================================================================
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI A1_REV VÀ A2_REV (CÒN 11 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI A1_REV VÀ A2_REV (CÒN 11 CÂU) ---data_A_drop2 <- data_A_drop1[, !(names(data_A_drop1) %in% c("R_A2_REV"))]
cat("\n--- 2. CHẠY PARALLEL ANALYSIS (PA) ---\n")##
## --- 2. CHẠY PARALLEL ANALYSIS (PA) ---pa_A_v2 <- fa.parallel(data_A_drop2, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain A (Loại A1, A2)")
## Parallel analysis suggests that the number of factors = 1 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_A_v2$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 1cat("\n--- 3. CHẠY EFA VỚI SỐ NHÂN TỐ PA GỢI Ý ---\n")##
## --- 3. CHẠY EFA VỚI SỐ NHÂN TỐ PA GỢI Ý ---efa_A_v2 <- fa(data_A_drop2, nfactors = pa_A_v2$nfact, cor = "poly", fm = "pa", rotate = "promax")## Warning in cor.smooth(mat): Matrix was not positive definite, smoothing was
## done# 3.1. Trích xuất dữ liệu gốc
loadings_A2 <- round(as.data.frame(unclass(efa_A_v2$loadings)), 3)
loadings_A2$Communality <- round(efa_A_v2$communality, 3)
loadings_A2$Complexity <- round(efa_A_v2$complexity, 3)
# 3.2. Tạo bảng hiển thị: Ẩn các hệ số tải < 0.3
display_A2 <- loadings_A2
n_factors_v2 <- pa_A_v2$nfact
for(i in 1:n_factors_v2) {
display_A2[, i] <- ifelse(abs(loadings_A2[, i]) < 0.3, "", as.character(loadings_A2[, i]))
}
# 3.3. Sắp xếp giảm dần theo hệ số tải nhân tố 1
display_A2 <- display_A2[order(-abs(loadings_A2[, 1])), , drop = FALSE]
cat("\n--- BẢNG HỆ SỐ TẢI (ĐÃ ẨN < 0.3) ---\n")##
## --- BẢNG HỆ SỐ TẢI (ĐÃ ẨN < 0.3) ---print(display_A2, quote = FALSE)## PA1 Communality Complexity
## R_A7 0.922 0.850 1
## R_A4 0.92 0.846 1
## R_A10 0.919 0.844 1
## R_A5 0.916 0.840 1
## R_A12 0.901 0.811 1
## R_A13 0.899 0.809 1
## R_A9 0.896 0.803 1
## R_A6 0.854 0.730 1
## R_A3 0.852 0.726 1
## R_A11 0.851 0.724 1
## R_A8 0.664 0.440 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (LẦN 2) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (LẦN 2) ---print(round(efa_A_v2$Vaccounted, 3))## PA1
## SS loadings 8.423
## Proportion Var 0.766#>CFA - ANALYSIS FOR DOMAIN A
# ==============================================================================
# BƯỚC 4 (DOMAIN A): CFA - KIỂM ĐỊNH MÔ HÌNH ĐO LƯỜNG (TẬP CFA)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA CHO 11 CÂU THÁI ĐỘ ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA CHO 11 CÂU THÁI ĐỘ ---# 1. Khai báo danh sách 11 biến
vars_A_final <- c("R_A3", "R_A4", "R_A5", "R_A6", "R_A7", "R_A8",
"R_A9", "R_A10", "R_A11", "R_A12", "R_A13")
# 2. Viết phương trình mô hình
model_A <- '
Attitude =~ R_A3 + R_A4 + R_A5 + R_A6 + R_A7 + R_A8 +
R_A9 + R_A10 + R_A11 + R_A12 + R_A13
'
# 3. Chạy CFA với WLSMV
fit_A <- cfa(model_A,
data = data_A_CFA,
ordered = vars_A_final,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= -1.134508e-17)
## is smaller than zero. This may be a symptom that the model is not
## identified.# 4. Xuất kết quả các chỉ số phù hợp (Fit Measures)
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---summary(fit_A, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 32 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 44
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 246.763 313.800
## Degrees of freedom 44 44
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.839
## Shift parameter 19.796
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 35325.739 11941.228
## Degrees of freedom 55 55
## P-value NA 0.000
## Scaling correction factor 2.967
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.994 0.977
## Tucker-Lewis Index (TLI) 0.993 0.972
##
## Robust Comparative Fit Index (CFI) 0.771
## Robust Tucker-Lewis Index (TLI) 0.714
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.145 0.167
## 90 Percent confidence interval - lower 0.128 0.150
## 90 Percent confidence interval - upper 0.163 0.185
## P-value H_0: RMSEA <= 0.050 0.000 0.000
## P-value H_0: RMSEA >= 0.080 1.000 1.000
##
## Robust RMSEA 0.281
## 90 Percent confidence interval - lower 0.255
## 90 Percent confidence interval - upper 0.307
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.067 0.067
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.832 0.832
## R_A4 1.090 0.027 39.739 0.000 0.907 0.907
## R_A5 1.103 0.031 35.181 0.000 0.918 0.918
## R_A6 1.017 0.031 32.374 0.000 0.846 0.846
## R_A7 1.062 0.029 36.970 0.000 0.884 0.884
## R_A8 0.793 0.048 16.618 0.000 0.660 0.660
## R_A9 1.058 0.031 34.449 0.000 0.881 0.881
## R_A10 1.033 0.031 32.797 0.000 0.860 0.860
## R_A11 1.051 0.031 33.528 0.000 0.875 0.875
## R_A12 1.110 0.030 36.402 0.000 0.924 0.924
## R_A13 1.128 0.031 36.052 0.000 0.939 0.939
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A4|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A4|t2 -0.591 0.090 -6.545 0.000 -0.591 -0.591
## R_A4|t3 1.184 0.110 10.742 0.000 1.184 1.184
## R_A5|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_A5|t2 -0.591 0.090 -6.545 0.000 -0.591 -0.591
## R_A5|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_A11|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A11|t2 -0.564 0.090 -6.283 0.000 -0.564 -0.564
## R_A11|t3 0.926 0.099 9.324 0.000 0.926 0.926
## R_A12|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A12|t2 -0.538 0.089 -6.020 0.000 -0.538 -0.538
## R_A12|t3 1.231 0.113 10.926 0.000 1.231 1.231
## R_A13|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A13|t2 -0.524 0.089 -5.888 0.000 -0.524 -0.524
## R_A13|t3 1.056 0.104 10.125 0.000 1.056 1.056
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.307 0.307 0.307
## .R_A4 0.177 0.177 0.177
## .R_A5 0.158 0.158 0.158
## .R_A6 0.284 0.284 0.284
## .R_A7 0.219 0.219 0.219
## .R_A8 0.564 0.564 0.564
## .R_A9 0.224 0.224 0.224
## .R_A10 0.261 0.261 0.261
## .R_A11 0.235 0.235 0.235
## .R_A12 0.147 0.147 0.147
## .R_A13 0.118 0.118 0.118
## Attitude 0.693 0.039 17.761 0.000 1.000 1.000cat("\n--- 3. MODIFICATION INDICES (MI) ---\n")##
## --- 3. MODIFICATION INDICES (MI) ---# Lấy ra Top 10 gợi ý chỉnh sửa có MI cao nhất để xem xét
mi_A <- modindices(fit_A)
mi_A_sorted <- mi_A[mi_A$op == "~~", ] # Chỉ xem xét tương quan phần dư
mi_A_sorted <- mi_A_sorted[order(-mi_A_sorted$mi), ]
print(head(mi_A_sorted, 15))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 90 R_A4 ~~ R_A5 54.934 0.168 0.168 1.007 1.007
## 134 R_A12 ~~ R_A13 27.724 0.132 0.132 1.001 1.001
## 133 R_A11 ~~ R_A13 24.796 0.119 0.119 0.717 0.717
## 121 R_A8 ~~ R_A10 17.158 0.169 0.169 0.439 0.439
## 105 R_A5 ~~ R_A12 13.260 -0.136 -0.136 -0.894 -0.894
## 97 R_A4 ~~ R_A12 13.111 -0.131 -0.131 -0.810 -0.810
## 96 R_A4 ~~ R_A11 11.844 -0.146 -0.146 -0.716 -0.716
## 119 R_A7 ~~ R_A13 11.689 -0.132 -0.132 -0.819 -0.819
## 94 R_A4 ~~ R_A9 11.512 -0.146 -0.146 -0.734 -0.734
## 98 R_A4 ~~ R_A13 10.639 -0.116 -0.116 -0.802 -0.802
## 116 R_A7 ~~ R_A10 10.593 0.101 0.101 0.422 0.422
## 118 R_A7 ~~ R_A12 10.504 -0.119 -0.119 -0.664 -0.664
## 107 R_A6 ~~ R_A7 9.863 0.106 0.106 0.424 0.424
## 104 R_A5 ~~ R_A11 9.714 -0.122 -0.122 -0.635 -0.635
## 113 R_A6 ~~ R_A13 9.081 -0.129 -0.129 -0.706 -0.706# ==============================================================================
# BƯỚC 6 (DOMAIN A): CFA CHO MÔ HÌNH RÚT GỌN (10 CÂU - LOẠI BỎ A4)
#LOẠI A4 VÌ A4 VÀ A5 ĐO LƯỜNG NỘI DUNG GẦN NHƯ GIỐNG NHAU
# ==============================================================================
library(lavaan)
cat("\n--- CHẠY CFA 10 CÂU (LOẠI BỎ A4 DO TRÙNG LẶP NỘI DUNG VỚI A5) ---\n")##
## --- CHẠY CFA 10 CÂU (LOẠI BỎ A4 DO TRÙNG LẶP NỘI DUNG VỚI A5) ---# 1. Danh sách 10 biến còn lại
vars_A_10 <- c("R_A3", "R_A5", "R_A6", "R_A7", "R_A8",
"R_A9", "R_A10", "R_A11", "R_A12", "R_A13")
# 2. Phương trình mô hình sạch
model_A_10 <- '
Attitude =~ R_A3 + R_A5 + R_A6 + R_A7 + R_A8 +
R_A9 + R_A10 + R_A11 + R_A12 + R_A13
'
# 3. Chạy lại CFA
fit_A_10 <- cfa(model_A_10,
data = data_A_CFA,
ordered = vars_A_10,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 5.426996e-17)
## is close to zero. This may be a symptom that the model is not identified.# 4. Xuất kết quả
summary(fit_A_10, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 30 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 40
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 154.864 236.156
## Degrees of freedom 35 35
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.695
## Shift parameter 13.317
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 27019.013 10152.684
## Degrees of freedom 45 45
## P-value NA 0.000
## Scaling correction factor 2.669
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.996 0.980
## Tucker-Lewis Index (TLI) 0.994 0.974
##
## Robust Comparative Fit Index (CFI) 0.813
## Robust Tucker-Lewis Index (TLI) 0.760
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.125 0.162
## 90 Percent confidence interval - lower 0.105 0.143
## 90 Percent confidence interval - upper 0.145 0.182
## P-value H_0: RMSEA <= 0.050 0.000 0.000
## P-value H_0: RMSEA >= 0.080 1.000 1.000
##
## Robust RMSEA 0.262
## 90 Percent confidence interval - lower 0.235
## 90 Percent confidence interval - upper 0.291
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.060 0.060
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.825 0.825
## R_A5 1.052 0.033 32.351 0.000 0.868 0.868
## R_A6 1.030 0.034 30.487 0.000 0.850 0.850
## R_A7 1.072 0.032 33.248 0.000 0.884 0.884
## R_A8 0.816 0.049 16.735 0.000 0.673 0.673
## R_A9 1.080 0.032 33.611 0.000 0.891 0.891
## R_A10 1.048 0.033 31.466 0.000 0.865 0.865
## R_A11 1.068 0.033 32.501 0.000 0.881 0.881
## R_A12 1.131 0.033 34.634 0.000 0.933 0.933
## R_A13 1.147 0.033 34.469 0.000 0.946 0.946
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A5|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_A5|t2 -0.591 0.090 -6.545 0.000 -0.591 -0.591
## R_A5|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_A11|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A11|t2 -0.564 0.090 -6.283 0.000 -0.564 -0.564
## R_A11|t3 0.926 0.099 9.324 0.000 0.926 0.926
## R_A12|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A12|t2 -0.538 0.089 -6.020 0.000 -0.538 -0.538
## R_A12|t3 1.231 0.113 10.926 0.000 1.231 1.231
## R_A13|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A13|t2 -0.524 0.089 -5.888 0.000 -0.524 -0.524
## R_A13|t3 1.056 0.104 10.125 0.000 1.056 1.056
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.320 0.320 0.320
## .R_A5 0.246 0.246 0.246
## .R_A6 0.278 0.278 0.278
## .R_A7 0.218 0.218 0.218
## .R_A8 0.547 0.547 0.547
## .R_A9 0.207 0.207 0.207
## .R_A10 0.253 0.253 0.253
## .R_A11 0.224 0.224 0.224
## .R_A12 0.130 0.130 0.130
## .R_A13 0.105 0.105 0.105
## Attitude 0.680 0.040 16.978 0.000 1.000 1.000# Xem lại MI để chuẩn bị cho bước tiếp theo nếu cần
cat("\n--- MODIFICATION INDICES CHO MÔ HÌNH 10 CÂU ---\n")##
## --- MODIFICATION INDICES CHO MÔ HÌNH 10 CÂU ---mi_A_10 <- modindices(fit_A_10)
print(head(mi_A_10[mi_A_10$op == "~~", ][order(-mi_A_10$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 117 R_A12 ~~ R_A13 18.953 0.114 0.114 0.974 0.974
## 116 R_A11 ~~ R_A13 17.023 0.103 0.103 0.673 0.673
## 73 R_A3 ~~ R_A5 16.290 0.133 0.133 0.475 0.475
## 104 R_A8 ~~ R_A10 14.061 0.155 0.155 0.416 0.416
## 102 R_A7 ~~ R_A13 13.529 -0.144 -0.144 -0.950 -0.950# ==============================================================================
# BƯỚC 8 (DOMAIN A): CFA MÔ HÌNH 9 CÂU (LOẠI BỎ A4 VÀ A13)
# ==============================================================================
library(lavaan)
cat("\n--- CHẠY CFA 9 CÂU (LOẠI BỎ A13) ---\n")##
## --- CHẠY CFA 9 CÂU (LOẠI BỎ A13) ---# 1. Danh sách 9 biến còn lại sau khi lọc sạch
vars_A_9 <- c("R_A3", "R_A5", "R_A6", "R_A7", "R_A8",
"R_A9", "R_A10", "R_A11", "R_A12")
# 2. Phương trình mô hình sạch (Không cần nối phần dư)
model_A_9 <- '
Attitude =~ R_A3 + R_A5 + R_A6 + R_A7 + R_A8 +
R_A9 + R_A10 + R_A11 + R_A12
'
# 3. Chạy lại CFA với WLSMV
fit_A_9 <- cfa(model_A_9,
data = data_A_CFA,
ordered = vars_A_9,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 3.882873e-17)
## is close to zero. This may be a symptom that the model is not identified.# 4. Xuất kết quả các chỉ số phù hợp
summary(fit_A_9, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 27 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 36
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 88.296 156.428
## Degrees of freedom 27 27
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.596
## Shift parameter 8.296
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 18418.248 7404.169
## Degrees of freedom 36 36
## P-value NA 0.000
## Scaling correction factor 2.495
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.997 0.982
## Tucker-Lewis Index (TLI) 0.996 0.977
##
## Robust Comparative Fit Index (CFI) 0.882
## Robust Tucker-Lewis Index (TLI) 0.842
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.102 0.148
## 90 Percent confidence interval - lower 0.079 0.126
## 90 Percent confidence interval - upper 0.126 0.171
## P-value H_0: RMSEA <= 0.050 0.000 0.000
## P-value H_0: RMSEA >= 0.080 0.940 1.000
##
## Robust RMSEA 0.209
## 90 Percent confidence interval - lower 0.180
## 90 Percent confidence interval - upper 0.239
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.051 0.051
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.834 0.834
## R_A5 1.047 0.032 32.677 0.000 0.873 0.873
## R_A6 1.038 0.033 31.813 0.000 0.865 0.865
## R_A7 1.077 0.031 34.664 0.000 0.898 0.898
## R_A8 0.822 0.047 17.363 0.000 0.685 0.685
## R_A9 1.068 0.032 33.059 0.000 0.890 0.890
## R_A10 1.055 0.033 32.253 0.000 0.879 0.879
## R_A11 1.026 0.036 28.263 0.000 0.855 0.855
## R_A12 1.088 0.031 34.982 0.000 0.907 0.907
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A5|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_A5|t2 -0.591 0.090 -6.545 0.000 -0.591 -0.591
## R_A5|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_A11|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A11|t2 -0.564 0.090 -6.283 0.000 -0.564 -0.564
## R_A11|t3 0.926 0.099 9.324 0.000 0.926 0.926
## R_A12|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A12|t2 -0.538 0.089 -6.020 0.000 -0.538 -0.538
## R_A12|t3 1.231 0.113 10.926 0.000 1.231 1.231
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.305 0.305 0.305
## .R_A5 0.238 0.238 0.238
## .R_A6 0.251 0.251 0.251
## .R_A7 0.194 0.194 0.194
## .R_A8 0.531 0.531 0.531
## .R_A9 0.208 0.208 0.208
## .R_A10 0.227 0.227 0.227
## .R_A11 0.268 0.268 0.268
## .R_A12 0.177 0.177 0.177
## Attitude 0.695 0.040 17.313 0.000 1.000 1.000cat("\n--- MODIFICATION INDEX 9-ITEMS SCALE ---\n")##
## --- MODIFICATION INDEX 9-ITEMS SCALE ---mi_A_9 <- modindices(fit_A_9)
print(head(mi_A_9[mi_A_9$op == "~~", ][order(-mi_A_9$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 101 R_A11 ~~ R_A12 26.776 0.153 0.153 0.705 0.705
## 66 R_A3 ~~ R_A5 13.307 0.124 0.124 0.462 0.462
## 91 R_A7 ~~ R_A12 11.166 -0.129 -0.129 -0.695 -0.695
## 93 R_A8 ~~ R_A10 10.171 0.134 0.134 0.388 0.388
## 90 R_A7 ~~ R_A11 6.437 -0.105 -0.105 -0.461 -0.461# ==============================================================================
# BƯỚC 9B (DOMAIN A): CFA 9 CÂU - CHỈ NỐI HIỆP PHƯƠNG SAI A11 ~~ A12
# ==============================================================================
library(lavaan)
cat("\n--- CHẠY CFA 9 CÂU: CHỈ NỐI CẶP (A11 ~~ A12) ---\n")##
## --- CHẠY CFA 9 CÂU: CHỈ NỐI CẶP (A11 ~~ A12) ---# 1. Định nghĩa mô hình
model_A_single_fix <- '
# Nhân tố chính
Attitude =~ R_A3 + R_A5 + R_A6 + R_A7 + R_A8 +
R_A9 + R_A10 + R_A11 + R_A12
# Chỉ nối một cặp trùng lặp nặng nhất
R_A11 ~~ R_A12
'
# 2. Chạy CFA với WLSMV
fit_A_single_fix <- cfa(model_A_single_fix,
data = data_A_CFA,
ordered = vars_A_9,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 3.241942e-17)
## is close to zero. This may be a symptom that the model is not identified.# 3. Xuất kết quả Robust Fit Measures
summary(fit_A_single_fix, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 30 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 37
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 61.530 116.391
## Degrees of freedom 26 26
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.568
## Shift parameter 7.981
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 18418.248 7404.169
## Degrees of freedom 36 36
## P-value NA 0.000
## Scaling correction factor 2.495
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.998 0.988
## Tucker-Lewis Index (TLI) 0.997 0.983
##
## Robust Comparative Fit Index (CFI) 0.914
## Robust Tucker-Lewis Index (TLI) 0.881
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.079 0.126
## 90 Percent confidence interval - lower 0.054 0.103
## 90 Percent confidence interval - upper 0.105 0.150
## P-value H_0: RMSEA <= 0.050 0.032 0.000
## P-value H_0: RMSEA >= 0.080 0.500 0.999
##
## Robust RMSEA 0.182
## 90 Percent confidence interval - lower 0.152
## 90 Percent confidence interval - upper 0.213
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.043 0.043
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.838 0.838
## R_A5 1.047 0.032 32.603 0.000 0.877 0.877
## R_A6 1.038 0.033 31.849 0.000 0.870 0.870
## R_A7 1.076 0.031 34.708 0.000 0.902 0.902
## R_A8 0.821 0.047 17.395 0.000 0.688 0.688
## R_A9 1.075 0.033 32.655 0.000 0.901 0.901
## R_A10 1.059 0.033 32.065 0.000 0.887 0.887
## R_A11 0.965 0.037 26.249 0.000 0.809 0.809
## R_A12 1.040 0.032 32.630 0.000 0.872 0.872
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A11 ~~
## .R_A12 0.151 0.027 5.521 0.000 0.151 0.525
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A5|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_A5|t2 -0.591 0.090 -6.545 0.000 -0.591 -0.591
## R_A5|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_A11|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A11|t2 -0.564 0.090 -6.283 0.000 -0.564 -0.564
## R_A11|t3 0.926 0.099 9.324 0.000 0.926 0.926
## R_A12|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A12|t2 -0.538 0.089 -6.020 0.000 -0.538 -0.538
## R_A12|t3 1.231 0.113 10.926 0.000 1.231 1.231
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.297 0.297 0.297
## .R_A5 0.230 0.230 0.230
## .R_A6 0.243 0.243 0.243
## .R_A7 0.187 0.187 0.187
## .R_A8 0.527 0.527 0.527
## .R_A9 0.188 0.188 0.188
## .R_A10 0.213 0.213 0.213
## .R_A11 0.346 0.346 0.346
## .R_A12 0.240 0.240 0.240
## Attitude 0.703 0.040 17.497 0.000 1.000 1.000# 4. Kiểm tra các MI còn lại
cat("\n--- CÁC CHỈ SỐ MI CÒN LẠI SAU KHI NỐI A11-A12 ---\n")##
## --- CÁC CHỈ SỐ MI CÒN LẠI SAU KHI NỐI A11-A12 ---mi_final <- modindices(fit_A_single_fix)
print(head(mi_final[mi_final$op == "~~", ][order(-mi_final$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 98 R_A9 ~~ R_A11 12.303 0.116 0.116 0.456 0.456
## 67 R_A3 ~~ R_A5 11.119 0.114 0.114 0.437 0.437
## 94 R_A8 ~~ R_A10 8.671 0.125 0.125 0.373 0.373
## 84 R_A6 ~~ R_A9 6.539 -0.109 -0.109 -0.510 -0.510
## 92 R_A7 ~~ R_A12 5.718 -0.093 -0.093 -0.440 -0.440# ==============================================================================
# BƯỚC 10 (DOMAIN A): CFA 9 CÂU - PHƯƠNG ÁN TỐI ƯU (NỐI 11-12 VÀ 3-5)
# ==============================================================================
library(lavaan)
cat("\n--- CHẠY CFA 9 CÂU: ĐỐI CHIẾU NỘI DUNG MỚI & NỐI CÁC CẶP TRÙNG LẶP ---\n")##
## --- CHẠY CFA 9 CÂU: ĐỐI CHIẾU NỘI DUNG MỚI & NỐI CÁC CẶP TRÙNG LẶP ---# 1. Định nghĩa mô hình sạch (Loại bỏ A4, A13)
model_A_final <- '
# Nhân tố chính: Thái độ đối với EBM
Attitude =~ R_A3 + R_A5 + R_A6 + R_A7 + R_A8 +
R_A9 + R_A10 + R_A11 + R_A12
# Nối phần dư cho các cặp có tương quan nội dung cao (MI > 10)
R_A11 ~~ R_A12 # Cùng là khía cạnh Đào tạo/Cập nhật kiến thức
R_A3 ~~ R_A5 # Cùng là khía cạnh Sẵn lòng/Ủng hộ áp dụng
'
# 2. Chạy CFA với WLSMV
fit_A_final <- cfa(model_A_final,
data = data_A_CFA,
ordered = vars_A_9,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 9.009217e-17)
## is close to zero. This may be a symptom that the model is not identified.# 3. Xuất kết quả tổng thể (Tập trung vào cột Robust)
summary(fit_A_final, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 30 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 38
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 50.369 100.874
## Degrees of freedom 25 25
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.541
## Shift parameter 7.762
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 18418.248 7404.169
## Degrees of freedom 36 36
## P-value NA 0.000
## Scaling correction factor 2.495
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.999 0.990
## Tucker-Lewis Index (TLI) 0.998 0.985
##
## Robust Comparative Fit Index (CFI) 0.926
## Robust Tucker-Lewis Index (TLI) 0.894
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.068 0.118
## 90 Percent confidence interval - lower 0.040 0.094
## 90 Percent confidence interval - upper 0.095 0.142
## P-value H_0: RMSEA <= 0.050 0.130 0.000
## P-value H_0: RMSEA >= 0.080 0.252 0.995
##
## Robust RMSEA 0.172
## 90 Percent confidence interval - lower 0.141
## 90 Percent confidence interval - upper 0.203
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.040 0.040
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.811 0.811
## R_A5 1.057 0.033 31.600 0.000 0.857 0.857
## R_A6 1.077 0.038 27.990 0.000 0.873 0.873
## R_A7 1.117 0.039 28.952 0.000 0.906 0.906
## R_A8 0.851 0.050 17.095 0.000 0.690 0.690
## R_A9 1.115 0.040 27.851 0.000 0.904 0.904
## R_A10 1.097 0.040 27.535 0.000 0.890 0.890
## R_A11 1.001 0.042 23.633 0.000 0.812 0.812
## R_A12 1.079 0.038 28.306 0.000 0.875 0.875
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A11 ~~
## .R_A12 0.146 0.027 5.312 0.000 0.146 0.516
## .R_A3 ~~
## .R_A5 0.114 0.032 3.563 0.000 0.114 0.379
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A5|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_A5|t2 -0.591 0.090 -6.545 0.000 -0.591 -0.591
## R_A5|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_A11|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A11|t2 -0.564 0.090 -6.283 0.000 -0.564 -0.564
## R_A11|t3 0.926 0.099 9.324 0.000 0.926 0.926
## R_A12|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A12|t2 -0.538 0.089 -6.020 0.000 -0.538 -0.538
## R_A12|t3 1.231 0.113 10.926 0.000 1.231 1.231
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.342 0.342 0.342
## .R_A5 0.265 0.265 0.265
## .R_A6 0.237 0.237 0.237
## .R_A7 0.179 0.179 0.179
## .R_A8 0.524 0.524 0.524
## .R_A9 0.183 0.183 0.183
## .R_A10 0.208 0.208 0.208
## .R_A11 0.341 0.341 0.341
## .R_A12 0.234 0.234 0.234
## Attitude 0.658 0.045 14.554 0.000 1.000 1.000cat("\n--- Modification Index ---\n")##
## --- Modification Index ---mi_check <- modindices(fit_A_final)
print(head(mi_check[mi_check$op == "~~", ][order(-mi_check$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 98 R_A9 ~~ R_A11 10.565 0.109 0.109 0.436 0.436
## 94 R_A8 ~~ R_A10 8.084 0.121 0.121 0.365 0.365
## 84 R_A6 ~~ R_A9 7.469 -0.117 -0.117 -0.562 -0.562
## 92 R_A7 ~~ R_A12 6.997 -0.104 -0.104 -0.507 -0.507
## 75 R_A5 ~~ R_A6 5.195 0.085 0.085 0.340 0.340# ==============================================================================
# BƯỚC CFA: MÔ HÌNH 9 CÂU (NỐI 3 CẶP PHẦN DƯ: A11-A12, A3-A5, A9-A11)
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA 9 CÂU (ĐẶT STENT LẦN 3) ---\n")##
## --- 1. CHẠY CFA 9 CÂU (ĐẶT STENT LẦN 3) ---model_A_9_adj3 <- '
Attitude =~ R_A3 + R_A5 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10 + R_A11 + R_A12
# Các đường nối phần dư (Stents)
R_A11 ~~ R_A12
R_A3 ~~ R_A5
R_A9 ~~ R_A11
'
fit_A_9_adj3 <- cfa(model_A_9_adj3,
data = data_A_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 7.417868e-17)
## is close to zero. This may be a symptom that the model is not identified.cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP ---summary(fit_A_9_adj3, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 28 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 39
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 39.758 86.094
## Degrees of freedom 24 24
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.502
## Shift parameter 6.823
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 18418.248 7404.169
## Degrees of freedom 36 36
## P-value NA 0.000
## Scaling correction factor 2.495
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.999 0.992
## Tucker-Lewis Index (TLI) 0.999 0.987
##
## Robust Comparative Fit Index (CFI) 0.927
## Robust Tucker-Lewis Index (TLI) 0.891
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.055 0.109
## 90 Percent confidence interval - lower 0.021 0.084
## 90 Percent confidence interval - upper 0.084 0.134
## P-value H_0: RMSEA <= 0.050 0.367 0.000
## P-value H_0: RMSEA >= 0.080 0.082 0.973
##
## Robust RMSEA 0.174
## 90 Percent confidence interval - lower 0.141
## 90 Percent confidence interval - upper 0.208
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.037 0.037
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.817 0.817
## R_A5 1.054 0.033 31.503 0.000 0.862 0.862
## R_A6 1.073 0.039 27.749 0.000 0.877 0.877
## R_A7 1.114 0.039 28.707 0.000 0.910 0.910
## R_A8 0.847 0.050 17.088 0.000 0.692 0.692
## R_A9 1.082 0.043 25.371 0.000 0.884 0.884
## R_A10 1.094 0.040 27.319 0.000 0.894 0.894
## R_A11 0.948 0.048 19.849 0.000 0.775 0.775
## R_A12 1.072 0.039 27.737 0.000 0.876 0.876
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A11 ~~
## .R_A12 0.178 0.030 5.966 0.000 0.178 0.582
## .R_A3 ~~
## .R_A5 0.106 0.033 3.249 0.001 0.106 0.361
## .R_A9 ~~
## .R_A11 0.108 0.028 3.886 0.000 0.108 0.367
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A5|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_A5|t2 -0.591 0.090 -6.545 0.000 -0.591 -0.591
## R_A5|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_A11|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A11|t2 -0.564 0.090 -6.283 0.000 -0.564 -0.564
## R_A11|t3 0.926 0.099 9.324 0.000 0.926 0.926
## R_A12|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A12|t2 -0.538 0.089 -6.020 0.000 -0.538 -0.538
## R_A12|t3 1.231 0.113 10.926 0.000 1.231 1.231
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.332 0.332 0.332
## .R_A5 0.258 0.258 0.258
## .R_A6 0.232 0.232 0.232
## .R_A7 0.172 0.172 0.172
## .R_A8 0.521 0.521 0.521
## .R_A9 0.218 0.218 0.218
## .R_A10 0.202 0.202 0.202
## .R_A11 0.400 0.400 0.400
## .R_A12 0.233 0.233 0.233
## Attitude 0.668 0.046 14.438 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---mi_A_9_adj3 <- modindices(fit_A_9_adj3)
mi_A_9_adj3_res <- mi_A_9_adj3[mi_A_9_adj3$op == "~~", ]
print(head(mi_A_9_adj3_res[order(-mi_A_9_adj3_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 93 R_A7 ~~ R_A12 7.761 -0.110 -0.110 -0.547 -0.547
## 95 R_A8 ~~ R_A10 7.346 0.115 0.115 0.356 0.356
## 99 R_A9 ~~ R_A12 6.827 0.092 0.092 0.408 0.408
## 85 R_A6 ~~ R_A9 5.332 -0.099 -0.099 -0.443 -0.443
## 76 R_A5 ~~ R_A6 4.153 0.077 0.077 0.314 0.314# ==============================================================================
# BƯỚC CFA TIẾP THEO: LÀM SẠCH THANG ĐO (CẮT BỎ R_A11 & THÁO hiệp phương sai)
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA 8 CÂU THÁI ĐỘ (ĐÃ LOẠI R_A11) ---\n")##
## --- 1. CHẠY CFA 8 CÂU THÁI ĐỘ (ĐÃ LOẠI R_A11) ---# Định nghĩa mô hình: Giữ lại 8 câu tinh nhuệ, tháo bỏ toàn bộ đường nối phần dư
model_A_8 <- '
Attitude =~ R_A3 + R_A5 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10 + R_A12
'
fit_A_8 <- cfa(model_A_8,
data = data_A_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 7.938647e-17)
## is close to zero. This may be a symptom that the model is not identified.cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MÔ HÌNH 8 CÂU BẢN GỐC) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MÔ HÌNH 8 CÂU BẢN GỐC) ---summary(fit_A_8, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 25 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 32
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 46.255 92.438
## Degrees of freedom 20 20
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.530
## Shift parameter 5.230
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 14196.566 6090.782
## Degrees of freedom 28 28
## P-value NA 0.000
## Scaling correction factor 2.337
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.998 0.988
## Tucker-Lewis Index (TLI) 0.997 0.983
##
## Robust Comparative Fit Index (CFI) 0.914
## Robust Tucker-Lewis Index (TLI) 0.880
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.077 0.129
## 90 Percent confidence interval - lower 0.048 0.103
## 90 Percent confidence interval - upper 0.107 0.156
## P-value H_0: RMSEA <= 0.050 0.060 0.000
## P-value H_0: RMSEA >= 0.080 0.472 0.999
##
## Robust RMSEA 0.191
## 90 Percent confidence interval - lower 0.158
## 90 Percent confidence interval - upper 0.225
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.042 0.042
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.839 0.839
## R_A5 1.046 0.032 32.548 0.000 0.878 0.878
## R_A6 1.043 0.032 32.825 0.000 0.875 0.875
## R_A7 1.082 0.031 34.658 0.000 0.908 0.908
## R_A8 0.830 0.046 17.900 0.000 0.696 0.696
## R_A9 1.049 0.035 29.864 0.000 0.881 0.881
## R_A10 1.062 0.032 32.960 0.000 0.891 0.891
## R_A12 1.040 0.032 32.529 0.000 0.873 0.873
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A5|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_A5|t2 -0.591 0.090 -6.545 0.000 -0.591 -0.591
## R_A5|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_A12|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A12|t2 -0.538 0.089 -6.020 0.000 -0.538 -0.538
## R_A12|t3 1.231 0.113 10.926 0.000 1.231 1.231
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.296 0.296 0.296
## .R_A5 0.229 0.229 0.229
## .R_A6 0.234 0.234 0.234
## .R_A7 0.176 0.176 0.176
## .R_A8 0.515 0.515 0.515
## .R_A9 0.225 0.225 0.225
## .R_A10 0.206 0.206 0.206
## .R_A12 0.238 0.238 0.238
## Attitude 0.704 0.040 17.567 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---mi_A_8 <- modindices(fit_A_8)
mi_A_8_res <- mi_A_8[mi_A_8$op == "~~", ]
print(head(mi_A_8_res[order(-mi_A_8_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 59 R_A3 ~~ R_A5 11.225 0.118 0.118 0.453 0.453
## 85 R_A9 ~~ R_A12 8.257 0.100 0.100 0.434 0.434
## 82 R_A8 ~~ R_A10 7.081 0.114 0.114 0.351 0.351
## 80 R_A7 ~~ R_A12 6.896 -0.104 -0.104 -0.506 -0.506
## 62 R_A3 ~~ R_A8 5.092 -0.133 -0.133 -0.341 -0.341# ==============================================================================
# BƯỚC CFA CHỐT HẠ: MÔ HÌNH 8 CÂU (ĐẶT 1 STENT DUY NHẤT A3-A5)
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA 8 CÂU (NỐI PHẦN DƯ R_A3 ~~ R_A5) ---\n")##
## --- 1. CHẠY CFA 8 CÂU (NỐI PHẦN DƯ R_A3 ~~ R_A5) ---model_A_8_adj <- '
Attitude =~ R_A3 + R_A5 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10 + R_A12
# Nối phần dư cho cặp có MI > 10 duy nhất
R_A3 ~~ R_A5
'
fit_A_8_adj <- cfa(model_A_8_adj,
data = data_A_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 6.430054e-17)
## is close to zero. This may be a symptom that the model is not identified.cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI NỐI A3-A5 ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI NỐI A3-A5 ---summary(fit_A_8_adj, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 26 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 33
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 34.991 75.551
## Degrees of freedom 19 19
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.495
## Shift parameter 4.928
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 14196.566 6090.782
## Degrees of freedom 28 28
## P-value NA 0.000
## Scaling correction factor 2.337
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.999 0.991
## Tucker-Lewis Index (TLI) 0.998 0.986
##
## Robust Comparative Fit Index (CFI) 0.929
## Robust Tucker-Lewis Index (TLI) 0.896
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.062 0.117
## 90 Percent confidence interval - lower 0.028 0.090
## 90 Percent confidence interval - upper 0.094 0.145
## P-value H_0: RMSEA <= 0.050 0.247 0.000
## P-value H_0: RMSEA >= 0.080 0.191 0.986
##
## Robust RMSEA 0.178
## 90 Percent confidence interval - lower 0.144
## 90 Percent confidence interval - upper 0.213
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.037 0.037
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.809 0.809
## R_A5 1.058 0.034 31.382 0.000 0.856 0.856
## R_A6 1.087 0.038 28.245 0.000 0.879 0.879
## R_A7 1.129 0.040 28.360 0.000 0.913 0.913
## R_A8 0.864 0.049 17.577 0.000 0.699 0.699
## R_A9 1.094 0.043 25.514 0.000 0.885 0.885
## R_A10 1.105 0.040 27.841 0.000 0.894 0.894
## R_A12 1.083 0.039 27.839 0.000 0.876 0.876
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 ~~
## .R_A5 0.117 0.032 3.667 0.000 0.117 0.386
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A5|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_A5|t2 -0.591 0.090 -6.545 0.000 -0.591 -0.591
## R_A5|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_A12|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A12|t2 -0.538 0.089 -6.020 0.000 -0.538 -0.538
## R_A12|t3 1.231 0.113 10.926 0.000 1.231 1.231
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.346 0.346 0.346
## .R_A5 0.268 0.268 0.268
## .R_A6 0.227 0.227 0.227
## .R_A7 0.166 0.166 0.166
## .R_A8 0.512 0.512 0.512
## .R_A9 0.217 0.217 0.217
## .R_A10 0.201 0.201 0.201
## .R_A12 0.233 0.233 0.233
## Attitude 0.654 0.046 14.365 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---mi_A_8_adj <- modindices(fit_A_8_adj)
mi_A_8_adj_res <- mi_A_8_adj[mi_A_8_adj$op == "~~", ]
print(head(mi_A_8_adj_res[order(-mi_A_8_adj_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 80 R_A7 ~~ R_A12 8.550 -0.116 -0.116 -0.591 -0.591
## 85 R_A9 ~~ R_A12 6.705 0.091 0.091 0.406 0.406
## 82 R_A8 ~~ R_A10 6.416 0.109 0.109 0.341 0.341
## 74 R_A6 ~~ R_A9 5.796 -0.105 -0.105 -0.471 -0.471
## 66 R_A5 ~~ R_A6 4.826 0.084 0.084 0.341 0.341# ==============================================================================
# CFA: MÔ HÌNH 7 CÂU
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA 7 CÂU THÁI ĐỘ (ĐÃ LOẠI THÊM R_A5) ---\n")##
## --- 1. CHẠY CFA 7 CÂU THÁI ĐỘ (ĐÃ LOẠI THÊM R_A5) ---model_A_7 <- '
Attitude =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10 + R_A12
'
fit_A_7 <- cfa(model_A_7,
data = data_A_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 8.056028e-17)
## is close to zero. This may be a symptom that the model is not identified.cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MÔ HÌNH 7 CÂU) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MÔ HÌNH 7 CÂU) ---summary(fit_A_7, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 23 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 28
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 25.141 54.882
## Degrees of freedom 14 14
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.481
## Shift parameter 2.605
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 10122.982 4910.542
## Degrees of freedom 21 21
## P-value NA 0.000
## Scaling correction factor 2.066
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.999 0.992
## Tucker-Lewis Index (TLI) 0.998 0.987
##
## Robust Comparative Fit Index (CFI) 0.925
## Robust Tucker-Lewis Index (TLI) 0.887
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.060 0.115
## 90 Percent confidence interval - lower 0.017 0.084
## 90 Percent confidence interval - upper 0.098 0.148
## P-value H_0: RMSEA <= 0.050 0.294 0.001
## P-value H_0: RMSEA >= 0.080 0.213 0.968
##
## Robust RMSEA 0.193
## 90 Percent confidence interval - lower 0.154
## 90 Percent confidence interval - upper 0.234
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.036 0.036
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.809 0.809
## R_A6 1.067 0.039 27.361 0.000 0.863 0.863
## R_A7 1.120 0.039 28.779 0.000 0.905 0.905
## R_A8 0.879 0.050 17.505 0.000 0.711 0.711
## R_A9 1.100 0.044 25.082 0.000 0.890 0.890
## R_A10 1.115 0.040 27.634 0.000 0.902 0.902
## R_A12 1.086 0.039 28.123 0.000 0.878 0.878
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_A12|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A12|t2 -0.538 0.089 -6.020 0.000 -0.538 -0.538
## R_A12|t3 1.231 0.113 10.926 0.000 1.231 1.231
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.346 0.346 0.346
## .R_A6 0.255 0.255 0.255
## .R_A7 0.180 0.180 0.180
## .R_A8 0.495 0.495 0.495
## .R_A9 0.209 0.209 0.209
## .R_A10 0.186 0.186 0.186
## .R_A12 0.229 0.229 0.229
## Attitude 0.654 0.046 14.344 0.000 1.000 1.000cat("\n--- 3. (MODIFICATION INDICES) ---\n")##
## --- 3. (MODIFICATION INDICES) ---mi_A_7 <- modindices(fit_A_7)
mi_A_7_res <- mi_A_7[mi_A_7$op == "~~", ]
print(head(mi_A_7_res[order(-mi_A_7_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 66 R_A7 ~~ R_A12 8.273 -0.119 -0.119 -0.588 -0.588
## 71 R_A9 ~~ R_A12 5.881 0.090 0.090 0.411 0.411
## 60 R_A6 ~~ R_A9 4.679 -0.097 -0.097 -0.420 -0.420
## 58 R_A6 ~~ R_A7 4.532 0.083 0.083 0.389 0.389
## 54 R_A3 ~~ R_A8 4.358 -0.124 -0.124 -0.300 -0.300CHỐT MÔ HÌNH 6-ITEMS A3, A6, A7, A8, A9, A10
# ==============================================================================
# BƯỚC CFA CHỐT: MÔ HÌNH 6 CÂU THÁI ĐỘ (ĐÃ LOẠI R_A12 do không phù hợp và có nội dung tương đồng)
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA 6 CÂU THÁI ĐỘ (ĐÃ LOẠI R_A12) ---\n")##
## --- 1. CHẠY CFA 6 CÂU THÁI ĐỘ (ĐÃ LOẠI R_A12) ---# Định nghĩa mô hình: 6 items A3, 6, 7, 8, 9, 10.
model_A_6 <- '
Attitude =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
'
fit_A_6 <- cfa(model_A_6,
data = data_A_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 7.811084e-17)
## is close to zero. This may be a symptom that the model is not identified.cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MÔ HÌNH 6 CÂU) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MÔ HÌNH 6 CÂU) ---summary(fit_A_6, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 21 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 24
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 13.044 33.827
## Degrees of freedom 9 9
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.397
## Shift parameter 0.953
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 6589.029 3735.167
## Degrees of freedom 15 15
## P-value NA 0.000
## Scaling correction factor 1.767
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.999 0.993
## Tucker-Lewis Index (TLI) 0.999 0.989
##
## Robust Comparative Fit Index (CFI) 0.967
## Robust Tucker-Lewis Index (TLI) 0.944
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.045 0.112
## 90 Percent confidence interval - lower 0.000 0.074
## 90 Percent confidence interval - upper 0.095 0.154
## P-value H_0: RMSEA <= 0.050 0.503 0.006
## P-value H_0: RMSEA >= 0.080 0.143 0.918
##
## Robust RMSEA 0.141
## 90 Percent confidence interval - lower 0.092
## 90 Percent confidence interval - upper 0.193
## P-value H_0: Robust RMSEA <= 0.050 0.002
## P-value H_0: Robust RMSEA >= 0.080 0.978
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.034 0.034
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Attitude =~
## R_A3 1.000 0.808 0.808
## R_A6 1.061 0.041 25.691 0.000 0.858 0.858
## R_A7 1.150 0.042 27.287 0.000 0.930 0.930
## R_A8 0.887 0.051 17.340 0.000 0.717 0.717
## R_A9 1.071 0.050 21.330 0.000 0.866 0.866
## R_A10 1.112 0.047 23.470 0.000 0.899 0.899
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_A3 0.346 0.346 0.346
## .R_A6 0.264 0.264 0.264
## .R_A7 0.135 0.135 0.135
## .R_A8 0.485 0.485 0.485
## .R_A9 0.250 0.250 0.250
## .R_A10 0.192 0.192 0.192
## Attitude 0.654 0.049 13.423 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---mi_A_6 <- modindices(fit_A_6)
mi_A_6_res <- mi_A_6[mi_A_6$op == "~~", ]
print(head(mi_A_6_res[order(-mi_A_6_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 47 R_A3 ~~ R_A8 5.024 -0.136 -0.136 -0.333 -0.333
## 58 R_A8 ~~ R_A10 4.238 0.097 0.097 0.318 0.318
## 48 R_A3 ~~ R_A9 2.954 0.074 0.074 0.252 0.252
## 50 R_A6 ~~ R_A7 2.410 0.068 0.068 0.360 0.360
## 52 R_A6 ~~ R_A9 2.097 -0.068 -0.068 -0.266 -0.266C. DOMAIN P - ANALYSIS
# ==============================================================================
# BƯỚC 1 (DOMAIN P): KIỂM ĐỊNH KMO, BARTLETT VÀ XÁC ĐỊNH SỐ NHÂN TỐ
# ==============================================================================
library(psych)
cat("\n--- 1. (KMO & BARTLETT) CHO DOMAIN P ---\n")##
## --- 1. (KMO & BARTLETT) CHO DOMAIN P ---# Kiểm định KMO
kmo_P <- KMO(data_P_EFA)
cat("=> Chỉ số KMO Overall:", round(kmo_P$MSA, 3), "\n")## => Chỉ số KMO Overall: 0.92# Kiểm định Bartlett
bartlett_P <- cortest.bartlett(cor(data_P_EFA, use = "pairwise.complete.obs"), n = nrow(data_P_EFA))
cat("=> Bartlett's Test: Chi-square =", round(bartlett_P$chisq, 2),
"| df =", bartlett_P$df,
"| p-value =", bartlett_P$p.value, "\n")## => Bartlett's Test: Chi-square = 1673.77 | df = 91 | p-value = 2.38271e-289cat("\n--- 2. CÁC TIÊU CHÍ GỢI Ý SỐ NHÂN TỐ ---\n")##
## --- 2. CÁC TIÊU CHÍ GỢI Ý SỐ NHÂN TỐ ---# 1. Tiêu chí Kaiser (Eigenvalue > 1)
eigen_P <- eigen(cor(data_P_EFA, use = "pairwise.complete.obs"))$values
cat("Các trị số Eigenvalues:", round(eigen_P, 3), "\n")## Các trị số Eigenvalues: 7.021 1.254 0.926 0.728 0.654 0.593 0.536 0.422 0.401 0.36 0.339 0.3 0.263 0.204cat("=> Gợi ý Kaiser (Eigenvalue > 1):", sum(eigen_P > 1), "nhân tố\n")## => Gợi ý Kaiser (Eigenvalue > 1): 2 nhân tố# 2. Tiêu chí VSS và MAP
vss_P <- vss(data_P_EFA, n = 3, fm = "pa", cor = "cor", plot = FALSE)
print(vss_P)##
## Very Simple Structure
## Call: vss(x = data_P_EFA, n = 3, fm = "pa", plot = FALSE, cor = "cor")
## VSS complexity 1 achieves a maximimum of 0.91 with 1 factors
## VSS complexity 2 achieves a maximimum of 0.93 with 2 factors
##
## The Velicer MAP achieves a minimum of 0.03 with 2 factors
## BIC achieves a minimum of -161.41 with 2 factors
## Sample Size adjusted BIC achieves a minimum of 15.21 with 3 factors
##
## Statistics by number of factors
## vss1 vss2 map dof chisq prob sqresid fit RMSEA BIC SABIC complex
## 1 0.91 0.00 0.028 77 325 3.3e-32 5.1 0.91 0.121 -91 153 1.0
## 2 0.58 0.93 0.027 64 184 1.5e-13 3.7 0.93 0.092 -161 41 1.5
## 3 0.47 0.82 0.034 52 131 9.0e-09 3.0 0.94 0.083 -150 15 1.9
## eChisq SRMR eCRMS eBIC
## 1 109 0.052 0.057 -307
## 2 46 0.034 0.040 -300
## 3 26 0.025 0.034 -255cat("\n--- 3. PARALLEL ANALYSIS (PA) ---\n")##
## --- 3. PARALLEL ANALYSIS (PA) ---pa_P <- fa.parallel(data_P_EFA,
cor = "cor",
fm = "pa",
fa = "fa",
main = "Parallel Analysis - Domain P")
## Parallel analysis suggests that the number of factors = 3 and the number of components = NA# ==============================================================================
# BƯỚC 2: EFA Analysis for P Domain (Hide factor loadings <0.3)
# ==============================================================================
library(psych)
# 1. Chạy EFA cho Domain P (Thay n_fact_P theo kết quả Parallel Analysis)
n_fact_P <- 2
efa_P_final <- fa(data_P_EFA, nfactors = n_fact_P, cor = "poly", fm = "pa", rotate = "promax")
cat("\n--- EFA Analysis Result (Hide factor loadings < 0.3) ---\n")##
## --- EFA Analysis Result (Hide factor loadings < 0.3) ---# 2. Tạo bảng dữ liệu gốc để tính toán
loadings_raw <- as.data.frame(unclass(efa_P_final$loadings))
loadings_table <- round(loadings_raw, 3)
# 3. Communality, Complexity, Loading Difference
loadings_table$Communality <- round(efa_P_final$communality, 3)
loadings_table$Complexity <- round(efa_P_final$complexity, 3)
loadings_table$Difference <- apply(loadings_raw[, 1:n_fact_P, drop=FALSE], 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
if(length(sorted_abs) > 1) return(round(sorted_abs[1] - sorted_abs[2], 3)) else return(NA)
})
# 4. BƯỚC QUAN TRỌNG: Ẩn các loading < 0.3 ở các cột Factor
# Lưu ý: Bước này sẽ chuyển các cột Factor thành dạng ký tự (Character) để hiển thị khoảng trắng
display_table <- loadings_table
for(i in 1:n_fact_P) {
display_table[, i] <- ifelse(abs(loadings_table[, i]) < 0.3, "", as.character(loadings_table[, i]))
}
# 5. Sắp xếp bảng theo nhóm nhân tố cho chuyên nghiệp
display_table$Group <- apply(abs(loadings_raw[, 1:n_fact_P, drop=FALSE]), 1, which.max)
display_table <- display_table[order(display_table$Group, -apply(abs(loadings_raw[, 1:n_fact_P, drop=FALSE]), 1, max)), ]
# 6. IN BẢNG CUỐI CÙNG (Loại bỏ cột Group tạm thời)
print(display_table[, !(names(display_table) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_P6 0.88 0.764 1.000 0.872
## R_P7 0.763 0.488 1.027 0.674
## R_P5 0.754 0.635 1.011 0.699
## R_P2 0.71 0.502 1.000 0.708
## R_P1 0.689 0.594 1.046 0.585
## R_P4 0.613 0.528 1.110 0.469
## R_P3 0.611 0.596 1.213 0.411
## R_P8 0.602 0.430 1.028 0.531
## R_P13 0.921 0.788 1.005 0.876
## R_P10 0.838 0.666 1.002 0.809
## R_P14 0.835 0.712 1.000 0.824
## R_P12 0.708 0.767 1.173 0.499
## R_P9 0.699 0.579 1.027 0.617
## R_P11 0.685 0.524 1.011 0.634cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (CUMULATIVE VARIANCE) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (CUMULATIVE VARIANCE) ---print(round(efa_P_final$Vaccounted, 3))## PA1 PA2
## SS loadings 4.426 4.148
## Proportion Var 0.316 0.296
## Cumulative Var 0.316 0.612
## Proportion Explained 0.516 0.484
## Cumulative Proportion 0.516 1.000# ==============================================================================
# BƯỚC KIỂM TRA CHÉO: EFA 1 NHÂN TỐ CHO DOMAIN P (14 CÂU GỐC)
# ==============================================================================
library(psych)
cat("\n--- CHẠY EFA 1 NHÂN TỐ CHO TOÀN BỘ DOMAIN P (14 CÂU) ---\n")##
## --- CHẠY EFA 1 NHÂN TỐ CHO TOÀN BỘ DOMAIN P (14 CÂU) ---# Ép thuật toán chạy đúng 1 nhân tố duy nhất
efa_P_1fact <- fa(data_P_EFA, nfactors = 1, cor = "poly", fm = "pa")
# Trích xuất dữ liệu để làm bảng báo cáo chi tiết
loadings_mat <- as.matrix(unclass(efa_P_1fact$loadings))
# Tạo bảng tổng hợp (Không có cột Difference vì chỉ có 1 nhân tố)
efa_summary_P1 <- data.frame(
Loading = round(as.numeric(loadings_mat), 3),
Communality = round(efa_P_1fact$communality, 3),
Complexity = round(efa_P_1fact$complexity, 3)
)
# Gắn tên câu hỏi và sắp xếp theo Hệ số tải giảm dần
rownames(efa_summary_P1) <- rownames(loadings_mat)
efa_summary_P1 <- efa_summary_P1[order(-efa_summary_P1$Loading), ]
# In bảng kết quả
cat("\n--- BẢNG HỆ SỐ TẢI VÀ CHỈ SỐ KIỂM ĐỊNH CHI TIẾT ---\n")##
## --- BẢNG HỆ SỐ TẢI VÀ CHỈ SỐ KIỂM ĐỊNH CHI TIẾT ---print(efa_summary_P1)## Loading Communality Complexity
## R_P12 0.854 0.730 1
## R_P6 0.812 0.659 1
## R_P13 0.802 0.642 1
## R_P14 0.779 0.607 1
## R_P3 0.762 0.581 1
## R_P5 0.758 0.574 1
## R_P1 0.744 0.554 1
## R_P10 0.744 0.553 1
## R_P9 0.723 0.523 1
## R_P4 0.711 0.505 1
## R_P11 0.682 0.465 1
## R_P2 0.663 0.440 1
## R_P8 0.631 0.398 1
## R_P7 0.629 0.396 1# In tổng phương sai trích
cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (VARIANCE ACCOUNTED FOR) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (VARIANCE ACCOUNTED FOR) ---print(round(efa_P_1fact$Vaccounted, 3))## PA1
## SS loadings 7.628
## Proportion Var 0.545# ==============================================================================
# BƯỚC 2 (DOMAIN P): PHÂN TÍCH NHÂN TỐ KHẲNG ĐỊNH (CFA) cho Domain P (2 factors)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 2 NHÂN TỐ CHO DOMAIN P (P1 & P2) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 2 NHÂN TỐ CHO DOMAIN P (P1 & P2) ---# Định nghĩa mô hình với tên gọi mới theo yêu cầu của Chương
model_P_cfa <- '
# Nhân tố P1: Gồm 8 câu đầu tiên trong EFA
P1 =~ R_P6 + R_P7 + R_P5 + R_P2 + R_P1 + R_P4 + R_P3 + R_P8
# Nhân tố P2: Gồm 6 câu còn lại
P2 =~ R_P13 + R_P10 + R_P14 + R_P12 + R_P9 + R_P11
'
# Chạy CFA với estimator WLSMV (Dành cho dữ liệu Likert/Thứ bậc)
fit_P <- cfa(model_P_cfa,
data = data_P_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= -4.633383e-19)
## is smaller than zero. This may be a symptom that the model is not
## identified.cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---# Xuất kết quả chi tiết
summary(fit_P, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 35 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 67
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 136.176 222.174
## Degrees of freedom 76 76
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.681
## Shift parameter 22.064
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 15785.644 5658.676
## Degrees of freedom 91 91
## P-value NA 0.000
## Scaling correction factor 2.819
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.996 0.974
## Tucker-Lewis Index (TLI) 0.995 0.969
##
## Robust Comparative Fit Index (CFI) 0.891
## Robust Tucker-Lewis Index (TLI) 0.870
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.060 0.094
## 90 Percent confidence interval - lower 0.043 0.080
## 90 Percent confidence interval - upper 0.076 0.108
## P-value H_0: RMSEA <= 0.050 0.149 0.000
## P-value H_0: RMSEA >= 0.080 0.020 0.944
##
## Robust RMSEA 0.127
## 90 Percent confidence interval - lower 0.109
## 90 Percent confidence interval - upper 0.146
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.055 0.055
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 =~
## R_P6 1.000 0.858 0.858
## R_P7 0.806 0.042 19.079 0.000 0.692 0.692
## R_P5 0.954 0.035 27.059 0.000 0.819 0.819
## R_P2 0.779 0.046 16.946 0.000 0.668 0.668
## R_P1 0.785 0.047 16.785 0.000 0.674 0.674
## R_P4 0.904 0.034 26.466 0.000 0.776 0.776
## R_P3 0.830 0.046 17.926 0.000 0.713 0.713
## R_P8 0.812 0.043 18.739 0.000 0.697 0.697
## P2 =~
## R_P13 1.000 0.885 0.885
## R_P10 0.914 0.035 26.142 0.000 0.809 0.809
## R_P14 0.988 0.033 30.284 0.000 0.874 0.874
## R_P12 1.032 0.029 35.200 0.000 0.913 0.913
## R_P9 0.835 0.048 17.423 0.000 0.739 0.739
## R_P11 0.864 0.036 23.682 0.000 0.764 0.764
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 ~~
## P2 0.699 0.032 21.534 0.000 0.921 0.921
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_P6|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P6|t2 -1.036 0.103 -10.015 0.000 -1.036 -1.036
## R_P6|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P6|t4 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P5|t2 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_P5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P4|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_P4|t2 -0.632 0.091 -6.936 0.000 -0.632 -0.632
## R_P4|t3 0.618 0.091 6.806 0.000 0.618 0.618
## R_P4|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P3|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P3|t2 -1.076 0.105 -10.234 0.000 -1.076 -1.076
## R_P3|t3 0.349 0.087 4.028 0.000 0.349 0.349
## R_P3|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P12|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_P12|t2 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_P12|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P12|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P6 0.264 0.264 0.264
## .R_P7 0.521 0.521 0.521
## .R_P5 0.330 0.330 0.330
## .R_P2 0.554 0.554 0.554
## .R_P1 0.546 0.546 0.546
## .R_P4 0.398 0.398 0.398
## .R_P3 0.492 0.492 0.492
## .R_P8 0.514 0.514 0.514
## .R_P13 0.217 0.217 0.217
## .R_P10 0.346 0.346 0.346
## .R_P14 0.236 0.236 0.236
## .R_P12 0.166 0.166 0.166
## .R_P9 0.454 0.454 0.454
## .R_P11 0.416 0.416 0.416
## P1 0.736 0.037 19.790 0.000 1.000 1.000
## P2 0.783 0.040 19.794 0.000 1.000 1.000cat("\n--- 3. (MODIFICATION INDICES ---\n")##
## --- 3. (MODIFICATION INDICES ---# Xem xét các đường nối phần dư nếu các chỉ số Fit chưa đạt chuẩn
mi_P <- modindices(fit_P)
#print(head(mi_P[mi_P$op == "~~", ][order(-mi_P$mi), ], 10))
# Lọc: Chỉ lấy các đường nối phần dư (Residual Covariances)
mi_P_res <- mi_P[mi_P$op == "~~", ]
# Sắp xếp: Đưa các cặp có chỉ số MI cao nhất lên đầu
mi_P_sorted <- mi_P_res[order(-mi_P_res$mi), ]
# In kết quả top 5 hoặc top 10 cặp cao nhất
print(head(mi_P_sorted, 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 205 R_P13 ~~ R_P14 14.774 0.132 0.132 0.583 0.583
## 211 R_P10 ~~ R_P9 13.726 0.163 0.163 0.412 0.412
## 146 R_P7 ~~ R_P8 9.159 0.140 0.140 0.270 0.270
## 204 R_P13 ~~ R_P10 8.464 -0.147 -0.147 -0.538 -0.538
## 166 R_P2 ~~ R_P3 7.991 0.148 0.148 0.284 0.284# ==============================================================================
# BƯỚC 2.1: LOẠI BỎ P3 (CÂU CÓ COMPLEXITY CAO NHẤT) VÀ KIỂM TRA LẠI CẤU TRÚC
# ==============================================================================
library(psych)
# 1. Tạo tập dữ liệu mới loại bỏ P3
data_P_drop3 <- data_P_EFA[, !(names(data_P_EFA) %in% c("R_P3"))]
cat("\n--- 2. CHẠY LẠI PARALLEL ANALYSIS (PA) SAU KHI LOẠI P3 ---\n")##
## --- 2. CHẠY LẠI PARALLEL ANALYSIS (PA) SAU KHI LOẠI P3 ---# Chạy lại PA (Dùng fm="pa" cho đồng bộ với EFA)
pa_P_v2 <- fa.parallel(data_P_drop3, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain P (Đã loại P3)")
## Parallel analysis suggests that the number of factors = 3 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT SAU KHI CẮT P3 LÀ:", pa_P_v2$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT SAU KHI CẮT P3 LÀ: 3cat("\n--- 3. KẾT QUẢ EFA MỚI ---\n")##
## --- 3. KẾT QUẢ EFA MỚI ---# Chạy lại EFA lấy tự động số nhân tố PA vừa gợi ý (pa_P_v2$nfact)
efa_P_v2 <- fa(data_P_drop3, nfactors = pa_P_v2$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất Loading và tính toán lại các chỉ số
loadings_raw_v2 <- as.data.frame(unclass(efa_P_v2$loadings))
loadings_table_v2 <- round(loadings_raw_v2, 3)
loadings_table_v2$Communality <- round(efa_P_v2$communality, 3)
loadings_table_v2$Complexity <- round(efa_P_v2$complexity, 3)
# Tính Difference (Chênh lệch giữa 2 hệ số tải cao nhất của mỗi câu)
# Chỉ tính Difference nếu mô hình có từ 2 nhân tố trở lên
if(pa_P_v2$nfact > 1) {
loadings_table_v2$Difference <- apply(loadings_raw_v2, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# 4. Ẩn loading < 0.3 và sắp xếp
display_table_v2 <- loadings_table_v2
# Vòng lặp chạy linh hoạt theo số nhân tố PA đề xuất
for(i in 1:pa_P_v2$nfact) {
display_table_v2[, i] <- ifelse(abs(loadings_table_v2[, i]) < 0.3, "", as.character(loadings_table_v2[, i]))
}
display_table_v2$Group <- apply(abs(loadings_raw_v2), 1, which.max)
display_table_v2 <- display_table_v2[order(display_table_v2$Group, -apply(abs(loadings_raw_v2), 1, max)), ]
# 5. IN BẢNG KẾT QUẢ
print(display_table_v2[, !(names(display_table_v2) %in% "Group")], quote = FALSE)## PA1 PA2 PA3 Communality Complexity Difference
## R_P13 0.9 0.812 1.222 0.676
## R_P14 0.824 0.772 1.445 0.537
## R_P10 0.797 0.673 1.057 0.688
## R_P9 0.693 0.313 0.648 1.558 0.381
## R_P12 0.672 0.764 1.240 0.443
## R_P11 0.654 0.575 1.448 0.384
## R_P1 0.872 0.761 1.013 0.822
## R_P2 0.724 0.571 1.025 0.648
## R_P5 0.457 0.333 0.608 1.904 0.124
## R_P4 0.409 0.532 2.017 0.132
## R_P8 0.728 0.561 1.011 0.677
## R_P7 0.72 0.570 1.113 0.579
## R_P6 0.479 0.497 0.773 1.998 0.018cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_P_v2$Vaccounted, 3))## PA1 PA2 PA3
## SS loadings 3.853 2.643 2.124
## Proportion Var 0.296 0.203 0.163
## Cumulative Var 0.296 0.500 0.663
## Proportion Explained 0.447 0.307 0.246
## Cumulative Proportion 0.447 0.754 1.000# ==============================================================================
# BƯỚC 2.2: LOẠI TIẾP R_P6 (CROSS-LOADING NẶNG NHẤT) VÀ KIỂM TRA LẠI CẤU TRÚC
# ==============================================================================
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI P3 VÀ P6 (CÒN 12 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI P3 VÀ P6 (CÒN 12 CÂU) ---data_P_drop6 <- data_P_drop3[, !(names(data_P_drop3) %in% c("R_P6"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI P6 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI P6 ---pa_P_v3 <- fa.parallel(data_P_drop6, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain P (Đã loại P3, P6)")
## Parallel analysis suggests that the number of factors = 3 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_P_v3$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 3cat("\n--- 3. KẾT QUẢ EFA MỚI ---\n")##
## --- 3. KẾT QUẢ EFA MỚI ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_P_v3 <- fa(data_P_drop6, nfactors = pa_P_v3$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_v3 <- as.data.frame(unclass(efa_P_v3$loadings))
loadings_table_v3 <- round(loadings_raw_v3, 3)
loadings_table_v3$Communality <- round(efa_P_v3$communality, 3)
loadings_table_v3$Complexity <- round(efa_P_v3$complexity, 3)
# Nếu số nhân tố > 1, tính Difference
if(pa_P_v3$nfact > 1) {
loadings_table_v3$Difference <- apply(loadings_raw_v3, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_v3 <- loadings_table_v3
for(i in 1:pa_P_v3$nfact) {
display_table_v3[, i] <- ifelse(abs(loadings_table_v3[, i]) < 0.3, "", as.character(loadings_table_v3[, i]))
}
display_table_v3$Group <- apply(abs(loadings_raw_v3), 1, which.max)
display_table_v3 <- display_table_v3[order(display_table_v3$Group, -apply(abs(loadings_raw_v3), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_v3[, !(names(display_table_v3) %in% "Group")], quote = FALSE)## PA1 PA2 PA3 Communality Complexity Difference
## R_P13 0.919 0.802 1.160 0.709
## R_P14 0.836 0.753 1.302 0.605
## R_P10 0.83 0.676 1.039 0.741
## R_P12 0.731 0.762 1.135 0.540
## R_P9 0.717 0.645 1.436 0.440
## R_P11 0.627 0.570 1.491 0.343
## R_P1 0.898 0.792 1.020 0.825
## R_P2 0.777 0.628 1.064 0.667
## R_P5 0.417 0.556 2.041 0.166
## R_P4 0.401 0.528 2.082 0.133
## R_P8 0.837 0.660 1.003 0.807
## R_P7 0.647 0.523 1.146 0.482cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_P_v3$Vaccounted, 3))## PA1 PA2 PA3
## SS loadings 3.986 2.236 1.673
## Proportion Var 0.332 0.186 0.139
## Cumulative Var 0.332 0.519 0.658
## Proportion Explained 0.505 0.283 0.212
## Cumulative Proportion 0.505 0.788 1.000# ==============================================================================
# BƯỚC 2.3: LOẠI TIẾP R_P4 (CROSS-LOADING NẶNG NHẤT) VÀ KIỂM TRA LẠI CẤU TRÚC
# ==============================================================================
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI P3, P6, P4 (CÒN 11 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI P3, P6, P4 (CÒN 11 CÂU) ---data_P_drop4 <- data_P_drop6[, !(names(data_P_drop6) %in% c("R_P4"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI P4 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI P4 ---pa_P_v4 <- fa.parallel(data_P_drop4, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain P (Đã loại P3, P6, P4)")
## Parallel analysis suggests that the number of factors = 3 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_P_v4$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 3cat("\n--- 3. KẾT QUẢ EFA MỚI ---\n")##
## --- 3. KẾT QUẢ EFA MỚI ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_P_v4 <- fa(data_P_drop4, nfactors = pa_P_v4$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_v4 <- as.data.frame(unclass(efa_P_v4$loadings))
loadings_table_v4 <- round(loadings_raw_v4, 3)
loadings_table_v4$Communality <- round(efa_P_v4$communality, 3)
loadings_table_v4$Complexity <- round(efa_P_v4$complexity, 3)
# Nếu số nhân tố > 1, tính Difference
if(pa_P_v4$nfact > 1) {
loadings_table_v4$Difference <- apply(loadings_raw_v4, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_v4 <- loadings_table_v4
for(i in 1:pa_P_v4$nfact) {
display_table_v4[, i] <- ifelse(abs(loadings_table_v4[, i]) < 0.3, "", as.character(loadings_table_v4[, i]))
}
display_table_v4$Group <- apply(abs(loadings_raw_v4), 1, which.max)
display_table_v4 <- display_table_v4[order(display_table_v4$Group, -apply(abs(loadings_raw_v4), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_v4[, !(names(display_table_v4) %in% "Group")], quote = FALSE)## PA1 PA2 PA3 Communality Complexity Difference
## R_P13 0.91 0.801 1.141 0.719
## R_P14 0.844 0.750 1.252 0.634
## R_P10 0.83 0.677 1.032 0.748
## R_P12 0.74 0.767 1.120 0.559
## R_P9 0.718 0.649 1.388 0.454
## R_P11 0.642 0.560 1.386 0.390
## R_P1 0.867 0.808 1.016 0.794
## R_P2 0.752 0.641 1.091 0.606
## R_P5 0.355 0.523 2.582 0.103
## R_P8 0.797 0.642 1.000 0.793
## R_P7 0.684 0.561 1.131 0.519cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_P_v4$Vaccounted, 3))## PA1 PA2 PA3
## SS loadings 3.982 1.864 1.533
## Proportion Var 0.362 0.169 0.139
## Cumulative Var 0.362 0.532 0.671
## Proportion Explained 0.540 0.253 0.208
## Cumulative Proportion 0.540 0.792 1.000# ==============================================================================
# BƯỚC 2.4: LOẠI TIẾP R_P5 (COMPLEXITY CAO NHẤT) VÀ KIỂM TRA LẠI CẤU TRÚC
# ==============================================================================
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI P3, P6, P4, P5 (CÒN 10 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI P3, P6, P4, P5 (CÒN 10 CÂU) ---data_P_drop5 <- data_P_drop4[, !(names(data_P_drop4) %in% c("R_P5"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI P5 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI P5 ---pa_P_v5 <- fa.parallel(data_P_drop5, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain P (Đã loại P3, P6, P4, P5)")
## Parallel analysis suggests that the number of factors = 3 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_P_v5$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 3cat("\n--- 3. KẾT QUẢ EFA MỚI ---\n")##
## --- 3. KẾT QUẢ EFA MỚI ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_P_v5 <- fa(data_P_drop5, nfactors = pa_P_v5$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_v5 <- as.data.frame(unclass(efa_P_v5$loadings))
loadings_table_v5 <- round(loadings_raw_v5, 3)
loadings_table_v5$Communality <- round(efa_P_v5$communality, 3)
loadings_table_v5$Complexity <- round(efa_P_v5$complexity, 3)
# Nếu số nhân tố > 1, tính Difference
if(pa_P_v5$nfact > 1) {
loadings_table_v5$Difference <- apply(loadings_raw_v5, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_v5 <- loadings_table_v5
for(i in 1:pa_P_v5$nfact) {
display_table_v5[, i] <- ifelse(abs(loadings_table_v5[, i]) < 0.3, "", as.character(loadings_table_v5[, i]))
}
display_table_v5$Group <- apply(abs(loadings_raw_v5), 1, which.max)
display_table_v5 <- display_table_v5[order(display_table_v5$Group, -apply(abs(loadings_raw_v5), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_v5[, !(names(display_table_v5) %in% "Group")], quote = FALSE)## PA1 PA2 PA3 Communality Complexity Difference
## R_P13 0.907 0.805 1.114 0.738
## R_P10 0.838 0.676 1.024 0.759
## R_P14 0.835 0.737 1.181 0.653
## R_P12 0.755 0.757 1.093 0.592
## R_P9 0.732 0.635 1.287 0.507
## R_P11 0.622 0.577 1.400 0.356
## R_P1 0.805 0.780 1.053 0.675
## R_P2 0.785 0.698 1.098 0.626
## R_P8 0.901 0.779 1.007 0.853
## R_P7 0.561 0.471 1.182 0.395cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_P_v5$Vaccounted, 3))## PA1 PA2 PA3
## SS loadings 3.898 1.597 1.419
## Proportion Var 0.390 0.160 0.142
## Cumulative Var 0.390 0.550 0.691
## Proportion Explained 0.564 0.231 0.205
## Cumulative Proportion 0.564 0.795 1.000# ==============================================================================
# BƯỚC 2.5: ÉP MÔ HÌNH VỀ 2 NHÂN TỐ (OVERRIDE PA) ĐỂ ĐÁP ỨNG QUY TẮC >= 3 ITEMS
# ==============================================================================
library(psych)
cat("\n--- 1. CHẠY LẠI EFA CHO 10 CÂU (ÉP CỨNG 2 NHÂN TỐ) ---\n")##
## --- 1. CHẠY LẠI EFA CHO 10 CÂU (ÉP CỨNG 2 NHÂN TỐ) ---# Bỏ qua gợi ý nfact=3 của PA, chúng ta ép nfactors = 2
efa_P_force2 <- fa(data_P_drop5, nfactors = 2, cor = "poly", fm = "pa", rotate = "promax")
# 2. Trích xuất và định dạng bảng kết quả
loadings_raw_f2 <- as.data.frame(unclass(efa_P_force2$loadings))
loadings_table_f2 <- round(loadings_raw_f2, 3)
loadings_table_f2$Communality <- round(efa_P_force2$communality, 3)
loadings_table_f2$Complexity <- round(efa_P_force2$complexity, 3)
# Tính Difference
loadings_table_f2$Difference <- apply(loadings_raw_f2, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
# 3. Ẩn loading < 0.3 và sắp xếp
display_table_f2 <- loadings_table_f2
for(i in 1:2) {
display_table_f2[, i] <- ifelse(abs(loadings_table_f2[, i]) < 0.3, "", as.character(loadings_table_f2[, i]))
}
display_table_f2$Group <- apply(abs(loadings_raw_f2), 1, which.max)
display_table_f2 <- display_table_f2[order(display_table_f2$Group, -apply(abs(loadings_raw_f2), 1, max)), ]
# 4. IN BẢNG KẾT QUẢ
print(display_table_f2[, !(names(display_table_f2) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_P13 0.886 0.771 1.000 0.875
## R_P10 0.86 0.675 1.008 0.806
## R_P14 0.811 0.698 1.003 0.779
## R_P9 0.754 0.591 1.001 0.734
## R_P12 0.745 0.756 1.095 0.582
## R_P11 0.649 0.541 1.061 0.536
## R_P2 0.867 0.624 1.033 0.756
## R_P1 0.712 0.614 1.036 0.616
## R_P7 0.603 0.414 1.016 0.548
## R_P8 0.579 0.437 1.069 0.471cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (MÔ HÌNH ÉP 2 NHÂN TỐ) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (MÔ HÌNH ÉP 2 NHÂN TỐ) ---print(round(efa_P_force2$Vaccounted, 3))## PA1 PA2
## SS loadings 3.942 2.179
## Proportion Var 0.394 0.218
## Cumulative Var 0.394 0.612
## Proportion Explained 0.644 0.356
## Cumulative Proportion 0.644 1.000CFA - Analysis for Domain P
# ==============================================================================
# BƯỚC 3 (DOMAIN P): CHẠY CFA CHO MÔ HÌNH 2 NHÂN TỐ (10 CÂU)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 2 NHÂN TỐ CHO DOMAIN P ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 2 NHÂN TỐ CHO DOMAIN P ---# Định nghĩa cấu trúc 2 nhân tố dựa trên kết quả EFA chốt hạ
model_P_final <- '
# Nhân tố 1 (6 câu)
P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
# Nhân tố 2 (4 câu)
P2 =~ R_P2 + R_P1 + R_P7 + R_P8
'
# Chạy thuật toán CFA
fit_P_final <- cfa(model_P_final,
data = data_P_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---summary(fit_P_final, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 26 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 47
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 65.332 115.142
## Degrees of freedom 34 34
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.602
## Shift parameter 6.569
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 8306.942 3924.312
## Degrees of freedom 45 45
## P-value NA 0.000
## Scaling correction factor 2.130
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.996 0.979
## Tucker-Lewis Index (TLI) 0.995 0.972
##
## Robust Comparative Fit Index (CFI) 0.906
## Robust Tucker-Lewis Index (TLI) 0.875
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.065 0.104
## 90 Percent confidence interval - lower 0.041 0.084
## 90 Percent confidence interval - upper 0.088 0.126
## P-value H_0: RMSEA <= 0.050 0.144 0.000
## P-value H_0: RMSEA >= 0.080 0.154 0.973
##
## Robust RMSEA 0.142
## 90 Percent confidence interval - lower 0.115
## 90 Percent confidence interval - upper 0.170
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.053 0.053
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 =~
## R_P13 1.000 0.895 0.895
## R_P10 0.908 0.034 26.816 0.000 0.812 0.812
## R_P14 0.980 0.034 28.766 0.000 0.877 0.877
## R_P9 0.833 0.046 18.034 0.000 0.745 0.745
## R_P12 1.007 0.028 35.568 0.000 0.901 0.901
## R_P11 0.841 0.036 23.663 0.000 0.752 0.752
## P2 =~
## R_P2 1.000 0.700 0.700
## R_P1 1.023 0.078 13.081 0.000 0.716 0.716
## R_P7 1.018 0.081 12.598 0.000 0.712 0.712
## R_P8 1.089 0.088 12.400 0.000 0.762 0.762
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 ~~
## P2 0.533 0.041 12.916 0.000 0.852 0.852
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P12|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_P12|t2 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_P12|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P12|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P13 0.199 0.199 0.199
## .R_P10 0.340 0.340 0.340
## .R_P14 0.231 0.231 0.231
## .R_P9 0.445 0.445 0.445
## .R_P12 0.189 0.189 0.189
## .R_P11 0.434 0.434 0.434
## .R_P2 0.510 0.510 0.510
## .R_P1 0.487 0.487 0.487
## .R_P7 0.493 0.493 0.493
## .R_P8 0.419 0.419 0.419
## P1 0.801 0.039 20.704 0.000 1.000 1.000
## P2 0.490 0.061 8.075 0.000 1.000 1.000cat("\n--- 3. (MODIFICATION INDICES) ---\n")##
## --- 3. (MODIFICATION INDICES) ---mi_P <- modindices(fit_P_final)
mi_P_res <- mi_P[mi_P$op == "~~", ]
# In ra top 5 cặp có MI cao nhất để hội chẩn
print(head(mi_P_res[order(-mi_P_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 102 R_P10 ~~ R_P9 13.527 0.171 0.171 0.440 0.440
## 93 R_P13 ~~ R_P14 13.196 0.142 0.142 0.660 0.660
## 92 R_P13 ~~ R_P10 11.105 -0.177 -0.177 -0.679 -0.679
## 135 R_P1 ~~ R_P8 10.928 -0.236 -0.236 -0.522 -0.522
## 94 R_P13 ~~ R_P9 7.193 -0.148 -0.148 -0.496 -0.496# ==============================================================================
# BƯỚC 3.1 (DOMAIN P): CHẠY CFA 10 CÂU (ĐẶT 2 ỐNG STENT CHO P10-P9 VÀ P13-P14)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 10 CÂU (NỐI 2 CẶP PHẦN DƯ) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 10 CÂU (NỐI 2 CẶP PHẦN DƯ) ---model_P_final_adj <- '
# Nhân tố 1 (6 câu)
P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
# Nhân tố 2 (4 câu)
P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# Đặt 2 ống stent giải tỏa áp lực (Các cặp có MI > 13)
R_P10 ~~ R_P9
R_P13 ~~ R_P14
'
fit_P_final_adj <- cfa(model_P_final_adj,
data = data_P_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI ĐẶT STENT ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI ĐẶT STENT ---summary(fit_P_final_adj, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 25 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 49
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 40.271 76.799
## Degrees of freedom 32 32
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.569
## Shift parameter 6.034
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 8306.942 3924.312
## Degrees of freedom 45 45
## P-value NA 0.000
## Scaling correction factor 2.130
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.999 0.988
## Tucker-Lewis Index (TLI) 0.999 0.984
##
## Robust Comparative Fit Index (CFI) 0.947
## Robust Tucker-Lewis Index (TLI) 0.926
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.034 0.080
## 90 Percent confidence interval - lower 0.000 0.057
## 90 Percent confidence interval - upper 0.064 0.103
## P-value H_0: RMSEA <= 0.050 0.781 0.017
## P-value H_0: RMSEA >= 0.080 0.003 0.522
##
## Robust RMSEA 0.110
## 90 Percent confidence interval - lower 0.080
## 90 Percent confidence interval - upper 0.140
## P-value H_0: Robust RMSEA <= 0.050 0.001
## P-value H_0: Robust RMSEA >= 0.080 0.949
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.046 0.046
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 =~
## R_P13 1.000 0.855 0.855
## R_P10 0.921 0.039 23.362 0.000 0.788 0.788
## R_P14 0.970 0.036 27.161 0.000 0.830 0.830
## R_P9 0.833 0.051 16.495 0.000 0.713 0.713
## R_P12 1.082 0.039 27.998 0.000 0.926 0.926
## R_P11 0.893 0.039 22.667 0.000 0.764 0.764
## P2 =~
## R_P2 1.000 0.700 0.700
## R_P1 1.025 0.079 13.038 0.000 0.717 0.717
## R_P7 1.019 0.081 12.560 0.000 0.713 0.713
## R_P8 1.088 0.088 12.366 0.000 0.761 0.761
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P10 ~~
## .R_P9 0.161 0.037 4.305 0.000 0.161 0.371
## .R_P13 ~~
## .R_P14 0.130 0.038 3.436 0.001 0.130 0.450
## P1 ~~
## P2 0.521 0.042 12.431 0.000 0.872 0.872
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P12|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_P12|t2 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_P12|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P12|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P13 0.269 0.269 0.269
## .R_P10 0.380 0.380 0.380
## .R_P14 0.312 0.312 0.312
## .R_P9 0.492 0.492 0.492
## .R_P12 0.143 0.143 0.143
## .R_P11 0.416 0.416 0.416
## .R_P2 0.511 0.511 0.511
## .R_P1 0.486 0.486 0.486
## .R_P7 0.492 0.492 0.492
## .R_P8 0.421 0.421 0.421
## P1 0.731 0.045 16.368 0.000 1.000 1.000
## P2 0.489 0.061 8.049 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---mi_P_adj <- modindices(fit_P_final_adj)
mi_P_adj_res <- mi_P_adj[mi_P_adj$op == "~~", ]
print(head(mi_P_adj_res[order(-mi_P_adj_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 135 R_P1 ~~ R_P8 10.935 -0.236 -0.236 -0.522 -0.522
## 123 R_P12 ~~ R_P2 4.693 -0.153 -0.153 -0.565 -0.565
## 118 R_P9 ~~ R_P2 4.594 0.120 0.120 0.239 0.239
## 94 R_P13 ~~ R_P10 4.157 -0.111 -0.111 -0.348 -0.348
## 121 R_P9 ~~ R_P8 3.776 0.097 0.097 0.214 0.214# ==============================================================================
# BƯỚC 3.2 (DOMAIN P): CFA 10 CÂU (NỐI 3 CẶP: P10-P9, P13-P14 VÀ P1-P8)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 10 CÂU (NỐI 3 CẶP PHẦN DƯ) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 10 CÂU (NỐI 3 CẶP PHẦN DƯ) ---model_P_final_adj2 <- '
# Nhân tố 1 (6 câu)
P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
# Nhân tố 2 (4 câu)
P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# Đặt 3 ống stent giải tỏa áp lực (Các cặp có MI > 10)
R_P10 ~~ R_P9
R_P13 ~~ R_P14
R_P1 ~~ R_P8
'
fit_P_final_adj2 <- cfa(model_P_final_adj2,
data = data_P_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI ĐẶT 3 STENT ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI ĐẶT 3 STENT ---summary(fit_P_final_adj2, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 27 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 50
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 29.310 57.039
## Degrees of freedom 31 31
## P-value (Unknown) NA 0.003
## Scaling correction factor 0.572
## Shift parameter 5.824
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 8306.942 3924.312
## Degrees of freedom 45 45
## P-value NA 0.000
## Scaling correction factor 2.130
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.993
## Tucker-Lewis Index (TLI) 1.000 0.990
##
## Robust Comparative Fit Index (CFI) 0.966
## Robust Tucker-Lewis Index (TLI) 0.951
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000 0.062
## 90 Percent confidence interval - lower 0.000 0.036
## 90 Percent confidence interval - upper 0.047 0.087
## P-value H_0: RMSEA <= 0.050 0.965 0.205
## P-value H_0: RMSEA >= 0.080 0.000 0.123
##
## Robust RMSEA 0.089
## 90 Percent confidence interval - lower 0.056
## 90 Percent confidence interval - upper 0.122
## P-value H_0: Robust RMSEA <= 0.050 0.030
## P-value H_0: Robust RMSEA >= 0.080 0.697
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.037 0.037
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 =~
## R_P13 1.000 0.854 0.854
## R_P10 0.923 0.040 23.345 0.000 0.789 0.789
## R_P14 0.971 0.036 27.163 0.000 0.830 0.830
## R_P9 0.834 0.051 16.496 0.000 0.713 0.713
## R_P12 1.083 0.039 28.018 0.000 0.925 0.925
## R_P11 0.895 0.040 22.636 0.000 0.765 0.765
## P2 =~
## R_P2 1.000 0.702 0.702
## R_P1 1.080 0.082 13.197 0.000 0.758 0.758
## R_P7 1.023 0.081 12.634 0.000 0.718 0.718
## R_P8 1.135 0.091 12.402 0.000 0.797 0.797
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P10 ~~
## .R_P9 0.160 0.037 4.277 0.000 0.160 0.370
## .R_P13 ~~
## .R_P14 0.131 0.038 3.459 0.001 0.131 0.451
## .R_P1 ~~
## .R_P8 -0.239 0.047 -5.126 0.000 -0.239 -0.606
## P1 ~~
## P2 0.509 0.042 12.147 0.000 0.847 0.847
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P12|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_P12|t2 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_P12|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P12|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P13 0.270 0.270 0.270
## .R_P10 0.378 0.378 0.378
## .R_P14 0.312 0.312 0.312
## .R_P9 0.492 0.492 0.492
## .R_P12 0.143 0.143 0.143
## .R_P11 0.415 0.415 0.415
## .R_P2 0.507 0.507 0.507
## .R_P1 0.425 0.425 0.425
## .R_P7 0.484 0.484 0.484
## .R_P8 0.365 0.365 0.365
## P1 0.730 0.045 16.364 0.000 1.000 1.000
## P2 0.493 0.061 8.119 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES CÒN LẠI) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES CÒN LẠI) ---mi_P_adj2 <- modindices(fit_P_final_adj2)
mi_P_adj2_res <- mi_P_adj2[mi_P_adj2$op == "~~", ]
print(head(mi_P_adj2_res[order(-mi_P_adj2_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 119 R_P9 ~~ R_P2 5.576 0.132 0.132 0.264 0.264
## 95 R_P13 ~~ R_P10 4.172 -0.111 -0.111 -0.348 -0.348
## 124 R_P12 ~~ R_P2 3.738 -0.136 -0.136 -0.505 -0.505
## 97 R_P13 ~~ R_P12 3.548 0.082 0.082 0.416 0.416
## 122 R_P9 ~~ R_P8 2.959 0.087 0.087 0.204 0.204MODEL cũ loại câu P12
# ==============================================================================
# BƯỚC 2.2: LOẠI TIẾP P12 (CÂU CÓ COMPLEXITY CAO NHẤT HIỆN TẠI)
# ==============================================================================
library(psych)
# 1. Tạo tập dữ liệu mới loại bỏ P3 và P12
data_P_drop_3_12 <- data_P_EFA[, !(names(data_P_EFA) %in% c("R_P3", "R_P12"))]
# 2. Chạy lại EFA 2 nhân tố
efa_P_v3 <- fa(data_P_drop_3_12, nfactors = 2, cor = "poly", fm = "pa", rotate = "promax")
cat("\n--- KẾT QUẢ EFA SAU KHI LOẠI P3 VÀ P12 ---\n")##
## --- KẾT QUẢ EFA SAU KHI LOẠI P3 VÀ P12 ---# 3. Trích xuất Loading và tính toán lại các chỉ số
loadings_raw_v3 <- as.data.frame(unclass(efa_P_v3$loadings))
loadings_table_v3 <- round(loadings_raw_v3, 3)
loadings_table_v3$Communality <- round(efa_P_v3$communality, 3)
loadings_table_v3$Complexity <- round(efa_P_v3$complexity, 3)
loadings_table_v3$Difference <- apply(loadings_raw_v3, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
# 4. Ẩn loading < 0.3 và sắp xếp
display_table_v3 <- loadings_table_v3
for(i in 1:2) {
display_table_v3[, i] <- ifelse(abs(loadings_table_v3[, i]) < 0.3, "", as.character(loadings_table_v3[, i]))
}
display_table_v3$Group <- apply(abs(loadings_raw_v3), 1, which.max)
display_table_v3 <- display_table_v3[order(display_table_v3$Group, -apply(abs(loadings_raw_v3), 1, max)), ]
# 5. IN BẢNG KẾT QUẢ
print(display_table_v3[, !(names(display_table_v3) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_P6 0.921 0.786 1.005 0.874
## R_P5 0.745 0.618 1.011 0.689
## R_P7 0.734 0.483 1.011 0.679
## R_P1 0.698 0.595 1.038 0.602
## R_P2 0.69 0.486 1.000 0.680
## R_P4 0.628 0.544 1.101 0.486
## R_P8 0.585 0.429 1.048 0.494
## R_P13 0.936 0.802 1.007 0.879
## R_P14 0.828 0.717 1.002 0.804
## R_P10 0.801 0.658 1.001 0.787
## R_P9 0.668 0.574 1.061 0.552
## R_P11 0.65 0.525 1.045 0.553cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (BƯỚC 2.2) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (BƯỚC 2.2) ---print(round(efa_P_v3$Vaccounted, 3))## PA1 PA2
## SS loadings 3.883 3.334
## Proportion Var 0.324 0.278
## Cumulative Var 0.324 0.601
## Proportion Explained 0.538 0.462
## Cumulative Proportion 0.538 1.000# ==============================================================================
# BƯỚC 2.3: LOẠI BỎ NỐT P4 (HOÀN TẤT BỘ BA P3, P4, P12)
# ==============================================================================
library(psych)
# 1. Tạo tập dữ liệu mới loại bỏ P3, P12 và P4
data_P_clean <- data_P_EFA[, !(names(data_P_EFA) %in% c("R_P3", "R_P12", "R_P4"))]
# 2. Chạy lại EFA 2 nhân tố
efa_P_v4 <- fa(data_P_clean, nfactors = 2, cor = "poly", fm = "pa", rotate = "promax")
cat("\n--- KẾT QUẢ EFA CUỐI CÙNG (SAU KHI LOẠI P3, P12, P4) ---\n")##
## --- KẾT QUẢ EFA CUỐI CÙNG (SAU KHI LOẠI P3, P12, P4) ---# 3. Trích xuất Loading và tính toán lại các chỉ số
loadings_raw_v4 <- as.data.frame(unclass(efa_P_v4$loadings))
loadings_table_v4 <- round(loadings_raw_v4, 3)
loadings_table_v4$Communality <- round(efa_P_v4$communality, 3)
loadings_table_v4$Complexity <- round(efa_P_v4$complexity, 3)
loadings_table_v4$Difference <- apply(loadings_raw_v4, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
# 4. Ẩn loading < 0.3 và sắp xếp
display_table_v4 <- loadings_table_v4
for(i in 1:2) {
display_table_v4[, i] <- ifelse(abs(loadings_table_v4[, i]) < 0.3, "", as.character(loadings_table_v4[, i]))
}
display_table_v4$Group <- apply(abs(loadings_raw_v4), 1, which.max)
display_table_v4 <- display_table_v4[order(display_table_v4$Group, -apply(abs(loadings_raw_v4), 1, max)), ]
# 5. IN BẢNG KẾT QUẢ
print(display_table_v4[, !(names(display_table_v4) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_P6 0.912 0.793 1.002 0.882
## R_P7 0.773 0.519 1.019 0.698
## R_P5 0.702 0.596 1.035 0.608
## R_P1 0.667 0.587 1.076 0.537
## R_P2 0.658 0.477 1.009 0.615
## R_P8 0.581 0.429 1.057 0.483
## R_P13 0.943 0.808 1.009 0.881
## R_P14 0.847 0.719 1.000 0.846
## R_P10 0.8 0.658 1.001 0.785
## R_P9 0.663 0.576 1.073 0.536
## R_P11 0.657 0.516 1.031 0.575cat("\n--- TỔNG PHƯƠNG SAI TRÍCH CUỐI CÙNG ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH CUỐI CÙNG ---print(round(efa_P_v4$Vaccounted, 3))## PA1 PA2
## SS loadings 3.339 3.338
## Proportion Var 0.304 0.303
## Cumulative Var 0.304 0.607
## Proportion Explained 0.500 0.500
## Cumulative Proportion 0.500 1.000#Quay lại với phân tích CFA cho mô hình 2 factors.
# ==============================================================================
# BƯỚC 10 (DOMAIN P): CHẠY CFA 2 NHÂN TỐ (ĐÃ ĐỔI TÊN THÀNH P1, P2)
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA 2 NHÂN TỐ (P1: 6 CÂU, P2: 5 CÂU) ---\n")##
## --- 1. CHẠY CFA 2 NHÂN TỐ (P1: 6 CÂU, P2: 5 CÂU) ---# Cập nhật tên Latent Variables thành P1 và P2
model_P_final <- '
P1 =~ R_P6 + R_P7 + R_P5 + R_P1 + R_P2 + R_P8
P2 =~ R_P13 + R_P14 + R_P10 + R_P9 + R_P11
'
# Chạy CFA với estimator WLSMV
fit_P_final <- cfa(model_P_final,
data = data_P_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT INDICES) ---\n")##
## --- 2. CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT INDICES) ---# Xuất kết quả chi tiết
summary(fit_P_final, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 25 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 52
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 90.397 148.158
## Degrees of freedom 43 43
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.654
## Shift parameter 9.947
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 9098.393 4042.866
## Degrees of freedom 55 55
## P-value NA 0.000
## Scaling correction factor 2.268
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.995 0.974
## Tucker-Lewis Index (TLI) 0.993 0.966
##
## Robust Comparative Fit Index (CFI) 0.897
## Robust Tucker-Lewis Index (TLI) 0.868
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.071 0.106
## 90 Percent confidence interval - lower 0.050 0.087
## 90 Percent confidence interval - upper 0.091 0.125
## P-value H_0: RMSEA <= 0.050 0.047 0.000
## P-value H_0: RMSEA >= 0.080 0.246 0.989
##
## Robust RMSEA 0.136
## 90 Percent confidence interval - lower 0.113
## 90 Percent confidence interval - upper 0.161
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.054 0.054
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 =~
## R_P6 1.000 0.863 0.863
## R_P7 0.809 0.043 18.666 0.000 0.698 0.698
## R_P5 0.941 0.037 25.334 0.000 0.812 0.812
## R_P1 0.778 0.048 16.186 0.000 0.671 0.671
## R_P2 0.770 0.048 16.037 0.000 0.664 0.664
## R_P8 0.830 0.044 18.983 0.000 0.716 0.716
## P2 =~
## R_P13 1.000 0.874 0.874
## R_P14 1.005 0.036 27.599 0.000 0.879 0.879
## R_P10 0.933 0.038 24.772 0.000 0.816 0.816
## R_P9 0.858 0.051 16.921 0.000 0.750 0.750
## R_P11 0.869 0.037 23.546 0.000 0.760 0.760
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 ~~
## P2 0.690 0.034 20.275 0.000 0.915 0.915
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_P6|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P6|t2 -1.036 0.103 -10.015 0.000 -1.036 -1.036
## R_P6|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P6|t4 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P5|t2 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_P5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P6 0.256 0.256 0.256
## .R_P7 0.513 0.513 0.513
## .R_P5 0.340 0.340 0.340
## .R_P1 0.550 0.550 0.550
## .R_P2 0.559 0.559 0.559
## .R_P8 0.487 0.487 0.487
## .R_P13 0.235 0.235 0.235
## .R_P14 0.228 0.228 0.228
## .R_P10 0.335 0.335 0.335
## .R_P9 0.437 0.437 0.437
## .R_P11 0.422 0.422 0.422
## P1 0.744 0.040 18.537 0.000 1.000 1.000
## P2 0.765 0.043 17.747 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---# Kiểm tra các cặp phần dư
mi_P <- modindices(fit_P_final)
mi_P_res <- mi_P[mi_P$op == "~~", ]
mi_P_sorted <- mi_P_res[order(-mi_P_res$mi), ]
print(head(mi_P_sorted, 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 146 R_P13 ~~ R_P14 23.434 0.194 0.194 0.839 0.839
## 153 R_P10 ~~ R_P9 12.319 0.165 0.165 0.432 0.432
## 147 R_P13 ~~ R_P10 9.038 -0.160 -0.160 -0.572 -0.572
## 114 R_P7 ~~ R_P8 7.149 0.128 0.128 0.256 0.256
## 122 R_P5 ~~ R_P8 5.978 -0.137 -0.137 -0.337 -0.337# ==============================================================================
# BƯỚC 10.1: MÔ HÌNH CFA DOMAIN P (NỐI HIỆP PHƯƠNG SAI P13 ~~ P14)
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA 2 NHÂN TỐ (ĐÃ NỐI PHẦN DƯ P13-P14) ---\n")##
## --- 1. CHẠY CFA 2 NHÂN TỐ (ĐÃ NỐI PHẦN DƯ P13-P14) ---# Định nghĩa lại mô hình: P1 (6 câu), P2 (5 câu) + Nối sai số P13-P14
model_P_adj <- '
P1 =~ R_P6 + R_P7 + R_P5 + R_P1 + R_P2 + R_P8
P2 =~ R_P13 + R_P14 + R_P10 + R_P9 + R_P11
# Nối phần dư dựa trên MI cao nhất của bước trước
R_P13 ~~ R_P14
'
# Chạy CFA với estimator WLSMV
fit_P_adj <- cfa(model_P_adj,
data = data_P_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CHỈ SỐ ĐỘ PHÙ HỢP SAU CHỈNH SỬA ---\n")##
## --- 2. CHỈ SỐ ĐỘ PHÙ HỢP SAU CHỈNH SỬA ---# Xuất kết quả chi tiết
summary(fit_P_adj, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 29 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 53
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 67.049 116.903
## Degrees of freedom 42 42
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.623
## Shift parameter 9.310
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 9098.393 4042.866
## Degrees of freedom 55 55
## P-value NA 0.000
## Scaling correction factor 2.268
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.997 0.981
## Tucker-Lewis Index (TLI) 0.996 0.975
##
## Robust Comparative Fit Index (CFI) 0.932
## Robust Tucker-Lewis Index (TLI) 0.911
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.052 0.090
## 90 Percent confidence interval - lower 0.027 0.071
## 90 Percent confidence interval - upper 0.075 0.110
## P-value H_0: RMSEA <= 0.050 0.414 0.001
## P-value H_0: RMSEA >= 0.080 0.020 0.818
##
## Robust RMSEA 0.112
## 90 Percent confidence interval - lower 0.088
## 90 Percent confidence interval - upper 0.137
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 0.984
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.048 0.048
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 =~
## R_P6 1.000 0.862 0.862
## R_P7 0.808 0.043 18.648 0.000 0.696 0.696
## R_P5 0.944 0.037 25.368 0.000 0.814 0.814
## R_P1 0.783 0.048 16.191 0.000 0.674 0.674
## R_P2 0.771 0.048 16.055 0.000 0.665 0.665
## R_P8 0.830 0.044 19.046 0.000 0.715 0.715
## P2 =~
## R_P13 1.000 0.808 0.808
## R_P14 1.001 0.039 25.937 0.000 0.809 0.809
## R_P10 1.016 0.047 21.583 0.000 0.821 0.821
## R_P9 0.930 0.059 15.845 0.000 0.752 0.752
## R_P11 0.954 0.044 21.801 0.000 0.771 0.771
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P13 ~~
## .R_P14 0.186 0.041 4.540 0.000 0.186 0.538
## P1 ~~
## P2 0.657 0.037 17.757 0.000 0.944 0.944
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_P6|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P6|t2 -1.036 0.103 -10.015 0.000 -1.036 -1.036
## R_P6|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P6|t4 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P5|t2 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_P5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P6 0.258 0.258 0.258
## .R_P7 0.516 0.516 0.516
## .R_P5 0.338 0.338 0.338
## .R_P1 0.545 0.545 0.545
## .R_P2 0.558 0.558 0.558
## .R_P8 0.489 0.489 0.489
## .R_P13 0.347 0.347 0.347
## .R_P14 0.346 0.346 0.346
## .R_P10 0.326 0.326 0.326
## .R_P9 0.435 0.435 0.435
## .R_P11 0.406 0.406 0.406
## P1 0.742 0.040 18.473 0.000 1.000 1.000
## P2 0.653 0.051 12.687 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---# Kiểm tra các cặp phần dư theo đúng style của Chương
mi_P <- modindices(fit_P_adj)
mi_P_res <- mi_P[mi_P$op == "~~", ]
mi_P_sorted <- mi_P_res[order(-mi_P_res$mi), ]
print(head(mi_P_sorted, 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 153 R_P10 ~~ R_P9 11.398 0.161 0.161 0.426 0.426
## 115 R_P7 ~~ R_P8 7.447 0.130 0.130 0.260 0.260
## 118 R_P7 ~~ R_P10 6.733 -0.118 -0.118 -0.288 -0.288
## 123 R_P5 ~~ R_P8 6.008 -0.138 -0.138 -0.338 -0.338
## 155 R_P9 ~~ R_P11 5.323 -0.138 -0.138 -0.328 -0.328# ==============================================================================
# BƯỚC 10.2: CHỈNH SỬA MÔ HÌNH CFA DOMAIN P (NỐI THÊM PHẦN DƯ P10 ~~ P9)
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA 2 NHÂN TỐ (NỐI 2 CẶP: P13-P14 VÀ P10-P9) ---\n")##
## --- 1. CHẠY CFA 2 NHÂN TỐ (NỐI 2 CẶP: P13-P14 VÀ P10-P9) ---# Cập nhật mô hình: Thêm đường nối hiệp phương sai cho cặp P10-P9
model_P_adj2 <- '
P1 =~ R_P6 + R_P7 + R_P5 + R_P1 + R_P2 + R_P8
P2 =~ R_P13 + R_P14 + R_P10 + R_P9 + R_P11
# Các đường nối phần dư dựa trên MI > 10
R_P13 ~~ R_P14
R_P10 ~~ R_P9
'
fit_P_adj2 <- cfa(model_P_adj2,
data = data_P_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI NỐI 2 CẶP ---\n")##
## --- 2. CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI NỐI 2 CẶP ---# Xuất kết quả chi tiết
summary(fit_P_adj2, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 28 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 54
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 55.652 99.108
## Degrees of freedom 41 41
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.619
## Shift parameter 9.184
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 9098.393 4042.866
## Degrees of freedom 55 55
## P-value NA 0.000
## Scaling correction factor 2.268
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.998 0.985
## Tucker-Lewis Index (TLI) 0.998 0.980
##
## Robust Comparative Fit Index (CFI) 0.947
## Robust Tucker-Lewis Index (TLI) 0.928
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.040 0.080
## 90 Percent confidence interval - lower 0.000 0.060
## 90 Percent confidence interval - upper 0.065 0.101
## P-value H_0: RMSEA <= 0.050 0.710 0.008
## P-value H_0: RMSEA >= 0.080 0.003 0.535
##
## Robust RMSEA 0.100
## 90 Percent confidence interval - lower 0.075
## 90 Percent confidence interval - upper 0.126
## P-value H_0: Robust RMSEA <= 0.050 0.001
## P-value H_0: Robust RMSEA >= 0.080 0.909
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.045 0.045
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P1 =~
## R_P6 1.000 0.862 0.862
## R_P7 0.809 0.043 18.657 0.000 0.697 0.697
## R_P5 0.944 0.037 25.361 0.000 0.813 0.813
## R_P1 0.781 0.048 16.199 0.000 0.673 0.673
## R_P2 0.770 0.048 16.035 0.000 0.664 0.664
## R_P8 0.830 0.044 19.003 0.000 0.716 0.716
## P2 =~
## R_P13 1.000 0.809 0.809
## R_P14 1.001 0.038 25.997 0.000 0.809 0.809
## R_P10 0.974 0.048 20.286 0.000 0.788 0.788
## R_P9 0.884 0.060 14.733 0.000 0.715 0.715
## R_P11 0.952 0.044 21.849 0.000 0.770 0.770
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P13 ~~
## .R_P14 0.185 0.041 4.485 0.000 0.185 0.536
## .R_P10 ~~
## .R_P9 0.159 0.038 4.160 0.000 0.159 0.368
## P1 ~~
## P2 0.670 0.037 18.138 0.000 0.961 0.961
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_P6|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P6|t2 -1.036 0.103 -10.015 0.000 -1.036 -1.036
## R_P6|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P6|t4 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P5|t2 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_P5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P6 0.257 0.257 0.257
## .R_P7 0.514 0.514 0.514
## .R_P5 0.339 0.339 0.339
## .R_P1 0.547 0.547 0.547
## .R_P2 0.559 0.559 0.559
## .R_P8 0.488 0.488 0.488
## .R_P13 0.346 0.346 0.346
## .R_P14 0.345 0.345 0.345
## .R_P10 0.379 0.379 0.379
## .R_P9 0.489 0.489 0.489
## .R_P11 0.407 0.407 0.407
## P1 0.743 0.040 18.482 0.000 1.000 1.000
## P2 0.654 0.052 12.688 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---# Kiểm tra các cặp phần dư còn lại
mi_P <- modindices(fit_P_adj2)
mi_P_res <- mi_P[mi_P$op == "~~", ]
mi_P_sorted <- mi_P_res[order(-mi_P_res$mi), ]
print(head(mi_P_sorted, 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 116 R_P7 ~~ R_P8 7.268 0.129 0.129 0.258 0.258
## 124 R_P5 ~~ R_P8 6.019 -0.138 -0.138 -0.339 -0.339
## 119 R_P7 ~~ R_P10 5.098 -0.103 -0.103 -0.233 -0.233
## 131 R_P1 ~~ R_P8 3.949 -0.133 -0.133 -0.257 -0.257
## 115 R_P7 ~~ R_P2 3.551 0.114 0.114 0.213 0.213# ==============================================================================
# BƯỚC 11 (DOMAIN P): CHẠY MÔ HÌNH 1 NHÂN TỐ (GHÉP P1 VÀ P2)
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA MÔ HÌNH 1 NHÂN TỐ (GHÉP TẤT CẢ 11 CÂU) ---\n")##
## --- 1. CHẠY CFA MÔ HÌNH 1 NHÂN TỐ (GHÉP TẤT CẢ 11 CÂU) ---# Định nghĩa mô hình đơn nhân tố
model_P_unidim <- '
P_Total =~ R_P6 + R_P7 + R_P5 + R_P1 + R_P2 + R_P8 + R_P13 + R_P14 + R_P10 + R_P9 + R_P11
# Giữ lại các đường nối phần dư đã xác định
R_P13 ~~ R_P14
R_P10 ~~ R_P9
'
# Chạy CFA
fit_P_unidim <- cfa(model_P_unidim,
data = data_P_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CHỈ SỐ ĐỘ PHÙ HỢP (MÔ HÌNH 1 NHÂN TỐ) ---\n")##
## --- 2. CHỈ SỐ ĐỘ PHÙ HỢP (MÔ HÌNH 1 NHÂN TỐ) ---summary(fit_P_unidim, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 26 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 53
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 58.423 103.154
## Degrees of freedom 42 42
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.623
## Shift parameter 9.356
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 9098.393 4042.866
## Degrees of freedom 55 55
## P-value NA 0.000
## Scaling correction factor 2.268
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.998 0.985
## Tucker-Lewis Index (TLI) 0.998 0.980
##
## Robust Comparative Fit Index (CFI) 0.945
## Robust Tucker-Lewis Index (TLI) 0.928
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.042 0.082
## 90 Percent confidence interval - lower 0.005 0.062
## 90 Percent confidence interval - upper 0.066 0.102
## P-value H_0: RMSEA <= 0.050 0.673 0.006
## P-value H_0: RMSEA >= 0.080 0.003 0.571
##
## Robust RMSEA 0.100
## 90 Percent confidence interval - lower 0.075
## 90 Percent confidence interval - upper 0.126
## P-value H_0: Robust RMSEA <= 0.050 0.001
## P-value H_0: Robust RMSEA >= 0.080 0.913
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.046 0.046
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## P_Total =~
## R_P6 1.000 0.855 0.855
## R_P7 0.808 0.043 18.663 0.000 0.690 0.690
## R_P5 0.943 0.037 25.481 0.000 0.807 0.807
## R_P1 0.780 0.048 16.210 0.000 0.667 0.667
## R_P2 0.769 0.048 16.041 0.000 0.658 0.658
## R_P8 0.831 0.044 19.029 0.000 0.710 0.710
## R_P13 0.933 0.038 24.293 0.000 0.798 0.798
## R_P14 0.933 0.037 25.552 0.000 0.798 0.798
## R_P10 0.908 0.039 23.494 0.000 0.776 0.776
## R_P9 0.823 0.050 16.308 0.000 0.704 0.704
## R_P11 0.892 0.037 24.223 0.000 0.763 0.763
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P13 ~~
## .R_P14 0.203 0.039 5.183 0.000 0.203 0.559
## .R_P10 ~~
## .R_P9 0.176 0.038 4.641 0.000 0.176 0.392
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_P6|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P6|t2 -1.036 0.103 -10.015 0.000 -1.036 -1.036
## R_P6|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P6|t4 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P5|t2 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_P5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P6 0.269 0.269 0.269
## .R_P7 0.523 0.523 0.523
## .R_P5 0.349 0.349 0.349
## .R_P1 0.555 0.555 0.555
## .R_P2 0.567 0.567 0.567
## .R_P8 0.496 0.496 0.496
## .R_P13 0.364 0.364 0.364
## .R_P14 0.363 0.363 0.363
## .R_P10 0.398 0.398 0.398
## .R_P9 0.505 0.505 0.505
## .R_P11 0.418 0.418 0.418
## P_Total 0.731 0.040 18.365 0.000 1.000 1.000cat("\n--- 3. KIỂM TRA LẠI MI ---\n")##
## --- 3. KIỂM TRA LẠI MI ---mi_P <- modindices(fit_P_unidim)
mi_P_res <- mi_P[mi_P$op == "~~", ]
mi_P_sorted <- mi_P_res[order(-mi_P_res$mi), ]
print(head(mi_P_sorted, 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 102 R_P7 ~~ R_P8 8.345 0.137 0.137 0.268 0.268
## 105 R_P7 ~~ R_P10 6.109 -0.112 -0.112 -0.245 -0.245
## 110 R_P5 ~~ R_P8 4.958 -0.124 -0.124 -0.297 -0.297
## 89 R_P6 ~~ R_P7 4.840 0.091 0.091 0.242 0.242
## 136 R_P13 ~~ R_P11 4.669 0.101 0.101 0.260 0.260D. DOMAIN B - ANALYSIS
# ==============================================================================
# BƯỚC 1 (DOMAIN B): KHÁM SÀNG LỌC & XÁC ĐỊNH SỐ NHÂN TỐ
# ==============================================================================
library(psych)
cat("\n--- 1. (KMO & BARTLETT CHO DOMAIN B ---\n")##
## --- 1. (KMO & BARTLETT CHO DOMAIN B ---# Kiểm định KMO
kmo_B <- KMO(data_B_EFA)
cat("=> Chỉ số KMO Overall:", round(kmo_B$MSA, 3), "\n")## => Chỉ số KMO Overall: 0.666# Kiểm định Bartlett
bartlett_B <- cortest.bartlett(cor(data_B_EFA, use = "pairwise.complete.obs"), n = nrow(data_B_EFA))
cat("=> Bartlett's Test: Chi-square =", round(bartlett_B$chisq, 2),
"| df =", bartlett_B$df,
"| p-value =", bartlett_B$p.value, "\n")## => Bartlett's Test: Chi-square = 342.33 | df = 15 | p-value = 8.443721e-64cat("\n--- 2. CÁC TIÊU CHÍ GỢI Ý SỐ NHÂN TỐ ---\n")##
## --- 2. CÁC TIÊU CHÍ GỢI Ý SỐ NHÂN TỐ ---# Tiêu chí 1: Kaiser (Eigenvalue > 1)
eigen_B <- eigen(cor(data_B_EFA, use = "pairwise.complete.obs"))$values
cat("Các trị số Eigenvalues:\n", round(eigen_B, 3), "\n")## Các trị số Eigenvalues:
## 2.418 1.541 0.744 0.572 0.394 0.331cat("=> Gợi ý Kaiser (Eigenvalue > 1):", sum(eigen_B > 1), "nhân tố\n")## => Gợi ý Kaiser (Eigenvalue > 1): 2 nhân tốcat("\n--- KẾT QUẢ VSS & MAP (ĐÃ FIX LỖI MA TRẬN) ---\n")##
## --- KẾT QUẢ VSS & MAP (ĐÃ FIX LỖI MA TRẬN) ---# Đổi fm = "pa" thành fm = "minres"
vss_B <- vss(data_B_EFA, n = 3, fm = "minres", cor = "cor", plot = FALSE)## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefullyprint(vss_B)##
## Very Simple Structure
## Call: vss(x = data_B_EFA, n = 3, fm = "minres", plot = FALSE, cor = "cor")
## VSS complexity 1 achieves a maximimum of 0.81 with 2 factors
## VSS complexity 2 achieves a maximimum of 0.85 with 3 factors
##
## The Velicer MAP achieves a minimum of 0.07 with 1 factors
## BIC achieves a minimum of -15.54 with 2 factors
## Sample Size adjusted BIC achieves a minimum of -2.87 with 2 factors
##
## Statistics by number of factors
## vss1 vss2 map dof chisq prob sqresid fit RMSEA BIC SABIC complex eChisq
## 1 0.60 0.00 0.07 9 89.25 2.3e-15 3.8 0.60 0.201 41 69.2 1.0 68.52
## 2 0.81 0.82 0.12 4 6.05 2.0e-01 1.7 0.82 0.048 -16 -2.9 1.0 1.41
## 3 0.68 0.85 0.25 0 0.65 NA 1.4 0.85 NA NA NA 1.2 0.13
## SRMR eCRMS eBIC
## 1 0.1017 0.131 20
## 2 0.0146 0.028 -20
## 3 0.0044 NA NAcat("\n--- 3. PARALLEL ANALYSIS (PA) ---\n")##
## --- 3. PARALLEL ANALYSIS (PA) ---library(psych)
cat("\n--- 3. PARALLEL ANALYSIS (Dùng Pearson để tránh lỗi mô phỏng) ---\n")##
## --- 3. PARALLEL ANALYSIS (Dùng Pearson để tránh lỗi mô phỏng) ---# Đổi cor = "poly" thành cor = "cor" để thuật toán mô phỏng không bị sập
pa_B <- fa.parallel(data_B_EFA,
cor = "cor",
fm = "minres",
fa = "fa",
main = "Parallel Analysis - Domain B")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NA# ==============================================================================
# BƯỚC 2 (DOMAIN B): CHẠY EFA SO SÁNH 1 VÀ 2 NHÂN TỐ
# ==============================================================================
library(psych)
cat("\n=================================================================\n")##
## =================================================================cat(" MODEL 1: MÔ HÌNH 1 NHÂN TỐ\n")## MODEL 1: MÔ HÌNH 1 NHÂN TỐcat("=================================================================\n")## =================================================================# 1. Chạy EFA 1 nhân tố
efa_B_1fact <- fa(data_B_EFA, nfactors = 1, cor = "poly", fm = "minres")
# 2. Tạo bảng báo cáo
loadings_B1 <- as.data.frame(unclass(efa_B_1fact$loadings))
loadings_B1 <- round(loadings_B1, 3)
loadings_B1$Communality <- round(efa_B_1fact$communality, 3)
loadings_B1$Complexity <- round(efa_B_1fact$complexity, 3)
# 3. Sắp xếp giảm dần theo sức mạnh hệ số tải
loadings_B1 <- loadings_B1[order(-abs(loadings_B1[,1])), , drop = FALSE]
print(loadings_B1)## MR1 Communality Complexity
## R_B5 0.926 0.858 1
## R_B6 0.851 0.724 1
## R_B4 0.754 0.569 1
## R_B3 0.496 0.246 1
## R_B1_REV 0.081 0.007 1
## R_B2_REV 0.073 0.005 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (1 NHÂN TỐ) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (1 NHÂN TỐ) ---print(round(efa_B_1fact$Vaccounted, 3))## MR1
## SS loadings 2.409
## Proportion Var 0.402cat("\n\n=================================================================\n")##
##
## =================================================================cat(" MODEL 2: MÔ HÌNH 2 NHÂN TỐ\n")## MODEL 2: MÔ HÌNH 2 NHÂN TỐcat("=================================================================\n")## =================================================================# 1. Chạy EFA 2 nhân tố (Xoay trục xiên promax)
efa_B_2fact <- fa(data_B_EFA, nfactors = 2, cor = "poly", fm = "minres", rotate = "promax")## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefully# 2. Tạo bảng báo cáo thô
loadings_raw <- as.data.frame(unclass(efa_B_2fact$loadings))
loadings_B2 <- round(loadings_raw, 3)
# 3. Tính Communality, Complexity và Difference
loadings_B2$Communality <- round(efa_B_2fact$communality, 3)
loadings_B2$Complexity <- round(efa_B_2fact$complexity, 3)
loadings_B2$Difference <- apply(loadings_raw[, 1:2], 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
# 4. Ẩn loading < 0.3 để bảng "sạch" hơn
display_B2 <- loadings_B2
for(i in 1:2) {
display_B2[, i] <- ifelse(abs(loadings_B2[, i]) < 0.3, "", as.character(loadings_B2[, i]))
}
# 5. Sắp xếp theo nhóm nhân tố
display_B2$Group <- apply(abs(loadings_raw[, 1:2]), 1, which.max)
display_B2 <- display_B2[order(display_B2$Group, -apply(abs(loadings_raw[, 1:2]), 1, max)), ]
# 6. In bảng kết quả
print(display_B2[, !(names(display_B2) %in% "Group")], quote = FALSE)## MR1 MR2 Communality Complexity Difference
## R_B5 0.914 0.847 1.011 0.846
## R_B6 0.869 0.753 1.009 0.811
## R_B4 0.742 0.570 1.040 0.637
## R_B3 0.508 0.260 1.042 0.435
## R_B1_REV 1.003 1.006 1.000 0.990
## R_B2_REV 0.611 0.373 1.000 0.603cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (2 NHÂN TỐ) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (2 NHÂN TỐ) ---print(round(efa_B_2fact$Vaccounted, 3))## MR1 MR2
## SS loadings 2.403 1.406
## Proportion Var 0.400 0.234
## Cumulative Var 0.400 0.635
## Proportion Explained 0.631 0.369
## Cumulative Proportion 0.631 1.000# ==============================================================================
# BƯỚC 3 (DOMAIN B): CẮT BỎ TỪNG BƯỚC - LẦN 1 (LOẠI R_B1_REV)
# ==============================================================================
library(psych)
cat("\n--- CHẠY EFA (5 CÂU) - ĐÃ LOẠI BỎ R_B1_REV ---\n")##
## --- CHẠY EFA (5 CÂU) - ĐÃ LOẠI BỎ R_B1_REV ---# Tạo tập dữ liệu mới chỉ chứa 5 câu (Loại R_B1_REV)
data_B_step1 <- data_B_EFA[, c("R_B2_REV", "R_B3", "R_B4", "R_B5", "R_B6")]
cat("\n--- CHẠY PARALLEL ANALYSIS (PA) KIỂM TRA LẠI CẤU TRÚC ---\n")##
## --- CHẠY PARALLEL ANALYSIS (PA) KIỂM TRA LẠI CẤU TRÚC ---# Chạy PA trên dữ liệu 5 câu. Dùng cor="cor" để tránh lỗi mô phỏng
pa_B_step1 <- fa.parallel(data_B_step1, cor = "cor", fm = "minres", fa = "fa", main = "PA - Domain B (Đã loại R_B1_REV)")
## Parallel analysis suggests that the number of factors = 1 and the number of components = NAcat("\n=> Số nhân tố PA đề xuất sau khi cắt B1 là:", pa_B_step1$nfact, "\n")##
## => Số nhân tố PA đề xuất sau khi cắt B1 là: 1# Chạy lại EFA lấy số nhân tố tự động từ PA (pa_B_step1$nfact)
efa_B_step1 <- fa(data_B_step1, nfactors = pa_B_step1$nfact, cor = "poly", fm = "minres")
# Trích xuất và tạo bảng báo cáo
loadings_B_s1 <- as.data.frame(unclass(efa_B_step1$loadings))
loadings_B_s1 <- round(loadings_B_s1, 3)
loadings_B_s1$Communality <- round(efa_B_step1$communality, 3)
loadings_B_s1$Complexity <- round(efa_B_step1$complexity, 3)
# Sắp xếp giảm dần theo hệ số tải để dễ quan sát
loadings_B_s1 <- loadings_B_s1[order(-abs(loadings_B_s1[,1])), , drop = FALSE]
print(loadings_B_s1)## MR1 Communality Complexity
## R_B5 0.923 0.851 1
## R_B6 0.861 0.741 1
## R_B4 0.747 0.558 1
## R_B3 0.500 0.250 1
## R_B2_REV 0.052 0.003 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH ---print(round(efa_B_step1$Vaccounted, 3))## MR1
## SS loadings 2.404
## Proportion Var 0.481# ==============================================================================
# BƯỚC 3 (DOMAIN B): CẮT BỎ TỪNG BƯỚC - LẦN 2 (LOẠI TIẾP R_B2_REV)
# ==============================================================================
library(psych)
cat("\n--- CHẠY EFA (4 CÂU TỐT NHẤT) - ĐÃ LOẠI R_B2_REV VÀ R_B1_REV ---\n")##
## --- CHẠY EFA (4 CÂU TỐT NHẤT) - ĐÃ LOẠI R_B2_REV VÀ R_B1_REV ---# Tạo tập dữ liệu mới chỉ chứa 4 câu thuận chiều
data_B_step2 <- data_B_EFA[, c("R_B3", "R_B4", "R_B5", "R_B6")]
# Chạy lại EFA 1 nhân tố
efa_B_step2 <- fa(data_B_step2, nfactors = 1, cor = "poly", fm = "minres")
# Trích xuất và tạo bảng báo cáo
loadings_B_s2 <- as.data.frame(unclass(efa_B_step2$loadings))
loadings_B_s2 <- round(loadings_B_s2, 3)
loadings_B_s2$Communality <- round(efa_B_step2$communality, 3)
loadings_B_s2$Complexity <- round(efa_B_step2$complexity, 3)
# Sắp xếp giảm dần theo hệ số tải để dễ quan sát
loadings_B_s2 <- loadings_B_s2[order(-abs(loadings_B_s2[,1])), , drop = FALSE]
print(loadings_B_s2)## MR1 Communality Complexity
## R_B5 0.920 0.846 1
## R_B6 0.862 0.743 1
## R_B4 0.748 0.559 1
## R_B3 0.502 0.252 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (PROPORTION VAR) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (PROPORTION VAR) ---print(round(efa_B_step2$Vaccounted, 3))## MR1
## SS loadings 2.4
## Proportion Var 0.6#CFA Analysis for 4 items B3, B4, B5, B6. (Giữ nguyên 4 câu hỏi này) - CHỐT ĐOẠN NÀY
# ==============================================================================
# BƯỚC 4 (DOMAIN B): CHẠY CFA CHO MÔ HÌNH 1 NHÂN TỐ (B3, B4, B5, B6)
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY CFA 1 NHÂN TỐ (B3, B4, B5, B6) ---\n")##
## --- 1. CHẠY CFA 1 NHÂN TỐ (B3, B4, B5, B6) ---# Định nghĩa cấu trúc mô hình 1 nhân tố Rào cản (Barriers)
model_B_final <- '
Barriers =~ R_B3 + R_B4 + R_B5 + R_B6
'
# Chạy thuật toán CFA với ước lượng WLSMV cho dữ liệu thứ bậc
fit_B <- cfa(model_B_final,
data = data_B_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CHỈ SỐ ROBUST (FIT INDICES) ---\n")##
## --- 2. CHỈ SỐ ROBUST (FIT INDICES) ---# Xuất kết quả chi tiết
summary(fit_B, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 13 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 18
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 4.391 9.189
## Degrees of freedom 2 2
## P-value (Unknown) NA 0.010
## Scaling correction factor 0.481
## Shift parameter 0.055
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 956.538 790.258
## Degrees of freedom 6 6
## P-value NA 0.000
## Scaling correction factor 1.212
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.997 0.991
## Tucker-Lewis Index (TLI) 0.992 0.973
##
## Robust Comparative Fit Index (CFI) 0.977
## Robust Tucker-Lewis Index (TLI) 0.931
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.074 0.128
## 90 Percent confidence interval - lower 0.000 0.053
## 90 Percent confidence interval - upper 0.170 0.217
## P-value H_0: RMSEA <= 0.050 0.246 0.044
## P-value H_0: RMSEA >= 0.080 0.556 0.871
##
## Robust RMSEA 0.129
## 90 Percent confidence interval - lower 0.042
## 90 Percent confidence interval - upper 0.231
## P-value H_0: Robust RMSEA <= 0.050 0.063
## P-value H_0: Robust RMSEA >= 0.080 0.851
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.037 0.037
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Barriers =~
## R_B3 1.000 0.517 0.517
## R_B4 1.589 0.165 9.643 0.000 0.822 0.822
## R_B5 1.641 0.198 8.274 0.000 0.849 0.849
## R_B6 1.359 0.157 8.671 0.000 0.703 0.703
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_B3|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_B3|t2 -0.926 0.099 -9.324 0.000 -0.926 -0.926
## R_B3|t3 0.980 0.101 9.675 0.000 0.980 0.980
## R_B4|t1 -1.184 0.110 -10.742 0.000 -1.184 -1.184
## R_B4|t2 0.398 0.087 4.561 0.000 0.398 0.398
## R_B4|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_B5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B5|t2 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_B5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_B5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_B6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B6|t2 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_B6|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_B6|t4 2.609 0.342 7.622 0.000 2.609 2.609
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_B3 0.733 0.733 0.733
## .R_B4 0.324 0.324 0.324
## .R_B5 0.279 0.279 0.279
## .R_B6 0.506 0.506 0.506
## Barriers 0.267 0.056 4.778 0.000 1.000 1.000cat("\n--- 3. (MODIFICATION INDICES) ---\n")##
## --- 3. (MODIFICATION INDICES) ---# Trích xuất toàn bộ MI
mi_B <- modindices(fit_B)
# Lọc: Chỉ lấy các đường nối phần dư
mi_B_res <- mi_B[mi_B$op == "~~", ]
# Sắp xếp: Đưa các cặp có chỉ số MI cao nhất lên đầu
mi_B_sorted <- mi_B_res[order(-mi_B_res$mi), ]
# In kết quả top 5
print(head(mi_B_sorted, 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 35 R_B3 ~~ R_B6 4.305 0.150 0.150 0.247 0.247
## 36 R_B4 ~~ R_B5 4.305 0.289 0.289 0.958 0.958
## 34 R_B3 ~~ R_B5 1.653 -0.108 -0.108 -0.240 -0.240
## 37 R_B4 ~~ R_B6 1.653 -0.143 -0.143 -0.352 -0.352
## 38 R_B5 ~~ R_B6 0.543 -0.087 -0.087 -0.232 -0.232E. Domain F Analysis
# ==============================================================================
# BƯỚC 1 (DOMAIN F): KIỂM ĐỊNH KMO, BARTLETT VÀ CÁC TIÊU CHÍ SỐ NHÂN TỐ
# ==============================================================================
library(psych)
cat("\n--- 1. KIỂM ĐỊNH KMO VÀ BARTLETT CHO DOMAIN F (14 CÂU) ---\n")##
## --- 1. KIỂM ĐỊNH KMO VÀ BARTLETT CHO DOMAIN F (14 CÂU) ---kmo_F <- KMO(data_F_EFA)
print(kmo_F)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = data_F_EFA)
## Overall MSA = 0.93
## MSA for each item =
## R_F1 R_F2 R_F3 R_F4 R_F5 R_F6 R_F7 R_F8 R_F9 R_F10 R_F11 R_F12 R_F13
## 0.96 0.78 0.94 0.94 0.94 0.95 0.94 0.94 0.94 0.95 0.90 0.91 0.93
## R_F14
## 0.89bartlett_F <- cortest.bartlett(cor(data_F_EFA), n = nrow(data_F_EFA))
cat("\n=> Bartlett's Test: Chi-square = ", round(bartlett_F$chisq, 3),
" | df = ", bartlett_F$df,
" | p-value = ", bartlett_F$p.value, "\n")##
## => Bartlett's Test: Chi-square = 2220.818 | df = 91 | p-value = 0cat("\n--- 2. CÁC TIÊU CHÍ GỢI Ý SỐ NHÂN TỐ (KAISER, VSS, MAP) ---\n")##
## --- 2. CÁC TIÊU CHÍ GỢI Ý SỐ NHÂN TỐ (KAISER, VSS, MAP) ---# 2.1. Tiêu chí Kaiser (Eigenvalue > 1)
eigen_F <- eigen(cor(data_F_EFA))$values
cat("Các trị số Eigenvalues:\n", round(eigen_F, 3), "\n")## Các trị số Eigenvalues:
## 7.902 1.318 0.759 0.694 0.668 0.505 0.422 0.394 0.323 0.256 0.231 0.189 0.176 0.163cat("=> Gợi ý Kaiser (Eigenvalue > 1):", sum(eigen_F > 1), "nhân tố\n\n")## => Gợi ý Kaiser (Eigenvalue > 1): 2 nhân tố# 2.2. Tiêu chí VSS và Velicer's MAP
vss_F <- vss(data_F_EFA, n = 5, fm = "pa", cor = "cor", plot = FALSE)
print(vss_F)##
## Very Simple Structure
## Call: vss(x = data_F_EFA, n = 5, fm = "pa", plot = FALSE, cor = "cor")
## VSS complexity 1 achieves a maximimum of 0.93 with 1 factors
## VSS complexity 2 achieves a maximimum of 0.96 with 2 factors
##
## The Velicer MAP achieves a minimum of 0.03 with 2 factors
## BIC achieves a minimum of -149.92 with 2 factors
## Sample Size adjusted BIC achieves a minimum of 2.64 with 5 factors
##
## Statistics by number of factors
## vss1 vss2 map dof chisq prob sqresid fit RMSEA BIC SABIC complex
## 1 0.93 0.00 0.035 77 376 6.4e-41 4.3 0.93 0.132 -40 204.3 1.0
## 2 0.59 0.96 0.030 64 196 3.0e-15 2.9 0.96 0.096 -150 52.9 1.5
## 3 0.59 0.90 0.039 52 149 2.4e-11 2.4 0.96 0.092 -131 33.4 1.8
## 4 0.41 0.79 0.049 41 96 3.0e-06 2.1 0.97 0.077 -126 4.2 2.2
## 5 0.44 0.78 0.068 31 72 4.5e-05 1.5 0.98 0.077 -96 2.6 2.2
## eChisq SRMR eCRMS eBIC
## 1 99.9 0.050 0.054 -316
## 2 31.1 0.028 0.033 -314
## 3 19.7 0.022 0.029 -261
## 4 12.3 0.017 0.026 -209
## 5 6.3 0.012 0.021 -161cat("\n--- 3. PARALLEL ANALYSIS (PA) ---\n")##
## --- 3. PARALLEL ANALYSIS (PA) ---pa_F_v0 <- fa.parallel(data_F_EFA, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain F (Bản gốc)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NA# ==============================================================================
# BƯỚC 2 (DOMAIN F): CHẠY EFA VỚI 2 NHÂN TỐ LẦN 1 (BẢN GỐC 14 CÂU)
# ==============================================================================
library(psych)
cat("\n--- 1. CHẠY EFA CHO DOMAIN F VỚI SỐ NHÂN TỐ = 2 ---\n")##
## --- 1. CHẠY EFA CHO DOMAIN F VỚI SỐ NHÂN TỐ = 2 ---efa_F_v1 <- fa(data_F_EFA, nfactors = 2, cor = "poly", fm = "pa", rotate = "promax")
# 2. Trích xuất và định dạng bảng kết quả
loadings_raw_F1 <- as.data.frame(unclass(efa_F_v1$loadings))
loadings_F1 <- round(loadings_raw_F1, 3)
loadings_F1$Communality <- round(efa_F_v1$communality, 3)
loadings_F1$Complexity <- round(efa_F_v1$complexity, 3)
# Tính Difference (Chênh lệch 2 hệ số tải) để soi Cross-loading
loadings_F1$Difference <- apply(loadings_raw_F1, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
# 3. Tạo bảng hiển thị: Ẩn hệ số tải < 0.3
display_F1 <- loadings_F1
for(i in 1:2) {
display_F1[, i] <- ifelse(abs(loadings_F1[, i]) < 0.3, "", as.character(loadings_F1[, i]))
}
# 4. Sắp xếp các câu theo từng nhóm nhân tố để dễ quan sát
display_F1$Group <- apply(abs(loadings_raw_F1), 1, which.max)
display_F1 <- display_F1[order(display_F1$Group, -apply(abs(loadings_raw_F1), 1, max)), ]
cat("\n--- BẢNG HỆ SỐ TẢI DOMAIN F (2 NHÂN TỐ, ĐÃ ẨN < 0.3) ---\n")##
## --- BẢNG HỆ SỐ TẢI DOMAIN F (2 NHÂN TỐ, ĐÃ ẨN < 0.3) ---print(display_F1[, !(names(display_F1) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_F5 1.09 0.849 1.133 0.809
## R_F4 0.934 0.763 1.020 0.841
## R_F7 0.929 0.831 1.002 0.903
## R_F6 0.837 0.791 1.015 0.764
## R_F8 0.796 0.738 1.025 0.707
## R_F3 0.79 0.597 1.002 0.764
## R_F9 0.673 0.730 1.247 0.435
## R_F1 0.405 0.312 0.433 1.879 0.093
## R_F11 0.7 0.692 1.128 0.523
## R_F14 0.679 0.495 1.006 0.643
## R_F2 0.66 0.269 1.302 0.400
## R_F12 0.326 0.587 0.712 1.564 0.261
## R_F10 0.353 0.504 0.621 1.791 0.151
## R_F13 0.365 0.455 0.568 1.910 0.090cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (LẦN 1) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (LẦN 1) ---print(round(efa_F_v1$Vaccounted, 3))## PA1 PA2
## SS loadings 6.302 2.786
## Proportion Var 0.450 0.199
## Cumulative Var 0.450 0.649
## Proportion Explained 0.693 0.307
## Cumulative Proportion 0.693 1.000# ==============================================================================
# BƯỚC 2.1 (DOMAIN F): LOẠI BỎ R_F13 (CROSS-LOADING NẶNG NHẤT) VÀ CHẠY LẠI
# ==============================================================================
library(psych)
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI R_F13 (CÒN 13 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI R_F13 (CÒN 13 CÂU) ---data_F_drop13 <- data_F_EFA[, !(names(data_F_EFA) %in% c("R_F13"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI F13 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI F13 ---pa_F_v1 <- fa.parallel(data_F_drop13, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain F (Đã loại F13)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_F_v1$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2cat("\n--- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F13) ---\n")##
## --- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F13) ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_F_v1 <- fa(data_F_drop13, nfactors = pa_F_v1$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_v1 <- as.data.frame(unclass(efa_F_v1$loadings))
loadings_table_v1 <- round(loadings_raw_v1, 3)
loadings_table_v1$Communality <- round(efa_F_v1$communality, 3)
loadings_table_v1$Complexity <- round(efa_F_v1$complexity, 3)
# Chỉ tính Difference nếu số nhân tố PA gợi ý > 1
if(pa_F_v1$nfact > 1) {
loadings_table_v1$Difference <- apply(loadings_raw_v1, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_F1 <- loadings_table_v1
for(i in 1:pa_F_v1$nfact) {
display_table_F1[, i] <- ifelse(abs(loadings_table_v1[, i]) < 0.3, "", as.character(loadings_table_v1[, i]))
}
display_table_F1$Group <- apply(abs(loadings_raw_v1), 1, which.max)
display_table_F1 <- display_table_F1[order(display_table_F1$Group, -apply(abs(loadings_raw_v1), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_F1[, !(names(display_table_F1) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_F5 1.076 0.847 1.122 0.810
## R_F4 0.939 0.762 1.025 0.834
## R_F7 0.925 0.829 1.001 0.903
## R_F6 0.834 0.796 1.020 0.751
## R_F8 0.796 0.738 1.026 0.706
## R_F3 0.785 0.598 1.001 0.767
## R_F9 0.671 0.743 1.285 0.415
## R_F1 0.422 0.420 1.755 0.137
## R_F11 0.709 0.710 1.133 0.526
## R_F2 0.68 0.295 1.284 0.421
## R_F14 0.609 0.449 1.041 0.523
## R_F12 0.336 0.585 0.717 1.595 0.249
## R_F10 0.364 0.497 0.621 1.833 0.133cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_F_v1$Vaccounted, 3))## PA1 PA2
## SS loadings 6.089 2.436
## Proportion Var 0.468 0.187
## Cumulative Var 0.468 0.656
## Proportion Explained 0.714 0.286
## Cumulative Proportion 0.714 1.000# ==============================================================================
# BƯỚC 2.2 (DOMAIN F): LOẠI TIẾP R_F10 (CROSS-LOADING NẶNG NHẤT) VÀ CHẠY LẠI
# ==============================================================================
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI F13, F10 (CÒN 12 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI F13, F10 (CÒN 12 CÂU) ---data_F_drop10 <- data_F_drop13[, !(names(data_F_drop13) %in% c("R_F10"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI F10 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI F10 ---pa_F_v2 <- fa.parallel(data_F_drop10, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain F (Đã loại F13, F10)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_F_v2$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2cat("\n--- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F10) ---\n")##
## --- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F10) ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_F_v2 <- fa(data_F_drop10, nfactors = pa_F_v2$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_v2 <- as.data.frame(unclass(efa_F_v2$loadings))
loadings_table_v2 <- round(loadings_raw_v2, 3)
loadings_table_v2$Communality <- round(efa_F_v2$communality, 3)
loadings_table_v2$Complexity <- round(efa_F_v2$complexity, 3)
# Tính Difference
if(pa_F_v2$nfact > 1) {
loadings_table_v2$Difference <- apply(loadings_raw_v2, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_F2 <- loadings_table_v2
for(i in 1:pa_F_v2$nfact) {
display_table_F2[, i] <- ifelse(abs(loadings_table_v2[, i]) < 0.3, "", as.character(loadings_table_v2[, i]))
}
display_table_F2$Group <- apply(abs(loadings_raw_v2), 1, which.max)
display_table_F2 <- display_table_F2[order(display_table_F2$Group, -apply(abs(loadings_raw_v2), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_F2[, !(names(display_table_F2) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_F5 1.064 0.847 1.121 0.802
## R_F4 0.943 0.760 1.032 0.823
## R_F7 0.923 0.832 1.001 0.906
## R_F6 0.837 0.804 1.023 0.747
## R_F8 0.801 0.735 1.022 0.718
## R_F3 0.792 0.596 1.003 0.760
## R_F9 0.69 0.741 1.233 0.453
## R_F1 0.439 0.423 1.682 0.164
## R_F2 0.711 0.341 1.252 0.457
## R_F14 0.622 0.478 1.054 0.520
## R_F11 0.607 0.650 1.380 0.337
## R_F12 0.393 0.531 0.701 1.842 0.138cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_F_v2$Vaccounted, 3))## PA1 PA2
## SS loadings 5.974 1.934
## Proportion Var 0.498 0.161
## Cumulative Var 0.498 0.659
## Proportion Explained 0.755 0.245
## Cumulative Proportion 0.755 1.000# ==============================================================================
# BƯỚC 2.3 (DOMAIN F): LOẠI TIẾP R_F12 (CROSS-LOADING NẶNG NHẤT) VÀ CHẠY LẠI
# ==============================================================================
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI F13, F10, F12 (CÒN 11 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI F13, F10, F12 (CÒN 11 CÂU) ---data_F_drop12 <- data_F_drop10[, !(names(data_F_drop10) %in% c("R_F12"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI F12 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI F12 ---pa_F_v3 <- fa.parallel(data_F_drop12, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain F (Đã loại F13, F10, F12)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_F_v3$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2cat("\n--- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F12) ---\n")##
## --- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F12) ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_F_v3 <- fa(data_F_drop12, nfactors = pa_F_v3$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_v3 <- as.data.frame(unclass(efa_F_v3$loadings))
loadings_table_v3 <- round(loadings_raw_v3, 3)
loadings_table_v3$Communality <- round(efa_F_v3$communality, 3)
loadings_table_v3$Complexity <- round(efa_F_v3$complexity, 3)
# Tính Difference
if(pa_F_v3$nfact > 1) {
loadings_table_v3$Difference <- apply(loadings_raw_v3, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_F3 <- loadings_table_v3
for(i in 1:pa_F_v3$nfact) {
display_table_F3[, i] <- ifelse(abs(loadings_table_v3[, i]) < 0.3, "", as.character(loadings_table_v3[, i]))
}
display_table_F3$Group <- apply(abs(loadings_raw_v3), 1, which.max)
display_table_F3 <- display_table_F3[order(display_table_F3$Group, -apply(abs(loadings_raw_v3), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_F3[, !(names(display_table_F3) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_F5 1.047 0.842 1.132 0.777
## R_F4 0.936 0.760 1.033 0.816
## R_F7 0.93 0.835 1.002 0.901
## R_F6 0.858 0.809 1.013 0.789
## R_F8 0.807 0.752 1.030 0.708
## R_F3 0.802 0.593 1.011 0.743
## R_F9 0.733 0.732 1.130 0.546
## R_F1 0.481 0.422 1.468 0.241
## R_F2 0.767 0.436 1.182 0.534
## R_F14 0.629 0.527 1.112 0.480
## R_F11 0.405 0.424 0.542 1.996 0.018cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_F_v3$Vaccounted, 3))## PA1 PA2
## SS loadings 5.882 1.367
## Proportion Var 0.535 0.124
## Cumulative Var 0.535 0.659
## Proportion Explained 0.811 0.189
## Cumulative Proportion 0.811 1.000# ==============================================================================
# BƯỚC 2.4 (DOMAIN F): LOẠI TIẾP R_F11 (CROSS-LOADING NẶNG NHẤT) VÀ CHẠY LẠI
# ==============================================================================
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI F13, F10, F12, F11 (CÒN 10 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI F13, F10, F12, F11 (CÒN 10 CÂU) ---data_F_drop11 <- data_F_drop12[, !(names(data_F_drop12) %in% c("R_F11"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI F11 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI F11 ---pa_F_v4 <- fa.parallel(data_F_drop11, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain F (Đã loại 4 câu)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_F_v4$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2cat("\n--- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F11) ---\n")##
## --- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F11) ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_F_v4 <- fa(data_F_drop11, nfactors = pa_F_v4$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_v4 <- as.data.frame(unclass(efa_F_v4$loadings))
loadings_table_v4 <- round(loadings_raw_v4, 3)
loadings_table_v4$Communality <- round(efa_F_v4$communality, 3)
loadings_table_v4$Complexity <- round(efa_F_v4$complexity, 3)
# Tính Difference
if(pa_F_v4$nfact > 1) {
loadings_table_v4$Difference <- apply(loadings_raw_v4, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_F4 <- loadings_table_v4
for(i in 1:pa_F_v4$nfact) {
display_table_F4[, i] <- ifelse(abs(loadings_table_v4[, i]) < 0.3, "", as.character(loadings_table_v4[, i]))
}
display_table_F4$Group <- apply(abs(loadings_raw_v4), 1, which.max)
display_table_F4 <- display_table_F4[order(display_table_F4$Group, -apply(abs(loadings_raw_v4), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_F4[, !(names(display_table_F4) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_F5 1.021 0.840 1.119 0.771
## R_F7 0.926 0.835 1.001 0.902
## R_F4 0.924 0.761 1.028 0.815
## R_F6 0.865 0.802 1.008 0.810
## R_F8 0.811 0.758 1.035 0.703
## R_F3 0.794 0.593 1.008 0.745
## R_F9 0.747 0.733 1.119 0.565
## R_F1 0.501 0.418 1.385 0.277
## R_F2 0.752 0.457 1.114 0.572
## R_F14 0.592 0.517 1.236 0.387cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_F_v4$Vaccounted, 3))## PA1 PA2
## SS loadings 5.648 1.066
## Proportion Var 0.565 0.107
## Cumulative Var 0.565 0.671
## Proportion Explained 0.841 0.159
## Cumulative Proportion 0.841 1.000Ép Domain F còn lại về 1 factor và đánh giá
# ==============================================================================
# BƯỚC 2.5 (DOMAIN F): ÉP MÔ HÌNH VỀ 1 NHÂN TỐ (OVERRIDE PA) VÌ PA2 CHỈ CÓ 2 CÂU
# ==============================================================================
library(psych)
cat("\n--- 1. CHẠY LẠI EFA CHO 10 CÂU (ÉP CỨNG 1 NHÂN TỐ) ---\n")##
## --- 1. CHẠY LẠI EFA CHO 10 CÂU (ÉP CỨNG 1 NHÂN TỐ) ---# Ép cứng nfactors = 1
efa_F_force1 <- fa(data_F_drop11, nfactors = 1, cor = "poly", fm = "pa", rotate = "promax")
# 2. Trích xuất và định dạng bảng kết quả
loadings_raw_f1 <- as.data.frame(unclass(efa_F_force1$loadings))
loadings_table_f1 <- round(loadings_raw_f1, 3)
loadings_table_f1$Communality <- round(efa_F_force1$communality, 3)
loadings_table_f1$Complexity <- round(efa_F_force1$complexity, 3)
# 3. Ẩn loading < 0.3 và sắp xếp
display_table_f1 <- loadings_table_f1
# Chỉ có 1 cột nhân tố (PA1) nên ta ẩn giá trị < 0.3 trên cột 1
display_table_f1[, 1] <- ifelse(abs(loadings_table_f1[, 1]) < 0.3, "", as.character(loadings_table_f1[, 1]))
# Sắp xếp giảm dần theo hệ số tải của PA1
display_table_f1 <- display_table_f1[order(-abs(loadings_raw_f1[, 1])), , drop = FALSE]
# 4. IN BẢNG KẾT QUẢ
print(display_table_f1, quote = FALSE)## PA1 Communality Complexity
## R_F7 0.911 0.829 1
## R_F6 0.898 0.807 1
## R_F8 0.874 0.764 1
## R_F5 0.858 0.736 1
## R_F4 0.855 0.731 1
## R_F9 0.854 0.729 1
## R_F3 0.763 0.583 1
## R_F1 0.63 0.398 1
## R_F14 0.532 0.283 1
## R_F2 0.061 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (MÔ HÌNH ÉP 1 NHÂN TỐ) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (MÔ HÌNH ÉP 1 NHÂN TỐ) ---print(round(efa_F_force1$Vaccounted, 3))## PA1
## SS loadings 5.919
## Proportion Var 0.592# ==============================================================================
# BƯỚC 2.6 (PHƯƠNG ÁN THỬ NGHIỆM): LOẠI R_F14 TRƯỚC VÀ CHẠY LẠI KIỂM TRA
# ==============================================================================
library(psych)
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI F13, F10, F12, F11 VÀ F14 (CÒN 9 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI F13, F10, F12, F11 VÀ F14 (CÒN 9 CÂU) ---# Tập nguồn là data_F_drop11 (chứa 10 câu trước khi ép 1 nhân tố)
data_F_drop14 <- data_F_drop11[, !(names(data_F_drop11) %in% c("R_F14"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI F14 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI F14 ---pa_F_alt <- fa.parallel(data_F_drop14, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain F (Đã loại F14)")
## Parallel analysis suggests that the number of factors = 1 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_F_alt$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 1cat("\n--- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F14) ---\n")##
## --- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI F14) ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_F_alt <- fa(data_F_drop14, nfactors = pa_F_alt$nfact, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_alt <- as.data.frame(unclass(efa_F_alt$loadings))
loadings_table_alt <- round(loadings_raw_alt, 3)
loadings_table_alt$Communality <- round(efa_F_alt$communality, 3)
loadings_table_alt$Complexity <- round(efa_F_alt$complexity, 3)
# Tính Difference nếu số nhân tố > 1
if(pa_F_alt$nfact > 1) {
loadings_table_alt$Difference <- apply(loadings_raw_alt, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_alt <- loadings_table_alt
for(i in 1:pa_F_alt$nfact) {
display_table_alt[, i] <- ifelse(abs(loadings_table_alt[, i]) < 0.3, "", as.character(loadings_table_alt[, i]))
}
display_table_alt$Group <- apply(abs(loadings_raw_alt), 1, which.max)
display_table_alt <- display_table_alt[order(display_table_alt$Group, -apply(abs(loadings_raw_alt), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_alt[, !(names(display_table_alt) %in% "Group")], quote = FALSE)## PA1 Communality Complexity
## R_F7 0.915 0.838 1
## R_F6 0.893 0.797 1
## R_F5 0.875 0.765 1
## R_F8 0.873 0.762 1
## R_F4 0.855 0.731 1
## R_F9 0.846 0.716 1
## R_F3 0.773 0.597 1
## R_F1 0.623 0.389 1
## R_F2 0.046 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_F_alt$Vaccounted, 3))## PA1
## SS loadings 5.641
## Proportion Var 0.627# ==============================================================================
# BƯỚC 2.7 (DOMAIN F): Model cuối cùng LOẠI BỎ R_F2
# ==============================================================================
cat("\n--- 1. TẠO TẬP DỮ LIỆU 8 CÂU CUỐI CÙNG (LOẠI F13, 10, 12, 11, 14, 2) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU 8 CÂU CUỐI CÙNG (LOẠI F13, 10, 12, 11, 14, 2) ---data_F_final <- data_F_drop14[, !(names(data_F_drop14) %in% c("R_F2"))]
cat("\n--- 2. CHẠY LẠI PA KIỂM CHỨNG LẦN CUỐI ---\n")##
## --- 2. CHẠY LẠI PA KIỂM CHỨNG LẦN CUỐI ---pa_F_final <- fa.parallel(data_F_final, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain F (8 items)")
## Parallel analysis suggests that the number of factors = 1 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_F_final$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 1cat("\n--- 3. KẾT QUẢ EFA ---\n")##
## --- 3. KẾT QUẢ EFA ---# Chạy EFA 1 nhân tố cho 8 câu
efa_F_final <- fa(data_F_final, nfactors = 1, cor = "poly", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_final <- as.data.frame(unclass(efa_F_final$loadings))
loadings_table_final <- round(loadings_raw_final, 3)
loadings_table_final$Communality <- round(efa_F_final$communality, 3)
loadings_table_final$Complexity <- round(efa_F_final$complexity, 3)
# Sắp xếp giảm dần theo hệ số tải
display_table_final <- loadings_table_final[order(-abs(loadings_raw_final[, 1])), , drop = FALSE]
# IN BẢNG KẾT QUẢ
print(display_table_final, quote = FALSE)## PA1 Communality Complexity
## R_F7 0.917 0.841 1
## R_F6 0.892 0.796 1
## R_F5 0.881 0.775 1
## R_F8 0.870 0.756 1
## R_F4 0.860 0.740 1
## R_F9 0.842 0.709 1
## R_F3 0.772 0.596 1
## R_F1 0.617 0.381 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH CUỐI CÙNG ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH CUỐI CÙNG ---print(round(efa_F_final$Vaccounted, 3))## PA1
## SS loadings 5.595
## Proportion Var 0.699# ==============================================================================
# BƯỚC 3 (DOMAIN F): CHẠY CFA CHO MÔ HÌNH 1 NHÂN TỐ (8 ITEMS)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 1 NHÂN TỐ CHO DOMAIN F ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 1 NHÂN TỐ CHO DOMAIN F ---# Định nghĩa cấu trúc 1 nhân tố dựa trên kết quả EFA chốt hạ
model_F_final <- '
# Nhân tố F (8 câu)
Frequency =~ R_F1 + R_F3 + R_F4 + R_F5 + R_F6 + R_F7 + R_F8 + R_F9
'
# Chạy thuật toán CFA (Vẫn dùng WLSMV vì là dữ liệu Likert/Ordinal)
fit_F_final <- cfa(model_F_final,
data = data_F_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---summary(fit_F_final, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 25 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 40
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 71.491 154.652
## Degrees of freedom 20 20
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.477
## Shift parameter 4.926
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 17974.275 7986.515
## Degrees of freedom 28 28
## P-value NA 0.000
## Scaling correction factor 2.255
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.997 0.983
## Tucker-Lewis Index (TLI) 0.996 0.976
##
## Robust Comparative Fit Index (CFI) 0.920
## Robust Tucker-Lewis Index (TLI) 0.888
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.108 0.175
## 90 Percent confidence interval - lower 0.082 0.150
## 90 Percent confidence interval - upper 0.136 0.202
## P-value H_0: RMSEA <= 0.050 0.000 0.000
## P-value H_0: RMSEA >= 0.080 0.961 1.000
##
## Robust RMSEA 0.174
## 90 Percent confidence interval - lower 0.149
## 90 Percent confidence interval - upper 0.201
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.046 0.046
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Frequency =~
## R_F1 1.000 0.688 0.688
## R_F3 0.988 0.059 16.668 0.000 0.679 0.679
## R_F4 1.284 0.065 19.714 0.000 0.883 0.883
## R_F5 1.268 0.066 19.165 0.000 0.872 0.872
## R_F6 1.334 0.067 19.829 0.000 0.918 0.918
## R_F7 1.302 0.064 20.424 0.000 0.896 0.896
## R_F8 1.269 0.065 19.413 0.000 0.873 0.873
## R_F9 1.219 0.061 19.973 0.000 0.838 0.838
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_F1|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F1|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F1|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_F1|t4 1.795 0.159 11.311 0.000 1.795 1.795
## R_F3|t1 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_F3|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F3|t3 0.632 0.091 6.936 0.000 0.632 0.632
## R_F3|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F4|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F4|t2 0.000 0.085 0.000 1.000 0.000 0.000
## R_F4|t3 0.763 0.094 8.092 0.000 0.763 0.763
## R_F4|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F5|t1 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_F5|t2 0.160 0.085 1.883 0.060 0.160 0.160
## R_F5|t3 0.810 0.096 8.469 0.000 0.810 0.810
## R_F5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F6|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F6|t2 -0.114 0.085 -1.345 0.179 -0.114 -0.114
## R_F6|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F6|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_F7|t1 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_F7|t2 -0.034 0.085 -0.404 0.687 -0.034 -0.034
## R_F7|t3 0.778 0.095 8.218 0.000 0.778 0.778
## R_F7|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F8|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_F8|t2 -0.230 0.086 -2.688 0.007 -0.230 -0.230
## R_F8|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F8|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F9|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_F9|t2 -0.277 0.086 -3.225 0.001 -0.277 -0.277
## R_F9|t3 0.591 0.090 6.545 0.000 0.591 0.591
## R_F9|t4 1.922 0.175 10.979 0.000 1.922 1.922
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_F1 0.527 0.527 0.527
## .R_F3 0.538 0.538 0.538
## .R_F4 0.220 0.220 0.220
## .R_F5 0.239 0.239 0.239
## .R_F6 0.158 0.158 0.158
## .R_F7 0.198 0.198 0.198
## .R_F8 0.238 0.238 0.238
## .R_F9 0.297 0.297 0.297
## Frequency 0.473 0.048 9.783 0.000 1.000 1.000cat("\n--- 3. (MODIFICATION INDICES) ---\n")##
## --- 3. (MODIFICATION INDICES) ---mi_F <- modindices(fit_F_final)
mi_F_res <- mi_F[mi_F$op == "~~", ]
# In ra top 5 cặp có MI cao nhất để xem có cần nối Stent không
print(head(mi_F_res[order(-mi_F_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 80 R_F4 ~~ R_F5 15.152 0.111 0.111 0.484 0.484
## 94 R_F8 ~~ R_F9 13.111 0.109 0.109 0.410 0.410
## 74 R_F3 ~~ R_F4 11.109 0.125 0.125 0.362 0.362
## 87 R_F5 ~~ R_F8 8.351 -0.104 -0.104 -0.437 -0.437
## 73 R_F1 ~~ R_F9 6.628 0.115 0.115 0.291 0.291# ==============================================================================
# BƯỚC 3.1 (DOMAIN F): CHẠY CFA 8 CÂU (ĐẶT 2 ỐNG STENT THEO CƠ SỞ LÝ LUẬN)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 8 CÂU (NỐI 2 CẶP PHẦN DƯ) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 8 CÂU (NỐI 2 CẶP PHẦN DƯ) ---model_F_final_adj <- '
# Nhân tố cốt lõi (8 câu)
Factor_F =~ R_F1 + R_F3 + R_F4 + R_F5 + R_F6 + R_F7 + R_F8 + R_F9
# Đặt 2 ống stent giải tỏa áp lực dựa trên MI và sự tương đồng ý nghĩa
R_F4 ~~ R_F5
R_F8 ~~ R_F9
'
fit_F_final_adj <- cfa(model_F_final_adj,
data = data_F_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI ĐẶT STENT ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI ĐẶT STENT ---summary(fit_F_final_adj, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 28 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 42
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 45.675 107.938
## Degrees of freedom 18 18
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.439
## Shift parameter 3.825
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 17974.275 7986.515
## Degrees of freedom 28 28
## P-value NA 0.000
## Scaling correction factor 2.255
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.998 0.989
## Tucker-Lewis Index (TLI) 0.998 0.982
##
## Robust Comparative Fit Index (CFI) 0.951
## Robust Tucker-Lewis Index (TLI) 0.923
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.084 0.151
## 90 Percent confidence interval - lower 0.054 0.124
## 90 Percent confidence interval - upper 0.114 0.179
## P-value H_0: RMSEA <= 0.050 0.033 0.000
## P-value H_0: RMSEA >= 0.080 0.611 1.000
##
## Robust RMSEA 0.144
## 90 Percent confidence interval - lower 0.117
## 90 Percent confidence interval - upper 0.173
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.040 0.040
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_F =~
## R_F1 1.000 0.694 0.694
## R_F3 0.990 0.060 16.638 0.000 0.687 0.687
## R_F4 1.238 0.063 19.551 0.000 0.859 0.859
## R_F5 1.219 0.064 19.074 0.000 0.846 0.846
## R_F6 1.339 0.068 19.786 0.000 0.929 0.929
## R_F7 1.304 0.064 20.422 0.000 0.905 0.905
## R_F8 1.235 0.064 19.365 0.000 0.857 0.857
## R_F9 1.177 0.060 19.545 0.000 0.817 0.817
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_F4 ~~
## .R_F5 0.101 0.020 5.157 0.000 0.101 0.371
## .R_F8 ~~
## .R_F9 0.099 0.021 4.714 0.000 0.099 0.331
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_F1|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F1|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F1|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_F1|t4 1.795 0.159 11.311 0.000 1.795 1.795
## R_F3|t1 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_F3|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F3|t3 0.632 0.091 6.936 0.000 0.632 0.632
## R_F3|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F4|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F4|t2 0.000 0.085 0.000 1.000 0.000 0.000
## R_F4|t3 0.763 0.094 8.092 0.000 0.763 0.763
## R_F4|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F5|t1 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_F5|t2 0.160 0.085 1.883 0.060 0.160 0.160
## R_F5|t3 0.810 0.096 8.469 0.000 0.810 0.810
## R_F5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F6|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F6|t2 -0.114 0.085 -1.345 0.179 -0.114 -0.114
## R_F6|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F6|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_F7|t1 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_F7|t2 -0.034 0.085 -0.404 0.687 -0.034 -0.034
## R_F7|t3 0.778 0.095 8.218 0.000 0.778 0.778
## R_F7|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F8|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_F8|t2 -0.230 0.086 -2.688 0.007 -0.230 -0.230
## R_F8|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F8|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F9|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_F9|t2 -0.277 0.086 -3.225 0.001 -0.277 -0.277
## R_F9|t3 0.591 0.090 6.545 0.000 0.591 0.591
## R_F9|t4 1.922 0.175 10.979 0.000 1.922 1.922
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_F1 0.519 0.519 0.519
## .R_F3 0.528 0.528 0.528
## .R_F4 0.263 0.263 0.263
## .R_F5 0.285 0.285 0.285
## .R_F6 0.137 0.137 0.137
## .R_F7 0.181 0.181 0.181
## .R_F8 0.266 0.266 0.266
## .R_F9 0.333 0.333 0.333
## Factor_F 0.481 0.049 9.842 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES CÒN LẠI) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES CÒN LẠI) ---mi_F_adj <- modindices(fit_F_final_adj)
mi_F_adj_res <- mi_F_adj[mi_F_adj$op == "~~", ]
print(head(mi_F_adj_res[order(-mi_F_adj_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 76 R_F3 ~~ R_F4 14.010 0.142 0.142 0.380 0.380
## 75 R_F1 ~~ R_F9 8.242 0.129 0.129 0.311 0.311
## 86 R_F5 ~~ R_F6 4.504 0.067 0.067 0.341 0.341
## 77 R_F3 ~~ R_F5 4.440 0.089 0.089 0.231 0.231
## 80 R_F3 ~~ R_F8 4.191 -0.087 -0.087 -0.233 -0.233# ==============================================================================
# BƯỚC 3.2 (DOMAIN F): CFA 8 CÂU (NỐI 3 CẶP: F4-F5, F8-F9, F3-F4)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 8 CÂU (3 ỐNG STENT) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 8 CÂU (3 ỐNG STENT) ---model_F_final_adj2 <- '
# Nhân tố cốt lõi (8 câu)
Factor_F =~ R_F1 + R_F3 + R_F4 + R_F5 + R_F6 + R_F7 + R_F8 + R_F9
# Giải tỏa áp lực nhóm kỹ năng chuyên sâu và thực hành
R_F4 ~~ R_F5
R_F8 ~~ R_F9
R_F3 ~~ R_F4
'
fit_F_final_adj2 <- cfa(model_F_final_adj2,
data = data_F_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---summary(fit_F_final_adj2, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 29 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 43
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 31.589 79.216
## Degrees of freedom 17 17
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.416
## Shift parameter 3.355
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 17974.275 7986.515
## Degrees of freedom 28 28
## P-value NA 0.000
## Scaling correction factor 2.255
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.999 0.992
## Tucker-Lewis Index (TLI) 0.999 0.987
##
## Robust Comparative Fit Index (CFI) 0.959
## Robust Tucker-Lewis Index (TLI) 0.932
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.063 0.129
## 90 Percent confidence interval - lower 0.026 0.101
## 90 Percent confidence interval - upper 0.096 0.159
## P-value H_0: RMSEA <= 0.050 0.246 0.000
## P-value H_0: RMSEA >= 0.080 0.215 0.998
##
## Robust RMSEA 0.136
## 90 Percent confidence interval - lower 0.106
## 90 Percent confidence interval - upper 0.166
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 0.999
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.034 0.034
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_F =~
## R_F1 1.000 0.697 0.697
## R_F3 0.939 0.061 15.361 0.000 0.654 0.654
## R_F4 1.204 0.064 18.955 0.000 0.839 0.839
## R_F5 1.213 0.064 19.002 0.000 0.845 0.845
## R_F6 1.337 0.068 19.782 0.000 0.932 0.932
## R_F7 1.300 0.064 20.400 0.000 0.906 0.906
## R_F8 1.235 0.064 19.347 0.000 0.861 0.861
## R_F9 1.179 0.060 19.535 0.000 0.822 0.822
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_F4 ~~
## .R_F5 0.118 0.021 5.620 0.000 0.118 0.407
## .R_F8 ~~
## .R_F9 0.091 0.021 4.313 0.000 0.091 0.313
## .R_F3 ~~
## .R_F4 0.142 0.027 5.247 0.000 0.142 0.344
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_F1|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F1|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F1|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_F1|t4 1.795 0.159 11.311 0.000 1.795 1.795
## R_F3|t1 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_F3|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F3|t3 0.632 0.091 6.936 0.000 0.632 0.632
## R_F3|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F4|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F4|t2 0.000 0.085 0.000 1.000 0.000 0.000
## R_F4|t3 0.763 0.094 8.092 0.000 0.763 0.763
## R_F4|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F5|t1 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_F5|t2 0.160 0.085 1.883 0.060 0.160 0.160
## R_F5|t3 0.810 0.096 8.469 0.000 0.810 0.810
## R_F5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F6|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F6|t2 -0.114 0.085 -1.345 0.179 -0.114 -0.114
## R_F6|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F6|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_F7|t1 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_F7|t2 -0.034 0.085 -0.404 0.687 -0.034 -0.034
## R_F7|t3 0.778 0.095 8.218 0.000 0.778 0.778
## R_F7|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F8|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_F8|t2 -0.230 0.086 -2.688 0.007 -0.230 -0.230
## R_F8|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F8|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F9|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_F9|t2 -0.277 0.086 -3.225 0.001 -0.277 -0.277
## R_F9|t3 0.591 0.090 6.545 0.000 0.591 0.591
## R_F9|t4 1.922 0.175 10.979 0.000 1.922 1.922
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_F1 0.514 0.514 0.514
## .R_F3 0.572 0.572 0.572
## .R_F4 0.296 0.296 0.296
## .R_F5 0.285 0.285 0.285
## .R_F6 0.131 0.131 0.131
## .R_F7 0.179 0.179 0.179
## .R_F8 0.259 0.259 0.259
## .R_F9 0.325 0.325 0.325
## Factor_F 0.486 0.049 9.837 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES CÒN LẠI) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES CÒN LẠI) ---mi_F_adj2 <- modindices(fit_F_final_adj2)
mi_F_adj2_res <- mi_F_adj2[mi_F_adj2$op == "~~", ]
print(head(mi_F_adj2_res[order(-mi_F_adj2_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 77 R_F3 ~~ R_F5 8.937 0.129 0.129 0.320 0.320
## 76 R_F1 ~~ R_F9 7.323 0.122 0.122 0.300 0.300
## 86 R_F5 ~~ R_F6 4.021 0.064 0.064 0.329 0.329
## 72 R_F1 ~~ R_F5 3.873 -0.100 -0.100 -0.261 -0.261
## 88 R_F5 ~~ R_F8 2.886 -0.063 -0.063 -0.233 -0.233# ==============================================================================
# BƯỚC 3.3 (DOMAIN F): CHẠY CFA 7 CÂU (QUYẾT ĐỊNH MẠNH TAY: LOẠI BỎ R_F4)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 7 CÂU (KHÔNG CÓ F4, CHƯA NỐI STENT) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 7 CÂU (KHÔNG CÓ F4, CHƯA NỐI STENT) ---# Định nghĩa cấu trúc 1 nhân tố với 7 câu còn lại
model_F_7items <- '
Factor_F =~ R_F1 + R_F3 + R_F5 + R_F6 + R_F7 + R_F8 + R_F9
'
fit_F_7items <- cfa(model_F_7items,
data = data_F_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP CỦA MÔ HÌNH 7 CÂU ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP CỦA MÔ HÌNH 7 CÂU ---summary(fit_F_7items, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 24 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 35
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 39.217 90.998
## Degrees of freedom 14 14
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.445
## Shift parameter 2.794
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 12889.058 6378.306
## Degrees of freedom 21 21
## P-value NA 0.000
## Scaling correction factor 2.024
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.998 0.988
## Tucker-Lewis Index (TLI) 0.997 0.982
##
## Robust Comparative Fit Index (CFI) 0.943
## Robust Tucker-Lewis Index (TLI) 0.915
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.091 0.158
## 90 Percent confidence interval - lower 0.058 0.128
## 90 Percent confidence interval - upper 0.125 0.190
## P-value H_0: RMSEA <= 0.050 0.023 0.000
## P-value H_0: RMSEA >= 0.080 0.727 1.000
##
## Robust RMSEA 0.156
## 90 Percent confidence interval - lower 0.127
## 90 Percent confidence interval - upper 0.188
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.041 0.041
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_F =~
## R_F1 1.000 0.698 0.698
## R_F3 0.932 0.061 15.173 0.000 0.650 0.650
## R_F5 1.206 0.064 18.942 0.000 0.842 0.842
## R_F6 1.328 0.066 20.102 0.000 0.927 0.927
## R_F7 1.296 0.064 20.372 0.000 0.905 0.905
## R_F8 1.261 0.065 19.377 0.000 0.880 0.880
## R_F9 1.206 0.060 20.130 0.000 0.841 0.841
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_F1|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F1|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F1|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_F1|t4 1.795 0.159 11.311 0.000 1.795 1.795
## R_F3|t1 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_F3|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F3|t3 0.632 0.091 6.936 0.000 0.632 0.632
## R_F3|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F5|t1 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_F5|t2 0.160 0.085 1.883 0.060 0.160 0.160
## R_F5|t3 0.810 0.096 8.469 0.000 0.810 0.810
## R_F5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F6|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F6|t2 -0.114 0.085 -1.345 0.179 -0.114 -0.114
## R_F6|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F6|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_F7|t1 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_F7|t2 -0.034 0.085 -0.404 0.687 -0.034 -0.034
## R_F7|t3 0.778 0.095 8.218 0.000 0.778 0.778
## R_F7|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F8|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_F8|t2 -0.230 0.086 -2.688 0.007 -0.230 -0.230
## R_F8|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F8|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F9|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_F9|t2 -0.277 0.086 -3.225 0.001 -0.277 -0.277
## R_F9|t3 0.591 0.090 6.545 0.000 0.591 0.591
## R_F9|t4 1.922 0.175 10.979 0.000 1.922 1.922
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_F1 0.513 0.513 0.513
## .R_F3 0.577 0.577 0.577
## .R_F5 0.291 0.291 0.291
## .R_F6 0.141 0.141 0.141
## .R_F7 0.182 0.182 0.182
## .R_F8 0.226 0.226 0.226
## .R_F9 0.292 0.292 0.292
## Factor_F 0.487 0.050 9.835 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---mi_F_7 <- modindices(fit_F_7items)
mi_F_7_res <- mi_F_7[mi_F_7$op == "~~", ]
print(head(mi_F_7_res[order(-mi_F_7_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 79 R_F8 ~~ R_F9 11.169 0.107 0.107 0.416 0.416
## 65 R_F3 ~~ R_F5 9.924 0.136 0.136 0.331 0.331
## 70 R_F5 ~~ R_F6 6.398 0.082 0.082 0.403 0.403
## 64 R_F1 ~~ R_F9 5.445 0.107 0.107 0.276 0.276
## 76 R_F6 ~~ R_F9 5.361 -0.082 -0.082 -0.406 -0.406# ==============================================================================
# BƯỚC 3.4 (DOMAIN F): CFA 7 CÂU (ĐẶT 2 STENT CHO F8-F9 VÀ F3-F5)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 7 CÂU (ĐẶT 2 ỐNG STENT) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 7 CÂU (ĐẶT 2 ỐNG STENT) ---model_F_7items_adj <- '
# Nhân tố cốt lõi (7 câu)
Factor_F =~ R_F1 + R_F3 + R_F5 + R_F6 + R_F7 + R_F8 + R_F9
# Stent 1: Kỹ năng ứng dụng lâm sàng
R_F8 ~~ R_F9
# Stent 2: Kỹ năng hàn lâm / nghiên cứu
R_F3 ~~ R_F5
'
fit_F_7items_adj <- cfa(model_F_7items_adj,
data = data_F_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP CỦA MÔ HÌNH CHỐT HẠ ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP CỦA MÔ HÌNH CHỐT HẠ ---summary(fit_F_7items_adj, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 23 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 37
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 19.172 50.215
## Degrees of freedom 12 12
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.400
## Shift parameter 2.338
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 12889.058 6378.306
## Degrees of freedom 21 21
## P-value NA 0.000
## Scaling correction factor 2.024
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.999 0.994
## Tucker-Lewis Index (TLI) 0.999 0.989
##
## Robust Comparative Fit Index (CFI) 0.972
## Robust Tucker-Lewis Index (TLI) 0.951
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.052 0.121
## 90 Percent confidence interval - lower 0.000 0.087
## 90 Percent confidence interval - upper 0.094 0.156
## P-value H_0: RMSEA <= 0.050 0.420 0.000
## P-value H_0: RMSEA >= 0.080 0.152 0.976
##
## Robust RMSEA 0.119
## 90 Percent confidence interval - lower 0.086
## 90 Percent confidence interval - upper 0.155
## P-value H_0: Robust RMSEA <= 0.050 0.001
## P-value H_0: Robust RMSEA >= 0.080 0.973
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.031 0.031
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_F =~
## R_F1 1.000 0.704 0.704
## R_F3 0.893 0.064 14.045 0.000 0.628 0.628
## R_F5 1.184 0.064 18.552 0.000 0.833 0.833
## R_F6 1.329 0.066 20.054 0.000 0.936 0.936
## R_F7 1.298 0.064 20.304 0.000 0.914 0.914
## R_F8 1.220 0.063 19.404 0.000 0.859 0.859
## R_F9 1.153 0.059 19.685 0.000 0.812 0.812
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_F8 ~~
## .R_F9 0.101 0.021 4.753 0.000 0.101 0.338
## .R_F3 ~~
## .R_F5 0.128 0.035 3.698 0.000 0.128 0.299
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_F1|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F1|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F1|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_F1|t4 1.795 0.159 11.311 0.000 1.795 1.795
## R_F3|t1 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_F3|t2 -0.137 0.085 -1.614 0.107 -0.137 -0.137
## R_F3|t3 0.632 0.091 6.936 0.000 0.632 0.632
## R_F3|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F5|t1 -0.825 0.096 -8.594 0.000 -0.825 -0.825
## R_F5|t2 0.160 0.085 1.883 0.060 0.160 0.160
## R_F5|t3 0.810 0.096 8.469 0.000 0.810 0.810
## R_F5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F6|t1 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_F6|t2 -0.114 0.085 -1.345 0.179 -0.114 -0.114
## R_F6|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F6|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_F7|t1 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_F7|t2 -0.034 0.085 -0.404 0.687 -0.034 -0.034
## R_F7|t3 0.778 0.095 8.218 0.000 0.778 0.778
## R_F7|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_F8|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_F8|t2 -0.230 0.086 -2.688 0.007 -0.230 -0.230
## R_F8|t3 0.689 0.092 7.454 0.000 0.689 0.689
## R_F8|t4 2.000 0.187 10.716 0.000 2.000 2.000
## R_F9|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_F9|t2 -0.277 0.086 -3.225 0.001 -0.277 -0.277
## R_F9|t3 0.591 0.090 6.545 0.000 0.591 0.591
## R_F9|t4 1.922 0.175 10.979 0.000 1.922 1.922
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_F1 0.505 0.505 0.505
## .R_F3 0.605 0.605 0.605
## .R_F5 0.306 0.306 0.306
## .R_F6 0.125 0.125 0.125
## .R_F7 0.165 0.165 0.165
## .R_F8 0.263 0.263 0.263
## .R_F9 0.341 0.341 0.341
## Factor_F 0.495 0.050 9.856 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (CÒN LẠI) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (CÒN LẠI) ---mi_F_7_adj <- modindices(fit_F_7items_adj)
mi_F_7_adj_res <- mi_F_7_adj[mi_F_7_adj$op == "~~", ]
print(head(mi_F_7_adj_res[order(-mi_F_7_adj_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 66 R_F1 ~~ R_F9 7.849 0.130 0.130 0.312 0.312
## 71 R_F5 ~~ R_F6 7.162 0.090 0.090 0.461 0.461
## 62 R_F1 ~~ R_F5 3.723 -0.099 -0.099 -0.252 -0.252
## 77 R_F6 ~~ R_F9 2.203 -0.056 -0.056 -0.274 -0.274
## 73 R_F5 ~~ R_F8 1.609 -0.048 -0.048 -0.171 -0.171F. Domain W - Analysis
# ==============================================================================
# BƯỚC 1 (DOMAIN W): KIỂM ĐỊNH KMO, BARTLETT VÀ CÁC TIÊU CHÍ SỐ NHÂN TỐ (9 CÂU)
# ==============================================================================
library(psych)
cat("\n--- 1. KIỂM ĐỊNH KMO VÀ BARTLETT CHO DOMAIN W (9 CÂU) ---\n")##
## --- 1. KIỂM ĐỊNH KMO VÀ BARTLETT CHO DOMAIN W (9 CÂU) ---kmo_W <- KMO(data_W_EFA)
print(kmo_W)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = data_W_EFA)
## Overall MSA = 0.9
## MSA for each item =
## R_W1_REV R_W2_REV R_W3_REV R_W4_REV R_W5_REV R_W6_REV R_W7_REV R_W8_REV
## 0.92 0.87 0.90 0.92 0.92 0.91 0.88 0.89
## R_W9_REV
## 0.93bartlett_W <- cortest.bartlett(cor(data_W_EFA), n = nrow(data_W_EFA))
cat("\n=> Bartlett's Test: Chi-square = ", round(bartlett_W$chisq, 3),
" | df = ", bartlett_W$df,
" | p-value = ", bartlett_W$p.value, "\n")##
## => Bartlett's Test: Chi-square = 860.48 | df = 36 | p-value = 2.446615e-157cat("\n--- 2. CÁC TIÊU CHÍ GỢI Ý SỐ NHÂN TỐ (KAISER, VSS, MAP) ---\n")##
## --- 2. CÁC TIÊU CHÍ GỢI Ý SỐ NHÂN TỐ (KAISER, VSS, MAP) ---# Tiêu chí Kaiser (Eigenvalue > 1)
eigen_W <- eigen(cor(data_W_EFA))$values
cat("Các trị số Eigenvalues:\n", round(eigen_W, 3), "\n")## Các trị số Eigenvalues:
## 4.726 0.915 0.758 0.581 0.535 0.452 0.365 0.356 0.312cat("=> Gợi ý Kaiser (Eigenvalue > 1):", sum(eigen_W > 1), "nhân tố\n\n")## => Gợi ý Kaiser (Eigenvalue > 1): 1 nhân tố# Tiêu chí VSS và Velicer's MAP
# Dùng n = 4 vì tổng số câu là 9, không nên thử số nhân tố quá lớn
vss_W <- vss(data_W_EFA, n = 4, fm = "pa", cor = "cor", plot = FALSE)
print(vss_W)##
## Very Simple Structure
## Call: vss(x = data_W_EFA, n = 4, fm = "pa", plot = FALSE, cor = "cor")
## VSS complexity 1 achieves a maximimum of 0.88 with 1 factors
## VSS complexity 2 achieves a maximimum of 0.91 with 2 factors
##
## The Velicer MAP achieves a minimum of 0.03 with 1 factors
## BIC achieves a minimum of -71.67 with 2 factors
## Sample Size adjusted BIC achieves a minimum of -13.84 with 3 factors
##
## Statistics by number of factors
## vss1 vss2 map dof chisq prob sqresid fit RMSEA BIC SABIC complex eChisq
## 1 0.88 0.00 0.032 27 91.9 5.2e-09 2.9 0.88 0.104 -54 31.7 1.0 28.9
## 2 0.54 0.91 0.044 19 30.9 4.1e-02 2.2 0.91 0.053 -72 -11.5 1.6 7.6
## 3 0.41 0.80 0.075 12 12.9 3.8e-01 1.8 0.93 0.018 -52 -13.8 2.0 2.4
## 4 0.37 0.68 0.117 6 6.8 3.4e-01 1.6 0.93 0.024 -26 -6.6 2.3 1.2
## SRMR eCRMS eBIC
## 1 0.0427 0.049 -117
## 2 0.0219 0.030 -95
## 3 0.0122 0.021 -62
## 4 0.0085 0.021 -31cat("\n--- 3. PARALLEL ANALYSIS (PA) ---\n")##
## --- 3. PARALLEL ANALYSIS (PA) ---# Chạy PA để xem số nhân tố tự nhiên
pa_W_v0 <- fa.parallel(data_W_EFA, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain W (Bản gốc 9 câu)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NA# ==============================================================================
# BƯỚC 2 (DOMAIN W): CHẠY EFA VỚI 2 NHÂN TỐ LẦN 1 (THEO GỢI Ý CỦA PA)
#Trong số 9 câu hỏi của Domain W, có những câu mà sinh viên không hề chọn một số đáp án nhất định (Ví dụ: Không có ai chọn mức 1 - "Hoàn toàn không đồng ý" hoặc mức 5 - "Hoàn toàn đồng ý"). Thuật toán tính ma trận tương quan Polychoric (cor = "poly") cực kỳ nhạy cảm và đòi hỏi các biến phải có đủ phổ điểm giống nhau.
# ==============================================================================
library(psych)
cat("\n--- 1. CHẠY EFA CHO DOMAIN W VỚI SỐ NHÂN TỐ = 2 (ĐÃ ĐỔI COR='COR') ---\n")##
## --- 1. CHẠY EFA CHO DOMAIN W VỚI SỐ NHÂN TỐ = 2 (ĐÃ ĐỔI COR='COR') ---# Dùng cor = "cor" để tránh lỗi ma trận Polychoric
efa_W_v1 <- fa(data_W_EFA, nfactors = pa_W_v0$nfact, cor = "cor", fm = "pa", rotate = "promax")
# 2. Trích xuất và định dạng bảng kết quả
loadings_raw_W1 <- as.data.frame(unclass(efa_W_v1$loadings))
loadings_W1 <- round(loadings_raw_W1, 3)
loadings_W1$Communality <- round(efa_W_v1$communality, 3)
loadings_W1$Complexity <- round(efa_W_v1$complexity, 3)
# Tính Difference (Chênh lệch 2 hệ số tải) để soi Cross-loading
if(pa_W_v0$nfact > 1) {
loadings_W1$Difference <- apply(loadings_raw_W1, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# 3. Tạo bảng hiển thị: Ẩn hệ số tải < 0.3
display_W1 <- loadings_W1
for(i in 1:pa_W_v0$nfact) {
display_W1[, i] <- ifelse(abs(loadings_W1[, i]) < 0.3, "", as.character(loadings_W1[, i]))
}
# 4. Sắp xếp các câu theo từng nhóm nhân tố để dễ quan sát
display_W1$Group <- apply(abs(loadings_raw_W1), 1, which.max)
display_W1 <- display_W1[order(display_W1$Group, -apply(abs(loadings_raw_W1), 1, max)), ]
cat("\n--- BẢNG HỆ SỐ TẢI DOMAIN W (2 NHÂN TỐ, ĐÃ ẨN < 0.3) ---\n")##
## --- BẢNG HỆ SỐ TẢI DOMAIN W (2 NHÂN TỐ, ĐÃ ẨN < 0.3) ---print(display_W1[, !(names(display_W1) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_W2_REV 1.01 0.738 1.092 0.793
## R_W1_REV 0.667 0.485 1.007 0.629
## R_W3_REV 0.657 0.535 1.042 0.562
## R_W4_REV 0.305 1.999 0.007
## R_W7_REV 0.862 0.632 1.023 0.770
## R_W8_REV 0.842 0.544 1.061 0.695
## R_W5_REV 0.314 0.522 0.616 1.639 0.208
## R_W6_REV 0.507 0.538 1.529 0.236
## R_W9_REV 0.312 0.369 0.406 1.947 0.056cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (LẦN 1) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (LẦN 1) ---print(round(efa_W_v1$Vaccounted, 3))## PA1 PA2
## SS loadings 2.412 2.387
## Proportion Var 0.268 0.265
## Cumulative Var 0.268 0.533
## Proportion Explained 0.503 0.497
## Cumulative Proportion 0.503 1.000# ==============================================================================
# BƯỚC 2.1 (DOMAIN W): LOẠI BỎ R_W4_REV VÀ CHẠY LẠI
# ==============================================================================
library(psych)
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI R_W4_REV (CÒN 8 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI R_W4_REV (CÒN 8 CÂU) ---data_W_drop4 <- data_W_EFA[, !(names(data_W_EFA) %in% c("R_W4_REV"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI W4 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI W4 ---pa_W_v1 <- fa.parallel(data_W_drop4, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain W (Đã loại W4)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_W_v1$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2cat("\n--- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI W4) ---\n")##
## --- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI W4) ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_W_v1 <- fa(data_W_drop4, nfactors = pa_W_v1$nfact, cor = "cor", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_W_v1 <- as.data.frame(unclass(efa_W_v1$loadings))
loadings_table_W_v1 <- round(loadings_raw_W_v1, 3)
loadings_table_W_v1$Communality <- round(efa_W_v1$communality, 3)
loadings_table_W_v1$Complexity <- round(efa_W_v1$complexity, 3)
# Chỉ tính Difference nếu số nhân tố PA gợi ý > 1
if(pa_W_v1$nfact > 1) {
loadings_table_W_v1$Difference <- apply(loadings_raw_W_v1, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_W1 <- loadings_table_W_v1
for(i in 1:pa_W_v1$nfact) {
display_table_W1[, i] <- ifelse(abs(loadings_table_W_v1[, i]) < 0.3, "", as.character(loadings_table_W_v1[, i]))
}
display_table_W1$Group <- apply(abs(loadings_raw_W_v1), 1, which.max)
display_table_W1 <- display_table_W1[order(display_table_W1$Group, -apply(abs(loadings_raw_W_v1), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_W1[, !(names(display_table_W1) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_W8_REV 0.856 0.566 1.062 0.705
## R_W7_REV 0.807 0.587 1.010 0.750
## R_W5_REV 0.534 0.308 0.622 1.599 0.226
## R_W6_REV 0.524 0.552 1.489 0.256
## R_W9_REV 0.381 0.311 0.415 1.922 0.071
## R_W2_REV 1.004 0.753 1.080 0.804
## R_W3_REV 0.64 0.528 1.061 0.528
## R_W1_REV 0.64 0.471 1.018 0.579cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_W_v1$Vaccounted, 3))## PA1 PA2
## SS loadings 2.262 2.233
## Proportion Var 0.283 0.279
## Cumulative Var 0.283 0.562
## Proportion Explained 0.503 0.497
## Cumulative Proportion 0.503 1.000# ==============================================================================
# BƯỚC 2.2 (DOMAIN W): LOẠI BỎ R_W9_REV (CROSS-LOADING NẶNG NHẤT) VÀ CHẠY LẠI
# ==============================================================================
library(psych)
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI W4 VÀ W9 (CÒN 7 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI W4 VÀ W9 (CÒN 7 CÂU) ---data_W_drop9 <- data_W_drop4[, !(names(data_W_drop4) %in% c("R_W9_REV"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI W9 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI W9 ---pa_W_v2 <- fa.parallel(data_W_drop9, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain W (Đã loại W4, W9)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_W_v2$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2cat("\n--- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI W9) ---\n")##
## --- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI W9) ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_W_v2 <- fa(data_W_drop9, nfactors = pa_W_v2$nfact, cor = "cor", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_W_v2 <- as.data.frame(unclass(efa_W_v2$loadings))
loadings_table_W_v2 <- round(loadings_raw_W_v2, 3)
loadings_table_W_v2$Communality <- round(efa_W_v2$communality, 3)
loadings_table_W_v2$Complexity <- round(efa_W_v2$complexity, 3)
# Chỉ tính Difference nếu số nhân tố PA gợi ý > 1
if(pa_W_v2$nfact > 1) {
loadings_table_W_v2$Difference <- apply(loadings_raw_W_v2, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_W2 <- loadings_table_W_v2
for(i in 1:pa_W_v2$nfact) {
display_table_W2[, i] <- ifelse(abs(loadings_table_W_v2[, i]) < 0.3, "", as.character(loadings_table_W_v2[, i]))
}
display_table_W2$Group <- apply(abs(loadings_raw_W_v2), 1, which.max)
display_table_W2 <- display_table_W2[order(display_table_W2$Group, -apply(abs(loadings_raw_W_v2), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_W2[, !(names(display_table_W2) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_W2_REV 0.971 0.732 1.064 0.797
## R_W1_REV 0.653 0.483 1.015 0.595
## R_W3_REV 0.652 0.538 1.056 0.542
## R_W8_REV 0.85 0.583 1.045 0.722
## R_W7_REV 0.79 0.595 1.002 0.764
## R_W5_REV 0.336 0.516 0.625 1.718 0.180
## R_W6_REV 0.483 0.522 1.650 0.190cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_W_v2$Vaccounted, 3))## PA1 PA2
## SS loadings 2.099 1.980
## Proportion Var 0.300 0.283
## Cumulative Var 0.300 0.583
## Proportion Explained 0.514 0.486
## Cumulative Proportion 0.514 1.000# ==============================================================================
# BƯỚC 2.3 (DOMAIN W): LOẠI BỎ R_W5_REV (CROSS-LOADING NẶNG NHẤT) VÀ CHẠY LẠI
# ==============================================================================
library(psych)
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI W4, W9, W5 (CÒN 6 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI W4, W9, W5 (CÒN 6 CÂU) ---data_W_drop5 <- data_W_drop9[, !(names(data_W_drop9) %in% c("R_W5_REV"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI W5 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI W5 ---pa_W_v3 <- fa.parallel(data_W_drop5, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain W (Đã loại W4, W9, W5)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_W_v3$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2cat("\n--- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI W5) ---\n")##
## --- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI W5) ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_W_v3 <- fa(data_W_drop5, nfactors = pa_W_v3$nfact, cor = "cor", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_W_v3 <- as.data.frame(unclass(efa_W_v3$loadings))
loadings_table_W_v3 <- round(loadings_raw_W_v3, 3)
loadings_table_W_v3$Communality <- round(efa_W_v3$communality, 3)
loadings_table_W_v3$Complexity <- round(efa_W_v3$complexity, 3)
# Chỉ tính Difference nếu số nhân tố PA gợi ý > 1
if(pa_W_v3$nfact > 1) {
loadings_table_W_v3$Difference <- apply(loadings_raw_W_v3, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_W3 <- loadings_table_W_v3
for(i in 1:pa_W_v3$nfact) {
display_table_W3[, i] <- ifelse(abs(loadings_table_W_v3[, i]) < 0.3, "", as.character(loadings_table_W_v3[, i]))
}
display_table_W3$Group <- apply(abs(loadings_raw_W_v3), 1, which.max)
display_table_W3 <- display_table_W3[order(display_table_W3$Group, -apply(abs(loadings_raw_W_v3), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_W3[, !(names(display_table_W3) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_W2_REV 0.983 0.768 1.059 0.814
## R_W1_REV 0.647 0.486 1.023 0.577
## R_W3_REV 0.635 0.516 1.066 0.520
## R_W8_REV 0.819 0.587 1.020 0.738
## R_W7_REV 0.797 0.629 1.000 0.791
## R_W6_REV 0.322 0.442 0.492 1.828 0.120cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_W_v3$Vaccounted, 3))## PA1 PA2
## SS loadings 1.915 1.564
## Proportion Var 0.319 0.261
## Cumulative Var 0.319 0.580
## Proportion Explained 0.550 0.450
## Cumulative Proportion 0.550 1.000# ==============================================================================
# BƯỚC 2.4 (DOMAIN W): LOẠI BỎ R_W6_REV (KẺ GÂY NHIỄU CUỐI CÙNG) VÀ CHẠY LẠI
# ==============================================================================
library(psych)
cat("\n--- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI W4, W9, W5, W6 (CÒN 5 CÂU) ---\n")##
## --- 1. TẠO TẬP DỮ LIỆU ĐÃ LOẠI W4, W9, W5, W6 (CÒN 5 CÂU) ---data_W_drop6 <- data_W_drop5[, !(names(data_W_drop5) %in% c("R_W6_REV"))]
cat("\n--- 2. CHẠY LẠI PA SAU KHI LOẠI W6 ---\n")##
## --- 2. CHẠY LẠI PA SAU KHI LOẠI W6 ---pa_W_v4 <- fa.parallel(data_W_drop6, cor = "cor", fm = "pa", fa = "fa", main = "PA - Domain W (Đã loại 4 câu)")
## Parallel analysis suggests that the number of factors = 2 and the number of components = NAcat("\n=> SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ:", pa_W_v4$nfact, "\n")##
## => SỐ NHÂN TỐ PA ĐỀ XUẤT LÀ: 2cat("\n--- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI W6) ---\n")##
## --- 3. KẾT QUẢ EFA MỚI (SAU KHI LOẠI W6) ---# Chạy lại EFA với số nhân tố PA tự động bắt được
efa_W_v4 <- fa(data_W_drop6, nfactors = pa_W_v4$nfact, cor = "cor", fm = "pa", rotate = "promax")
# Trích xuất và tính toán chỉ số
loadings_raw_W_v4 <- as.data.frame(unclass(efa_W_v4$loadings))
loadings_table_W_v4 <- round(loadings_raw_W_v4, 3)
loadings_table_W_v4$Communality <- round(efa_W_v4$communality, 3)
loadings_table_W_v4$Complexity <- round(efa_W_v4$complexity, 3)
# Chỉ tính Difference nếu số nhân tố PA gợi ý > 1
if(pa_W_v4$nfact > 1) {
loadings_table_W_v4$Difference <- apply(loadings_raw_W_v4, 1, function(x) {
sorted_abs <- sort(abs(x), decreasing = TRUE)
return(round(sorted_abs[1] - sorted_abs[2], 3))
})
}
# Ẩn loading < 0.3 và sắp xếp
display_table_W4 <- loadings_table_W_v4
for(i in 1:pa_W_v4$nfact) {
display_table_W4[, i] <- ifelse(abs(loadings_table_W_v4[, i]) < 0.3, "", as.character(loadings_table_W_v4[, i]))
}
display_table_W4$Group <- apply(abs(loadings_raw_W_v4), 1, which.max)
display_table_W4 <- display_table_W4[order(display_table_W4$Group, -apply(abs(loadings_raw_W_v4), 1, max)), ]
# IN BẢNG KẾT QUẢ
print(display_table_W4[, !(names(display_table_W4) %in% "Group")], quote = FALSE)## PA1 PA2 Communality Complexity Difference
## R_W2_REV 0.973 0.789 1.044 0.828
## R_W3_REV 0.63 0.531 1.103 0.486
## R_W1_REV 0.623 0.460 1.036 0.540
## R_W7_REV 0.827 0.684 1.000 0.827
## R_W8_REV 0.734 0.535 1.000 0.730cat("\n--- TỔNG PHƯƠNG SAI TRÍCH MỚI ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH MỚI ---print(round(efa_W_v4$Vaccounted, 3))## PA1 PA2
## SS loadings 1.729 1.271
## Proportion Var 0.346 0.254
## Cumulative Var 0.346 0.600
## Proportion Explained 0.576 0.424
## Cumulative Proportion 0.576 1.000# ==============================================================================
# BƯỚC 2.5 (DOMAIN W): ÉP MÔ HÌNH VỀ 1 NHÂN TỐ ĐỂ KIỂM TRA W7 VÀ W8
# ==============================================================================
library(psych)
cat("\n--- 1. CHẠY LẠI EFA CHO 5 CÂU (ÉP CỨNG 1 NHÂN TỐ) ---\n")##
## --- 1. CHẠY LẠI EFA CHO 5 CÂU (ÉP CỨNG 1 NHÂN TỐ) ---# Ép cứng nfactors = 1
efa_W_force1 <- fa(data_W_drop6, nfactors = 1, cor = "cor", fm = "pa", rotate = "promax")
# 2. Trích xuất và định dạng bảng kết quả
loadings_raw_W_f1 <- as.data.frame(unclass(efa_W_force1$loadings))
loadings_table_W_f1 <- round(loadings_raw_W_f1, 3)
loadings_table_W_f1$Communality <- round(efa_W_force1$communality, 3)
loadings_table_W_f1$Complexity <- round(efa_W_force1$complexity, 3)
# 3. Ẩn loading < 0.3 và sắp xếp
display_table_W_f1 <- loadings_table_W_f1
# Chỉ có 1 cột nhân tố nên ta ẩn giá trị < 0.3 trên cột 1
display_table_W_f1[, 1] <- ifelse(abs(loadings_table_W_f1[, 1]) < 0.3, "", as.character(loadings_table_W_f1[, 1]))
# Sắp xếp giảm dần theo hệ số tải của PA1
display_table_W_f1 <- display_table_W_f1[order(-abs(loadings_raw_W_f1[, 1])), , drop = FALSE]
# 4. IN BẢNG KẾT QUẢ
print(display_table_W_f1, quote = FALSE)## PA1 Communality Complexity
## R_W3_REV 0.74 0.548 1
## R_W2_REV 0.737 0.543 1
## R_W1_REV 0.674 0.454 1
## R_W7_REV 0.658 0.433 1
## R_W8_REV 0.596 0.355 1cat("\n--- TỔNG PHƯƠNG SAI TRÍCH (MÔ HÌNH ÉP 1 NHÂN TỐ) ---\n")##
## --- TỔNG PHƯƠNG SAI TRÍCH (MÔ HÌNH ÉP 1 NHÂN TỐ) ---print(round(efa_W_force1$Vaccounted, 3))## PA1
## SS loadings 2.333
## Proportion Var 0.467# ==============================================================================
# BƯỚC 3 (DOMAIN W): CHẠY CFA CHO MÔ HÌNH 1 NHÂN TỐ (5 CÂU CHỐT HẠ)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 1 NHÂN TỐ CHO DOMAIN W ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 1 NHÂN TỐ CHO DOMAIN W ---# Định nghĩa cấu trúc 1 nhân tố
model_W_final <- '
# Nhân tố Môi trường/Rào cản (5 câu)
Factor_W =~ R_W1_REV + R_W2_REV + R_W3_REV + R_W7_REV + R_W8_REV
'
# Chạy thuật toán CFA (Dùng WLSMV cho dữ liệu Likert)
fit_W_final <- cfa(model_W_final,
data = data_W_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---summary(fit_W_final, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 16 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 22
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 119.134 209.617
## Degrees of freedom 5 5
## P-value (Unknown) NA 0.000
## Scaling correction factor 0.571
## Shift parameter 0.983
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 1616.881 1077.655
## Degrees of freedom 10 10
## P-value NA 0.000
## Scaling correction factor 1.505
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 0.929 0.808
## Tucker-Lewis Index (TLI) 0.858 0.617
##
## Robust Comparative Fit Index (CFI) 0.723
## Robust Tucker-Lewis Index (TLI) 0.447
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.323 0.432
## 90 Percent confidence interval - lower 0.274 0.383
## 90 Percent confidence interval - upper 0.374 0.483
## P-value H_0: RMSEA <= 0.050 0.000 0.000
## P-value H_0: RMSEA >= 0.080 1.000 1.000
##
## Robust RMSEA 0.336
## 90 Percent confidence interval - lower 0.294
## 90 Percent confidence interval - upper 0.379
## P-value H_0: Robust RMSEA <= 0.050 0.000
## P-value H_0: Robust RMSEA >= 0.080 1.000
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.116 0.116
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_W =~
## R_W1_REV 1.000 0.671 0.671
## R_W2_REV 1.073 0.088 12.144 0.000 0.720 0.720
## R_W3_REV 1.160 0.075 15.478 0.000 0.778 0.778
## R_W7_REV 1.049 0.073 14.311 0.000 0.703 0.703
## R_W8_REV 1.023 0.073 13.976 0.000 0.686 0.686
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_W1_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W1_REV|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_W1_REV|t3 1.161 0.109 10.646 0.000 1.161 1.161
## R_W1_REV|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_W2_REV|t1 -1.691 0.147 -11.477 0.000 -1.691 -1.691
## R_W2_REV|t2 0.137 0.085 1.614 0.107 0.137 0.137
## R_W2_REV|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_W3_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W3_REV|t2 -0.242 0.086 -2.823 0.005 -0.242 -0.242
## R_W3_REV|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_W3_REV|t4 2.609 0.342 7.622 0.000 2.609 2.609
## R_W7_REV|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_W7_REV|t2 -0.325 0.086 -3.760 0.000 -0.325 -0.325
## R_W7_REV|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_W8_REV|t1 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_W8_REV|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_W8_REV|t3 1.645 0.143 11.519 0.000 1.645 1.645
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_W1_REV 0.550 0.550 0.550
## .R_W2_REV 0.482 0.482 0.482
## .R_W3_REV 0.395 0.395 0.395
## .R_W7_REV 0.505 0.505 0.505
## .R_W8_REV 0.530 0.530 0.530
## Factor_W 0.450 0.048 9.320 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MODIFICATION INDICES) ---mi_W <- modindices(fit_W_final)
mi_W_res <- mi_W[mi_W$op == "~~", ]
# In ra top 5 cặp có MI cao nhất để xem có cần nối Stent không
print(head(mi_W_res[order(-mi_W_res$mi), ], 10))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 49 R_W7_REV ~~ R_W8_REV 115.846 0.564 0.564 1.091 1.091
## 48 R_W3_REV ~~ R_W8_REV 27.590 -0.334 -0.334 -0.731 -0.731
## 45 R_W2_REV ~~ R_W7_REV 23.586 -0.329 -0.329 -0.667 -0.667
## 44 R_W2_REV ~~ R_W3_REV 21.764 0.288 0.288 0.661 0.661
## 41 R_W1_REV ~~ R_W3_REV 19.787 0.260 0.260 0.557 0.557
## 47 R_W3_REV ~~ R_W7_REV 19.532 -0.281 -0.281 -0.630 -0.630
## 43 R_W1_REV ~~ R_W8_REV 16.099 -0.231 -0.231 -0.429 -0.429
## 42 R_W1_REV ~~ R_W7_REV 10.215 -0.195 -0.195 -0.369 -0.369
## 46 R_W2_REV ~~ R_W8_REV 8.391 -0.180 -0.180 -0.357 -0.357
## 40 R_W1_REV ~~ R_W2_REV 4.003 0.114 0.114 0.221 0.221# ==============================================================================
# BƯỚC 3.1 (DOMAIN W): CFA 5 CÂU (Nối W7-W8, W2-W3)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 5 CÂU ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 5 CÂU ---model_W_final_adj <- '
# Nhân tố tổng: Môi trường làm việc lâm sàng
Factor_W =~ R_W1_REV + R_W2_REV + R_W3_REV + R_W7_REV + R_W8_REV
R_W7_REV ~~ R_W8_REV
R_W2_REV ~~ R_W3_REV
'
fit_W_final_adj <- cfa(model_W_final_adj,
data = data_W_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI ĐẶT STENT ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP SAU KHI ĐẶT STENT ---summary(fit_W_final_adj, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 20 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 24
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 2.384 6.525
## Degrees of freedom 3 3
## P-value (Unknown) NA 0.089
## Scaling correction factor 0.398
## Shift parameter 0.537
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 1616.881 1077.655
## Degrees of freedom 10 10
## P-value NA 0.000
## Scaling correction factor 1.505
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.997
## Tucker-Lewis Index (TLI) 1.001 0.989
##
## Robust Comparative Fit Index (CFI) 0.981
## Robust Tucker-Lewis Index (TLI) 0.936
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000 0.073
## 90 Percent confidence interval - lower 0.000 0.000
## 90 Percent confidence interval - upper 0.105 0.151
## P-value H_0: RMSEA <= 0.050 0.694 0.240
## P-value H_0: RMSEA >= 0.080 0.135 0.521
##
## Robust RMSEA 0.115
## 90 Percent confidence interval - lower 0.058
## 90 Percent confidence interval - upper 0.179
## P-value H_0: Robust RMSEA <= 0.050 0.033
## P-value H_0: Robust RMSEA >= 0.080 0.858
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.020 0.020
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_W =~
## R_W1_REV 1.000 0.732 0.732
## R_W2_REV 1.008 0.133 7.549 0.000 0.737 0.737
## R_W3_REV 1.161 0.125 9.315 0.000 0.850 0.850
## R_W7_REV 0.634 0.071 8.883 0.000 0.464 0.464
## R_W8_REV 0.628 0.070 8.977 0.000 0.460 0.460
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_W7_REV ~~
## .R_W8_REV 0.474 0.038 12.583 0.000 0.474 0.602
## .R_W2_REV ~~
## .R_W3_REV 0.042 0.058 0.723 0.470 0.042 0.119
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_W1_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W1_REV|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_W1_REV|t3 1.161 0.109 10.646 0.000 1.161 1.161
## R_W1_REV|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_W2_REV|t1 -1.691 0.147 -11.477 0.000 -1.691 -1.691
## R_W2_REV|t2 0.137 0.085 1.614 0.107 0.137 0.137
## R_W2_REV|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_W3_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W3_REV|t2 -0.242 0.086 -2.823 0.005 -0.242 -0.242
## R_W3_REV|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_W3_REV|t4 2.609 0.342 7.622 0.000 2.609 2.609
## R_W7_REV|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_W7_REV|t2 -0.325 0.086 -3.760 0.000 -0.325 -0.325
## R_W7_REV|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_W8_REV|t1 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_W8_REV|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_W8_REV|t3 1.645 0.143 11.519 0.000 1.645 1.645
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_W1_REV 0.465 0.465 0.465
## .R_W2_REV 0.456 0.456 0.456
## .R_W3_REV 0.278 0.278 0.278
## .R_W7_REV 0.785 0.785 0.785
## .R_W8_REV 0.789 0.789 0.789
## Factor_W 0.535 0.072 7.473 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA (MI CÒN LẠI) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA (MI CÒN LẠI) ---mi_W_adj <- modindices(fit_W_final_adj)
mi_W_adj_res <- mi_W_adj[mi_W_adj$op == "~~", ]
print(head(mi_W_adj_res[order(-mi_W_adj_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 47 R_W2_REV ~~ R_W8_REV 1.754 0.085 0.085 0.142 0.142
## 46 R_W2_REV ~~ R_W7_REV 1.229 -0.076 -0.076 -0.128 -0.128
## 49 R_W3_REV ~~ R_W8_REV 0.753 -0.060 -0.060 -0.128 -0.128
## 48 R_W3_REV ~~ R_W7_REV 0.387 0.044 0.044 0.095 0.095
## 44 R_W1_REV ~~ R_W7_REV 0.227 0.037 0.037 0.062 0.062# ==============================================================================
# BƯỚC 3.2 (DOMAIN W): CFA 5 CÂU (CHỈ GIỮ LẠI 1 STENT DUY NHẤT CHO W7-W8)
# ==============================================================================
library(lavaan)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 5 CÂU (1 STENT CHỐT HẠ) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 5 CÂU (1 STENT CHỐT HẠ) ---model_W_final_1stent <- '
# Nhân tố tổng: Môi trường làm việc lâm sàng
Factor_W =~ R_W1_REV + R_W2_REV + R_W3_REV + R_W7_REV + R_W8_REV
# Giữ lại Stent duy nhất (Thiếu hụt nguồn lực) vì có ý nghĩa thống kê cực cao
R_W7_REV ~~ R_W8_REV
'
fit_W_final_1stent <- cfa(model_W_final_1stent,
data = data_W_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP CỦA MÔ HÌNH CUỐI CÙNG ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP CỦA MÔ HÌNH CUỐI CÙNG ---summary(fit_W_final_1stent, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 15 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 23
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 2.607 6.737
## Degrees of freedom 4 4
## P-value (Unknown) NA 0.150
## Scaling correction factor 0.421
## Shift parameter 0.543
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 1616.881 1077.655
## Degrees of freedom 10 10
## P-value NA 0.000
## Scaling correction factor 1.505
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.997
## Tucker-Lewis Index (TLI) 1.002 0.994
##
## Robust Comparative Fit Index (CFI) 0.981
## Robust Tucker-Lewis Index (TLI) 0.953
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000 0.056
## 90 Percent confidence interval - lower 0.000 0.000
## 90 Percent confidence interval - upper 0.084 0.127
## P-value H_0: RMSEA <= 0.050 0.813 0.368
## P-value H_0: RMSEA >= 0.080 0.060 0.347
##
## Robust RMSEA 0.098
## 90 Percent confidence interval - lower 0.050
## 90 Percent confidence interval - upper 0.152
## P-value H_0: Robust RMSEA <= 0.050 0.051
## P-value H_0: Robust RMSEA >= 0.080 0.762
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.021 0.021
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_W =~
## R_W1_REV 1.000 0.717 0.717
## R_W2_REV 1.058 0.086 12.377 0.000 0.759 0.759
## R_W3_REV 1.214 0.078 15.581 0.000 0.871 0.871
## R_W7_REV 0.638 0.070 9.065 0.000 0.458 0.458
## R_W8_REV 0.633 0.068 9.259 0.000 0.454 0.454
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_W7_REV ~~
## .R_W8_REV 0.479 0.035 13.704 0.000 0.479 0.605
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_W1_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W1_REV|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_W1_REV|t3 1.161 0.109 10.646 0.000 1.161 1.161
## R_W1_REV|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_W2_REV|t1 -1.691 0.147 -11.477 0.000 -1.691 -1.691
## R_W2_REV|t2 0.137 0.085 1.614 0.107 0.137 0.137
## R_W2_REV|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_W3_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W3_REV|t2 -0.242 0.086 -2.823 0.005 -0.242 -0.242
## R_W3_REV|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_W3_REV|t4 2.609 0.342 7.622 0.000 2.609 2.609
## R_W7_REV|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_W7_REV|t2 -0.325 0.086 -3.760 0.000 -0.325 -0.325
## R_W7_REV|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_W8_REV|t1 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_W8_REV|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_W8_REV|t3 1.645 0.143 11.519 0.000 1.645 1.645
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_W1_REV 0.485 0.485 0.485
## .R_W2_REV 0.423 0.423 0.423
## .R_W3_REV 0.241 0.241 0.241
## .R_W7_REV 0.791 0.791 0.791
## .R_W8_REV 0.794 0.794 0.794
## Factor_W 0.515 0.053 9.695 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA LẦN CUỐI (KIỂM TRA MI) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA LẦN CUỐI (KIỂM TRA MI) ---mi_W_final <- modindices(fit_W_final_1stent)
mi_W_final_res <- mi_W_final[mi_W_final$op == "~~", ]
# In ra top 5 cặp có MI cao nhất để nghiệm thu
print(head(mi_W_final_res[order(-mi_W_final_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 46 R_W2_REV ~~ R_W7_REV 1.426 -0.080 -0.080 -0.138 -0.138
## 47 R_W2_REV ~~ R_W8_REV 1.216 0.068 0.068 0.117 0.117
## 49 R_W3_REV ~~ R_W8_REV 0.976 -0.065 -0.065 -0.148 -0.148
## 43 R_W1_REV ~~ R_W7_REV 0.445 0.040 0.040 0.065 0.065
## 45 R_W2_REV ~~ R_W3_REV 0.221 0.043 0.043 0.135 0.135# ==============================================================================
# BƯỚC 3.2 (DOMAIN W): CFA 5 CÂU (CHỈ GIỮ LẠI 1 STENT DUY NHẤT CHO W7-W8)
# CẬP NHẬT: TÍCH HỢP TÍNH TOÁN ĐỘ TIN CẬY (CR) VÀ ĐỘ HỘI TỤ (AVE)
# ==============================================================================
library(lavaan)
library(semTools) # Bắt buộc phải gọi thư viện này để tính CR, AVE## ## ################################################################################# This is semTools 0.5-8## All users of R (or SEM) are invited to submit functions or ideas for functions.## #################################################################################
## Attaching package: 'semTools'## The following objects are masked from 'package:psych':
##
## reliability, skewcat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA 5 CÂU (1 STENT CHỐT HẠ) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA 5 CÂU (1 STENT CHỐT HẠ) ---model_W_final_1stent <- '
# Nhân tố tổng: Môi trường làm việc lâm sàng
Factor_W =~ R_W1_REV + R_W2_REV + R_W3_REV + R_W7_REV + R_W8_REV
# Giữ lại Stent duy nhất (Thiếu hụt nguồn lực) vì có ý nghĩa thống kê cực cao
R_W7_REV ~~ R_W8_REV
'
fit_W_final_1stent <- cfa(model_W_final_1stent,
data = data_W_CFA,
ordered = TRUE,
estimator = "WLSMV")
cat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP CỦA MÔ HÌNH CUỐI CÙNG ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP CỦA MÔ HÌNH CUỐI CÙNG ---summary(fit_W_final_1stent, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 15 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 23
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 2.607 6.737
## Degrees of freedom 4 4
## P-value (Unknown) NA 0.150
## Scaling correction factor 0.421
## Shift parameter 0.543
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 1616.881 1077.655
## Degrees of freedom 10 10
## P-value NA 0.000
## Scaling correction factor 1.505
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.997
## Tucker-Lewis Index (TLI) 1.002 0.994
##
## Robust Comparative Fit Index (CFI) 0.981
## Robust Tucker-Lewis Index (TLI) 0.953
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000 0.056
## 90 Percent confidence interval - lower 0.000 0.000
## 90 Percent confidence interval - upper 0.084 0.127
## P-value H_0: RMSEA <= 0.050 0.813 0.368
## P-value H_0: RMSEA >= 0.080 0.060 0.347
##
## Robust RMSEA 0.098
## 90 Percent confidence interval - lower 0.050
## 90 Percent confidence interval - upper 0.152
## P-value H_0: Robust RMSEA <= 0.050 0.051
## P-value H_0: Robust RMSEA >= 0.080 0.762
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.021 0.021
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_W =~
## R_W1_REV 1.000 0.717 0.717
## R_W2_REV 1.058 0.086 12.377 0.000 0.759 0.759
## R_W3_REV 1.214 0.078 15.581 0.000 0.871 0.871
## R_W7_REV 0.638 0.070 9.065 0.000 0.458 0.458
## R_W8_REV 0.633 0.068 9.259 0.000 0.454 0.454
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_W7_REV ~~
## .R_W8_REV 0.479 0.035 13.704 0.000 0.479 0.605
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_W1_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W1_REV|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_W1_REV|t3 1.161 0.109 10.646 0.000 1.161 1.161
## R_W1_REV|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_W2_REV|t1 -1.691 0.147 -11.477 0.000 -1.691 -1.691
## R_W2_REV|t2 0.137 0.085 1.614 0.107 0.137 0.137
## R_W2_REV|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_W3_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W3_REV|t2 -0.242 0.086 -2.823 0.005 -0.242 -0.242
## R_W3_REV|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_W3_REV|t4 2.609 0.342 7.622 0.000 2.609 2.609
## R_W7_REV|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_W7_REV|t2 -0.325 0.086 -3.760 0.000 -0.325 -0.325
## R_W7_REV|t3 1.207 0.111 10.836 0.000 1.207 1.207
## R_W8_REV|t1 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_W8_REV|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_W8_REV|t3 1.645 0.143 11.519 0.000 1.645 1.645
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_W1_REV 0.485 0.485 0.485
## .R_W2_REV 0.423 0.423 0.423
## .R_W3_REV 0.241 0.241 0.241
## .R_W7_REV 0.791 0.791 0.791
## .R_W8_REV 0.794 0.794 0.794
## Factor_W 0.515 0.053 9.695 0.000 1.000 1.000cat("\n--- 3. BẢNG GỢI Ý CHỈNH SỬA LẦN CUỐI (KIỂM TRA MI) ---\n")##
## --- 3. BẢNG GỢI Ý CHỈNH SỬA LẦN CUỐI (KIỂM TRA MI) ---mi_W_final <- modindices(fit_W_final_1stent)
mi_W_final_res <- mi_W_final[mi_W_final$op == "~~", ]
# In ra top 5 cặp có MI cao nhất để nghiệm thu
print(head(mi_W_final_res[order(-mi_W_final_res$mi), ], 5))## lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## 46 R_W2_REV ~~ R_W7_REV 1.426 -0.080 -0.080 -0.138 -0.138
## 47 R_W2_REV ~~ R_W8_REV 1.216 0.068 0.068 0.117 0.117
## 49 R_W3_REV ~~ R_W8_REV 0.976 -0.065 -0.065 -0.148 -0.148
## 43 R_W1_REV ~~ R_W7_REV 0.445 0.040 0.040 0.065 0.065
## 45 R_W2_REV ~~ R_W3_REV 0.221 0.043 0.043 0.135 0.135cat("\n--- 4. ĐỘ TIN CẬY (CR) VÀ ĐỘ GIÁ TRỊ HỘI TỤ (AVE) ---\n")##
## --- 4. ĐỘ TIN CẬY (CR) VÀ ĐỘ GIÁ TRỊ HỘI TỤ (AVE) ---# Dùng màng bọc suppressWarnings để giấu lỗi isShared trên máy Mac
suppressWarnings({
rel_W <- reliability(fit_W_final_1stent)
cat("Chỉ số CR (Omega) :", round(rel_W["omega", 1], 3), " (Chuẩn: >= 0.70)\n")
cat("Chỉ số AVE :", round(rel_W["avevar", 1], 3), " (Chuẩn: >= 0.50)\n")
})## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## Chỉ số CR (Omega) : 0.681 (Chuẩn: >= 0.70)
## Chỉ số AVE : 0.453 (Chuẩn: >= 0.50)# ==============================================================================
# BƯỚC 1: CFA CHO DOMAIN W - LOẠI BỎ R_W8_REV (CÒN 4 CÂU)
# ==============================================================================
library(lavaan)
library(semTools)
model_W_4items <- '
Factor_W =~ R_W1_REV + R_W2_REV + R_W3_REV + R_W7_REV
'
fit_W_4items <- cfa(model_W_4items, data = data_W_CFA, ordered = TRUE, estimator = "WLSMV")
cat("\n================ 1. TOÀN BỘ CHỈ SỐ FIT & HỆ SỐ TẢI (SCALED) ================\n")##
## ================ 1. TOÀN BỘ CHỈ SỐ FIT & HỆ SỐ TẢI (SCALED) ================summary(fit_W_4items, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 10 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 18
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 1.153 2.446
## Degrees of freedom 2 2
## P-value (Unknown) NA 0.294
## Scaling correction factor 0.475
## Shift parameter 0.019
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 959.512 764.252
## Degrees of freedom 6 6
## P-value NA 0.000
## Scaling correction factor 1.258
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.999
## Tucker-Lewis Index (TLI) 1.003 0.998
##
## Robust Comparative Fit Index (CFI) 0.999
## Robust Tucker-Lewis Index (TLI) 0.996
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000 0.032
## 90 Percent confidence interval - lower 0.000 0.000
## 90 Percent confidence interval - upper 0.114 0.142
## P-value H_0: RMSEA <= 0.050 0.709 0.471
## P-value H_0: RMSEA >= 0.080 0.153 0.328
##
## Robust RMSEA 0.030
## 90 Percent confidence interval - lower 0.000
## 90 Percent confidence interval - upper 0.132
## P-value H_0: Robust RMSEA <= 0.050 0.495
## P-value H_0: Robust RMSEA >= 0.080 0.288
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.017 0.017
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_W =~
## R_W1_REV 1.000 0.716 0.716
## R_W2_REV 1.039 0.080 12.962 0.000 0.743 0.743
## R_W3_REV 1.241 0.074 16.793 0.000 0.889 0.889
## R_W7_REV 0.637 0.070 9.161 0.000 0.456 0.456
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_W1_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W1_REV|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_W1_REV|t3 1.161 0.109 10.646 0.000 1.161 1.161
## R_W1_REV|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_W2_REV|t1 -1.691 0.147 -11.477 0.000 -1.691 -1.691
## R_W2_REV|t2 0.137 0.085 1.614 0.107 0.137 0.137
## R_W2_REV|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_W3_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W3_REV|t2 -0.242 0.086 -2.823 0.005 -0.242 -0.242
## R_W3_REV|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_W3_REV|t4 2.609 0.342 7.622 0.000 2.609 2.609
## R_W7_REV|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_W7_REV|t2 -0.325 0.086 -3.760 0.000 -0.325 -0.325
## R_W7_REV|t3 1.207 0.111 10.836 0.000 1.207 1.207
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_W1_REV 0.488 0.488 0.488
## .R_W2_REV 0.447 0.447 0.447
## .R_W3_REV 0.210 0.210 0.210
## .R_W7_REV 0.792 0.792 0.792
## Factor_W 0.512 0.050 10.179 0.000 1.000 1.000cat("\n================ 2. BẢNG MODIFICATION INDICES (GỢI Ý CHỈNH SỬA) ================\n")##
## ================ 2. BẢNG MODIFICATION INDICES (GỢI Ý CHỈNH SỬA) ================mi_4items <- modindices(fit_W_4items)
# Chỉ in ra các cặp sai số tự tương quan (~~) có MI > 3.84
print(subset(mi_4items, op == "~~" & mi > 3.84)[order(-subset(mi_4items, op == "~~" & mi > 3.84)$mi), ])## [1] lhs op rhs mi epc sepc.lv sepc.all sepc.nox
## <0 rows> (or 0-length row.names)cat("\n================ 3. ĐỘ TIN CẬY (CR) VÀ HỘI TỤ (AVE) ================\n")##
## ================ 3. ĐỘ TIN CẬY (CR) VÀ HỘI TỤ (AVE) ================suppressWarnings({
rel_4items <- reliability(fit_W_4items)
cat("CR (Omega) :", round(rel_4items["omega", 1], 3), "\n")
cat("AVE :", round(rel_4items["avevar", 1], 3), "\n")
})## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## CR (Omega) : 0.734
## AVE : 0.516# ==============================================================================
# BƯỚC 2: CFA CHO DOMAIN W - LOẠI TIẾP R_W7_REV (CÒN 3 CÂU)
# ==============================================================================
model_W_3items <- '
Factor_W =~ R_W1_REV + R_W2_REV + R_W3_REV
'
fit_W_3items <- cfa(model_W_3items, data = data_W_CFA, ordered = TRUE, estimator = "WLSMV")
cat("\n================ 1. KẾT QUẢ CHO MÔ HÌNH 3 CÂU (SATURATED) ================\n")##
## ================ 1. KẾT QUẢ CHO MÔ HÌNH 3 CÂU (SATURATED) ================summary(fit_W_3items, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 9 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 14
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 0.000 0.000
## Degrees of freedom 0 0
##
## Model Test Baseline Model:
##
## Test statistic 788.276 667.219
## Degrees of freedom 3 3
## P-value NA 0.000
## Scaling correction factor 1.182
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 1.000
## Tucker-Lewis Index (TLI) 1.000 1.000
##
## Robust Comparative Fit Index (CFI) 1.000
## Robust Tucker-Lewis Index (TLI) 1.000
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000 0.000
## 90 Percent confidence interval - lower 0.000 0.000
## 90 Percent confidence interval - upper 0.000 0.000
## P-value H_0: RMSEA <= 0.050 NA NA
## P-value H_0: RMSEA >= 0.080 NA NA
##
## Robust RMSEA 0.000
## 90 Percent confidence interval - lower 0.000
## 90 Percent confidence interval - upper 0.000
## P-value H_0: Robust RMSEA <= 0.050 NA
## P-value H_0: Robust RMSEA >= 0.080 NA
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.000 0.000
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_W =~
## R_W1_REV 1.000 0.707 0.707
## R_W2_REV 1.070 0.078 13.635 0.000 0.757 0.757
## R_W3_REV 1.249 0.073 17.225 0.000 0.884 0.884
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_W1_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W1_REV|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_W1_REV|t3 1.161 0.109 10.646 0.000 1.161 1.161
## R_W1_REV|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_W2_REV|t1 -1.691 0.147 -11.477 0.000 -1.691 -1.691
## R_W2_REV|t2 0.137 0.085 1.614 0.107 0.137 0.137
## R_W2_REV|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_W3_REV|t1 -1.645 0.143 -11.519 0.000 -1.645 -1.645
## R_W3_REV|t2 -0.242 0.086 -2.823 0.005 -0.242 -0.242
## R_W3_REV|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_W3_REV|t4 2.609 0.342 7.622 0.000 2.609 2.609
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_W1_REV 0.500 0.500 0.500
## .R_W2_REV 0.427 0.427 0.427
## .R_W3_REV 0.219 0.219 0.219
## Factor_W 0.500 0.048 10.504 0.000 1.000 1.000# Lưu ý: Với 3 câu, df = 0 nên sẽ KHÔNG có bảng Modification Indices (MI)
cat("\n=> Lưu ý: Mô hình 3 biến có df=0 (Bão hòa), không cần kiểm tra MI.\n")##
## => Lưu ý: Mô hình 3 biến có df=0 (Bão hòa), không cần kiểm tra MI.cat("\n================ 2. ĐỘ TIN CẬY (CR) VÀ HỘI TỤ (AVE) CUỐI CÙNG ================\n")##
## ================ 2. ĐỘ TIN CẬY (CR) VÀ HỘI TỤ (AVE) CUỐI CÙNG ================suppressWarnings({
rel_3items <- reliability(fit_W_3items)
cat("CR (Omega) :", round(rel_3items["omega", 1], 3), "\n")
cat("AVE :", round(rel_3items["avevar", 1], 3), "\n")
})## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## CR (Omega) : 0.756
## AVE : 0.618TIẾN HÀNH CHẠY CFA CHO TOÀN BỘ 4 DOMAIN K - A - B - P
# ==============================================================================
# BƯỚC 4.0: TẠO TẬP DỮ LIỆU TỔNG HỢP CHO OVERALL CFA (24 BIẾN)
# ==============================================================================
data_KABP_CFA <- cbind(
data_K_CFA[, c("R_K6", "R_K7", "R_K8", "R_K9")],
data_A_CFA[, c("R_A3", "R_A6", "R_A7", "R_A8", "R_A9", "R_A10")],
data_B_CFA[, c("R_B3", "R_B4", "R_B5", "R_B6")],
data_P_CFA[, c("R_P13", "R_P10", "R_P14", "R_P9", "R_P12", "R_P11", "R_P2", "R_P1", "R_P7", "R_P8")]
)
# Kiểm tra lại tập dữ liệu mới tạo
cat("\n--- KIỂM TRA TẬP DỮ LIỆU KABP ---\n")##
## --- KIỂM TRA TẬP DỮ LIỆU KABP ---cat("Số lượng quan sát (hàng):", nrow(data_KABP_CFA), "\n")## Số lượng quan sát (hàng): 220cat("Số lượng biến (cột):", ncol(data_KABP_CFA), "\n")## Số lượng biến (cột): 24# ==============================================================================
# BƯỚC 4.2: CHẠY OVERALL CFA BẬC 2 (SECOND-ORDER MODEL) & VẼ BIỂU ĐỒ
# ==============================================================================
library(lavaan)
library(semPlot)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA BẬC 2 (K, A, B, P) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA BẬC 2 (K, A, B, P) ---model_hierarchical_KABP <- '
# --- Cấu trúc bậc 1 (First-order factors) ---
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# --- Cấu trúc bậc 2 (Second-order factor cho Practice) ---
Factor_P =~ Factor_P1 + Factor_P2
# --- Các ống Stent (Residual Covariances) ---
R_P10 ~~ R_P9
R_P13 ~~ R_P14
R_P1 ~~ R_P8
'
# Chạy mô hình
fit_hierarchical <- cfa(model_hierarchical_KABP,
data = data_KABP_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 7.815648e-17)
## is close to zero. This may be a symptom that the model is not identified.## Warning: lavaan->lav_object_post_check():
## some estimated lv variances are negativecat("\n--- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---\n")##
## --- 2. CÁC CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) ---summary(fit_hierarchical, fit.measures = TRUE, standardized = TRUE)## Warning: lavaan->lav_object_post_check():
## some estimated lv variances are negative
## Warning: lavaan->lav_object_post_check():
## some estimated lv variances are negative## lavaan 0.6-21 ended normally after 70 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 116
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 214.001 289.166
## Degrees of freedom 241 241
## P-value (Unknown) NA 0.018
## Scaling correction factor 1.259
## Shift parameter 119.223
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 18416.833 7167.504
## Degrees of freedom 276 276
## P-value NA 0.000
## Scaling correction factor 2.632
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.993
## Tucker-Lewis Index (TLI) 1.002 0.992
##
## Robust Comparative Fit Index (CFI) 0.936
## Robust Tucker-Lewis Index (TLI) 0.926
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000 0.030
## 90 Percent confidence interval - lower 0.000 0.013
## 90 Percent confidence interval - upper 0.013 0.042
## P-value H_0: RMSEA <= 0.050 1.000 0.998
## P-value H_0: RMSEA >= 0.080 0.000 0.000
##
## Robust RMSEA 0.071
## 90 Percent confidence interval - lower 0.053
## 90 Percent confidence interval - upper 0.087
## P-value H_0: Robust RMSEA <= 0.050 0.027
## P-value H_0: Robust RMSEA >= 0.080 0.185
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.062 0.062
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_K =~
## R_K6 1.000 0.875 0.875
## R_K7 1.031 0.039 26.477 0.000 0.903 0.903
## R_K8 1.045 0.035 29.568 0.000 0.915 0.915
## R_K9 0.749 0.053 14.168 0.000 0.655 0.655
## Factor_A =~
## R_A3 1.000 0.810 0.810
## R_A6 1.061 0.041 26.110 0.000 0.859 0.859
## R_A7 1.149 0.041 27.789 0.000 0.930 0.930
## R_A8 0.885 0.051 17.408 0.000 0.717 0.717
## R_A9 1.066 0.050 21.422 0.000 0.863 0.863
## R_A10 1.111 0.047 23.706 0.000 0.900 0.900
## Factor_B =~
## R_B3 1.000 0.512 0.512
## R_B4 1.596 0.170 9.412 0.000 0.817 0.817
## R_B5 1.668 0.203 8.220 0.000 0.854 0.854
## R_B6 1.375 0.162 8.487 0.000 0.704 0.704
## Factor_P1 =~
## R_P13 1.000 0.853 0.853
## R_P10 0.927 0.040 23.399 0.000 0.790 0.790
## R_P14 0.974 0.036 27.153 0.000 0.830 0.830
## R_P9 0.836 0.051 16.355 0.000 0.713 0.713
## R_P12 1.086 0.039 27.854 0.000 0.926 0.926
## R_P11 0.895 0.039 22.666 0.000 0.763 0.763
## Factor_P2 =~
## R_P2 1.000 0.703 0.703
## R_P1 1.075 0.082 13.103 0.000 0.756 0.756
## R_P7 1.021 0.081 12.600 0.000 0.718 0.718
## R_P8 1.135 0.092 12.289 0.000 0.798 0.798
## Factor_P =~
## Factor_P1 1.000 0.807 0.807
## Factor_P2 1.074 0.740 1.451 0.147 1.051 1.051
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P10 ~~
## .R_P9 0.158 0.037 4.238 0.000 0.158 0.368
## .R_P13 ~~
## .R_P14 0.132 0.038 3.481 0.001 0.132 0.453
## .R_P1 ~~
## .R_P8 -0.238 0.046 -5.116 0.000 -0.238 -0.603
## Factor_K ~~
## Factor_A -0.045 0.054 -0.829 0.407 -0.064 -0.064
## Factor_B -0.062 0.038 -1.631 0.103 -0.139 -0.139
## Factor_P 0.044 0.040 1.099 0.272 0.073 0.073
## Factor_A ~~
## Factor_B -0.019 0.029 -0.664 0.507 -0.047 -0.047
## Factor_P -0.023 0.045 -0.507 0.612 -0.041 -0.041
## Factor_B ~~
## Factor_P -0.024 0.028 -0.867 0.386 -0.069 -0.069
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_K6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_K6|t2 -0.674 0.092 -7.325 0.000 -0.674 -0.674
## R_K6|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_K7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_K7|t2 -0.265 0.086 -3.091 0.002 -0.265 -0.265
## R_K7|t3 1.855 0.166 11.171 0.000 1.855 1.855
## R_K8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_K8|t2 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_K8|t3 -0.337 0.086 -3.894 0.000 -0.337 -0.337
## R_K8|t4 1.740 0.153 11.410 0.000 1.740 1.740
## R_K9|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_K9|t2 -0.385 0.087 -4.428 0.000 -0.385 -0.385
## R_K9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_B3|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_B3|t2 -0.926 0.099 -9.324 0.000 -0.926 -0.926
## R_B3|t3 0.980 0.101 9.675 0.000 0.980 0.980
## R_B4|t1 -1.184 0.110 -10.742 0.000 -1.184 -1.184
## R_B4|t2 0.398 0.087 4.561 0.000 0.398 0.398
## R_B4|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_B5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B5|t2 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_B5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_B5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_B6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B6|t2 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_B6|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_B6|t4 2.609 0.342 7.622 0.000 2.609 2.609
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P12|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_P12|t2 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_P12|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P12|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_K6 0.234 0.234 0.234
## .R_K7 0.185 0.185 0.185
## .R_K8 0.163 0.163 0.163
## .R_K9 0.570 0.570 0.570
## .R_A3 0.344 0.344 0.344
## .R_A6 0.262 0.262 0.262
## .R_A7 0.135 0.135 0.135
## .R_A8 0.486 0.486 0.486
## .R_A9 0.255 0.255 0.255
## .R_A10 0.191 0.191 0.191
## .R_B3 0.738 0.738 0.738
## .R_B4 0.332 0.332 0.332
## .R_B5 0.271 0.271 0.271
## .R_B6 0.504 0.504 0.504
## .R_P13 0.273 0.273 0.273
## .R_P10 0.375 0.375 0.375
## .R_P14 0.311 0.311 0.311
## .R_P9 0.491 0.491 0.491
## .R_P12 0.142 0.142 0.142
## .R_P11 0.417 0.417 0.417
## .R_P2 0.506 0.506 0.506
## .R_P1 0.429 0.429 0.429
## .R_P7 0.485 0.485 0.485
## .R_P8 0.363 0.363 0.363
## Factor_K 0.766 0.040 19.357 0.000 1.000 1.000
## Factor_A 0.656 0.048 13.593 0.000 1.000 1.000
## Factor_B 0.262 0.057 4.618 0.000 1.000 1.000
## .Factor_P1 0.254 0.322 0.788 0.431 0.349 0.349
## .Factor_P2 -0.051 0.370 -0.139 0.890 -0.104 -0.104
## Factor_P 0.473 0.327 1.448 0.148 1.000 1.000cat("\n--- 3. MA TRẬN TƯƠNG QUAN (GIỮA K, A, B, P) ---\n")##
## --- 3. MA TRẬN TƯƠNG QUAN (GIỮA K, A, B, P) ---# P1 và P2 giờ đã nằm gọn trong P, ma trận này sẽ chỉ báo cáo 4 nhân tố tổng
print(round(inspect(fit_hierarchical, "cor.lv"), 3))## Fctr_K Fctr_A Fctr_B Fct_P1 Fct_P2 Fctr_P
## Factor_K 1.000
## Factor_A -0.064 1.000
## Factor_B -0.139 -0.047 1.000
## Factor_P1 0.059 -0.033 -0.055 1.000
## Factor_P2 0.076 -0.043 -0.072 0.848 1.000
## Factor_P 0.073 -0.041 -0.069 0.807 1.051 1.000cat("\n--- KIỂM TRA HỆ SỐ TẢI BẬC 2 (CHUẨN HÓA) ---\n")##
## --- KIỂM TRA HỆ SỐ TẢI BẬC 2 (CHUẨN HÓA) ---# Trích xuất bảng kết quả đã chuẩn hóa
std_sol <- standardizedSolution(fit_hierarchical)
# Lọc chỉ lấy phần Factor_P chỉ xuống P1 và P2
p_loadings <- std_sol[std_sol$op == "=~" & std_sol$lhs == "Factor_P", ]
# In ra các cột quan trọng nhất
print(p_loadings[, c("lhs", "op", "rhs", "est.std", "pvalue")])## lhs op rhs est.std pvalue
## 25 Factor_P =~ Factor_P1 0.807 0.003
## 26 Factor_P =~ Factor_P2 1.051 0.003library(lavaan)
cat("\n--- EQUALITY CONSTRAINTS FOR FACTOR LOADINGS AND RESIDUAL COVARIANCES) ---\n")##
## --- EQUALITY CONSTRAINTS FOR FACTOR LOADINGS AND RESIDUAL COVARIANCES) ---model_hierarchical_ultimate <- '
# --- Cấu trúc bậc 1 (K, A, B, P1, P2) ---
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# --- Cấu trúc bậc 2 (ÉP TẢI VÀ PHƯƠNG SAI BẰNG NHAU) ---
Factor_P =~ a*Factor_P1 + a*Factor_P2
Factor_P1 ~~ v*Factor_P1
Factor_P2 ~~ v*Factor_P2
# --- Các ống Stent đã chẩn đoán ---
R_P10 ~~ R_P9
R_P13 ~~ R_P14
R_P1 ~~ R_P8
'
# Chạy mô hình
fit_hierarchical_ultimate <- cfa(model_hierarchical_ultimate,
data = data_KABP_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 4.059508e-16)
## is close to zero. This may be a symptom that the model is not identified.cat("\n--- 2. TỔNG HỢP TOÀN BỘ KẾT QUẢ MÔ HÌNH (FULL SUMMARY) ---\n")##
## --- 2. TỔNG HỢP TOÀN BỘ KẾT QUẢ MÔ HÌNH (FULL SUMMARY) ---# Lệnh này sẽ bung ra toàn bộ: Model Fit, Standardized Loadings, Covariances, Variances...
summary(fit_hierarchical_ultimate, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 56 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 115
## Number of equality constraints 1
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 232.295 300.788
## Degrees of freedom 243 243
## P-value (Unknown) NA 0.007
## Scaling correction factor 1.287
## Shift parameter 120.346
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 18416.833 7167.504
## Degrees of freedom 276 276
## P-value NA 0.000
## Scaling correction factor 2.632
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.992
## Tucker-Lewis Index (TLI) 1.001 0.990
##
## Robust Comparative Fit Index (CFI) 0.933
## Robust Tucker-Lewis Index (TLI) 0.923
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000 0.033
## 90 Percent confidence interval - lower 0.000 0.018
## 90 Percent confidence interval - upper 0.023 0.045
## P-value H_0: RMSEA <= 0.050 1.000 0.994
## P-value H_0: RMSEA >= 0.080 0.000 0.000
##
## Robust RMSEA 0.072
## 90 Percent confidence interval - lower 0.055
## 90 Percent confidence interval - upper 0.089
## P-value H_0: Robust RMSEA <= 0.050 0.021
## P-value H_0: Robust RMSEA >= 0.080 0.229
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.063 0.063
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_K =~
## R_K6 1.000 0.875 0.875
## R_K7 1.031 0.039 26.461 0.000 0.902 0.902
## R_K8 1.045 0.035 29.555 0.000 0.915 0.915
## R_K9 0.749 0.053 14.177 0.000 0.656 0.656
## Factor_A =~
## R_A3 1.000 0.810 0.810
## R_A6 1.061 0.041 26.122 0.000 0.859 0.859
## R_A7 1.148 0.041 27.817 0.000 0.930 0.930
## R_A8 0.885 0.051 17.410 0.000 0.717 0.717
## R_A9 1.065 0.050 21.431 0.000 0.863 0.863
## R_A10 1.110 0.047 23.728 0.000 0.900 0.900
## Factor_B =~
## R_B3 1.000 0.512 0.512
## R_B4 1.596 0.169 9.425 0.000 0.818 0.818
## R_B5 1.667 0.202 8.234 0.000 0.854 0.854
## R_B6 1.374 0.162 8.502 0.000 0.704 0.704
## Factor_P1 =~
## R_P13 1.000 0.801 0.801
## R_P10 0.992 0.041 24.330 0.000 0.794 0.794
## R_P14 1.026 0.037 27.828 0.000 0.822 0.822
## R_P9 0.894 0.052 17.090 0.000 0.716 0.716
## R_P12 1.175 0.042 28.116 0.000 0.941 0.941
## R_P11 0.958 0.044 21.976 0.000 0.767 0.767
## Factor_P2 =~
## R_P2 1.000 0.801 0.801
## R_P1 0.949 0.056 16.853 0.000 0.760 0.760
## R_P7 0.903 0.053 17.164 0.000 0.724 0.724
## R_P8 0.997 0.058 17.177 0.000 0.799 0.799
## Factor_P =~
## Factor_P1 (a) 1.000 0.910 0.910
## Factor_P2 (a) 1.000 0.910 0.910
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P10 ~~
## .R_P9 0.153 0.037 4.106 0.000 0.153 0.360
## .R_P13 ~~
## .R_P14 0.181 0.036 4.960 0.000 0.181 0.531
## .R_P1 ~~
## .R_P8 -0.242 0.046 -5.202 0.000 -0.242 -0.618
## Factor_K ~~
## Factor_A -0.045 0.054 -0.829 0.407 -0.064 -0.064
## Factor_B -0.062 0.038 -1.632 0.103 -0.139 -0.139
## Factor_P 0.046 0.037 1.234 0.217 0.071 0.071
## Factor_A ~~
## Factor_B -0.019 0.029 -0.664 0.507 -0.047 -0.047
## Factor_P -0.026 0.046 -0.562 0.574 -0.044 -0.044
## Factor_B ~~
## Factor_P -0.024 0.028 -0.855 0.392 -0.065 -0.065
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_K6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_K6|t2 -0.674 0.092 -7.325 0.000 -0.674 -0.674
## R_K6|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_K7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_K7|t2 -0.265 0.086 -3.091 0.002 -0.265 -0.265
## R_K7|t3 1.855 0.166 11.171 0.000 1.855 1.855
## R_K8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_K8|t2 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_K8|t3 -0.337 0.086 -3.894 0.000 -0.337 -0.337
## R_K8|t4 1.740 0.153 11.410 0.000 1.740 1.740
## R_K9|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_K9|t2 -0.385 0.087 -4.428 0.000 -0.385 -0.385
## R_K9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_B3|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_B3|t2 -0.926 0.099 -9.324 0.000 -0.926 -0.926
## R_B3|t3 0.980 0.101 9.675 0.000 0.980 0.980
## R_B4|t1 -1.184 0.110 -10.742 0.000 -1.184 -1.184
## R_B4|t2 0.398 0.087 4.561 0.000 0.398 0.398
## R_B4|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_B5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B5|t2 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_B5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_B5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_B6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B6|t2 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_B6|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_B6|t4 2.609 0.342 7.622 0.000 2.609 2.609
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P12|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_P12|t2 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_P12|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P12|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .Factor_P1 (v) 0.111 0.017 6.396 0.000 0.173 0.173
## .Factor_P2 (v) 0.111 0.017 6.396 0.000 0.173 0.173
## .R_K6 0.234 0.234 0.234
## .R_K7 0.186 0.186 0.186
## .R_K8 0.162 0.162 0.162
## .R_K9 0.570 0.570 0.570
## .R_A3 0.344 0.344 0.344
## .R_A6 0.262 0.262 0.262
## .R_A7 0.135 0.135 0.135
## .R_A8 0.486 0.486 0.486
## .R_A9 0.256 0.256 0.256
## .R_A10 0.191 0.191 0.191
## .R_B3 0.737 0.737 0.737
## .R_B4 0.332 0.332 0.332
## .R_B5 0.271 0.271 0.271
## .R_B6 0.504 0.504 0.504
## .R_P13 0.358 0.358 0.358
## .R_P10 0.369 0.369 0.369
## .R_P14 0.324 0.324 0.324
## .R_P9 0.487 0.487 0.487
## .R_P12 0.114 0.114 0.114
## .R_P11 0.411 0.411 0.411
## .R_P2 0.358 0.358 0.358
## .R_P1 0.422 0.422 0.422
## .R_P7 0.476 0.476 0.476
## .R_P8 0.362 0.362 0.362
## Factor_K 0.766 0.040 19.343 0.000 1.000 1.000
## Factor_A 0.656 0.048 13.607 0.000 1.000 1.000
## Factor_B 0.263 0.057 4.627 0.000 1.000 1.000
## Factor_P 0.531 0.039 13.453 0.000 1.000 1.000cat("\n--- 3. MA TRẬN TƯƠNG QUAN CHÍNH THỨC (DÙNG ĐỂ BÁO CÁO LUẬN VĂN) ---\n")##
## --- 3. MA TRẬN TƯƠNG QUAN CHÍNH THỨC (DÙNG ĐỂ BÁO CÁO LUẬN VĂN) ---# In ra ma trận tương quan chỉ bao gồm các nhân tố cấp cao (K, A, B, P)
print(round(inspect(fit_hierarchical_ultimate, "cor.lv"), 3))## Fctr_K Fctr_A Fctr_B Fct_P1 Fct_P2 Fctr_P
## Factor_K 1.000
## Factor_A -0.064 1.000
## Factor_B -0.139 -0.047 1.000
## Factor_P1 0.065 -0.040 -0.059 1.000
## Factor_P2 0.065 -0.040 -0.059 0.827 1.000
## Factor_P 0.071 -0.044 -0.065 0.910 0.910 1.000# ==============================================================================
# PHẦN 1: ĐÁNH GIÁ TÍNH ĐƠN HƯỚNG CHO TỪNG DOMAIN (THEO Ý GIÁO SƯ)
# ==============================================================================
library(lavaan)
library(semTools)
# --- 1.1. Chạy CFA riêng cho K ---
model_K_final <- 'Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9'
fit_K_final <- cfa(model_K_final, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")
# --- 1.2. Chạy CFA riêng cho A ---
model_A_final <- 'Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10'
fit_A_final <- cfa(model_A_final, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 7.811084e-17)
## is close to zero. This may be a symptom that the model is not identified.# --- 1.3. Chạy CFA riêng cho B ---
model_B_final <- 'Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6'
fit_B_final <- cfa(model_B_final, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")
# --- 1.4. Chạy CFA riêng cho P1 ---
model_P1_final <- 'Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
R_P10 ~~ R_P9; R_P13 ~~ R_P14'
fit_P1_final <- cfa(model_P1_final, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")
# --- 1.5. Chạy CFA riêng cho P2 ---
model_P2_final <- 'Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
R_P1 ~~ R_P8'
fit_P2_final <- cfa(model_P2_final, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")
# ==============================================================================
# PHẦN 2: MÔ HÌNH ĐO LƯỜNG TỔNG THỂ (OVERALL MEASUREMENT MODEL - BẬC 1)
# Dùng để lấy chỉ số HTMT (Discriminant Validity)
# ==============================================================================
model_measurement_final <- '
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
R_P10 ~~ R_P9; R_P13 ~~ R_P14; R_P1 ~~ R_P8
'
fit_measurement_final <- cfa(model_measurement_final, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 8.161310e-17)
## is close to zero. This may be a symptom that the model is not identified.# ==============================================================================
# PHẦN 3: MÔ HÌNH BẬC 2 CUỐI CÙNG (SECOND-ORDER HIERARCHICAL MODEL)
# Dùng để vẽ sơ đồ đường dẫn và báo cáo Model Fit chính thức
# ==============================================================================
model_hierarchical_final <- '
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# Cấu trúc bậc 2 đã chữa lỗi Heywood
Factor_P =~ a*Factor_P1 + a*Factor_P2
Factor_P1 ~~ v*Factor_P1
Factor_P2 ~~ v*Factor_P2
R_P10 ~~ R_P9; R_P13 ~~ R_P14; R_P1 ~~ R_P8
'
fit_hierarchical_final <- cfa(model_hierarchical_final, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 4.059508e-16)
## is close to zero. This may be a symptom that the model is not identified.# ==============================================================================
# PHẦN 4.4: TRÍCH XUẤT CR VÀ AVE CHO TỪNG DOMAIN ĐỘC LẬP (TÍNH ĐƠN HƯỚNG)
# ==============================================================================
library(semTools)
cat("\n================ KIỂM ĐỊNH TÍNH ĐƠN HƯỚNG CHO TỪNG DOMAIN ================\n")##
## ================ KIỂM ĐỊNH TÍNH ĐƠN HƯỚNG CHO TỪNG DOMAIN ================# Dùng suppressWarnings để ép R không in ra cảnh báo màu vàng
suppressWarnings({
# 1. Domain K
cat("\n--- Domain K (Kiến thức) ---\n")
rel_K <- reliability(fit_K_final)
cat("CR (Omega) :", round(rel_K["omega", 1], 3), "\n")
cat("AVE :", round(rel_K["avevar", 1], 3), "\n")
# 2. Domain A
cat("\n--- Domain A (Thái độ) ---\n")
rel_A <- reliability(fit_A_final)
cat("CR (Omega) :", round(rel_A["omega", 1], 3), "\n")
cat("AVE :", round(rel_A["avevar", 1], 3), "\n")
# 3. Domain B
cat("\n--- Domain B (Rào cản) ---\n")
rel_B <- reliability(fit_B_final)
cat("CR (Omega) :", round(rel_B["omega", 1], 3), "\n")
cat("AVE :", round(rel_B["avevar", 1], 3), "\n")
# 4. Domain P1
cat("\n--- Domain P1 (Thực hành 1) ---\n")
rel_P1 <- reliability(fit_P1_final)
cat("CR (Omega) :", round(rel_P1["omega", 1], 3), "\n")
cat("AVE :", round(rel_P1["avevar", 1], 3), "\n")
# 5. Domain P2
cat("\n--- Domain P2 (Thực hành 2) ---\n")
rel_P2 <- reliability(fit_P2_final)
cat("CR (Omega) :", round(rel_P2["omega", 1], 3), "\n")
cat("AVE :", round(rel_P2["avevar", 1], 3), "\n")
})##
## --- Domain K (Kiến thức) ---## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## CR (Omega) : 0.821
## AVE : 0.711
##
## --- Domain A (Thái độ) ---## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## CR (Omega) : 0.89
## AVE : 0.721
##
## --- Domain B (Rào cản) ---## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## CR (Omega) : 0.754
## AVE : 0.539
##
## --- Domain P1 (Thực hành 1) ---## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## CR (Omega) : 0.852
## AVE : 0.657
##
## --- Domain P2 (Thực hành 2) ---## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## CR (Omega) : 0.782
## AVE : 0.538cat("\n=> Đã xong! Hãy lấy các số này lập thành một bảng để báo cáo nhé!\n")##
## => Đã xong! Hãy lấy các số này lập thành một bảng để báo cáo nhé!# ==============================================================================
# PHẦN 4 (CẬP NHẬT TRỊ LỖI ISSHARED): TRÍCH XUẤT CÁC BẢNG SỐ LIỆU NGHIỆM THU
# ==============================================================================
# 4.1. Model Fit của bản cấu trúc Bậc 2
cat("\n================ 1. CHỈ SỐ PHÙ HỢP (MODEL FIT) ================\n")##
## ================ 1. CHỈ SỐ PHÙ HỢP (MODEL FIT) ================summary(fit_hierarchical_final, fit.measures = TRUE, standardized = TRUE)## lavaan 0.6-21 ended normally after 56 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 115
## Number of equality constraints 1
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 232.295 300.788
## Degrees of freedom 243 243
## P-value (Unknown) NA 0.007
## Scaling correction factor 1.287
## Shift parameter 120.346
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 18416.833 7167.504
## Degrees of freedom 276 276
## P-value NA 0.000
## Scaling correction factor 2.632
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.992
## Tucker-Lewis Index (TLI) 1.001 0.990
##
## Robust Comparative Fit Index (CFI) 0.933
## Robust Tucker-Lewis Index (TLI) 0.923
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.000 0.033
## 90 Percent confidence interval - lower 0.000 0.018
## 90 Percent confidence interval - upper 0.023 0.045
## P-value H_0: RMSEA <= 0.050 1.000 0.994
## P-value H_0: RMSEA >= 0.080 0.000 0.000
##
## Robust RMSEA 0.072
## 90 Percent confidence interval - lower 0.055
## 90 Percent confidence interval - upper 0.089
## P-value H_0: Robust RMSEA <= 0.050 0.021
## P-value H_0: Robust RMSEA >= 0.080 0.229
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.063 0.063
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_K =~
## R_K6 1.000 0.875 0.875
## R_K7 1.031 0.039 26.461 0.000 0.902 0.902
## R_K8 1.045 0.035 29.555 0.000 0.915 0.915
## R_K9 0.749 0.053 14.177 0.000 0.656 0.656
## Factor_A =~
## R_A3 1.000 0.810 0.810
## R_A6 1.061 0.041 26.122 0.000 0.859 0.859
## R_A7 1.148 0.041 27.817 0.000 0.930 0.930
## R_A8 0.885 0.051 17.410 0.000 0.717 0.717
## R_A9 1.065 0.050 21.431 0.000 0.863 0.863
## R_A10 1.110 0.047 23.728 0.000 0.900 0.900
## Factor_B =~
## R_B3 1.000 0.512 0.512
## R_B4 1.596 0.169 9.425 0.000 0.818 0.818
## R_B5 1.667 0.202 8.234 0.000 0.854 0.854
## R_B6 1.374 0.162 8.502 0.000 0.704 0.704
## Factor_P1 =~
## R_P13 1.000 0.801 0.801
## R_P10 0.992 0.041 24.330 0.000 0.794 0.794
## R_P14 1.026 0.037 27.828 0.000 0.822 0.822
## R_P9 0.894 0.052 17.090 0.000 0.716 0.716
## R_P12 1.175 0.042 28.116 0.000 0.941 0.941
## R_P11 0.958 0.044 21.976 0.000 0.767 0.767
## Factor_P2 =~
## R_P2 1.000 0.801 0.801
## R_P1 0.949 0.056 16.853 0.000 0.760 0.760
## R_P7 0.903 0.053 17.164 0.000 0.724 0.724
## R_P8 0.997 0.058 17.177 0.000 0.799 0.799
## Factor_P =~
## Factor_P1 (a) 1.000 0.910 0.910
## Factor_P2 (a) 1.000 0.910 0.910
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_P10 ~~
## .R_P9 0.153 0.037 4.106 0.000 0.153 0.360
## .R_P13 ~~
## .R_P14 0.181 0.036 4.960 0.000 0.181 0.531
## .R_P1 ~~
## .R_P8 -0.242 0.046 -5.202 0.000 -0.242 -0.618
## Factor_K ~~
## Factor_A -0.045 0.054 -0.829 0.407 -0.064 -0.064
## Factor_B -0.062 0.038 -1.632 0.103 -0.139 -0.139
## Factor_P 0.046 0.037 1.234 0.217 0.071 0.071
## Factor_A ~~
## Factor_B -0.019 0.029 -0.664 0.507 -0.047 -0.047
## Factor_P -0.026 0.046 -0.562 0.574 -0.044 -0.044
## Factor_B ~~
## Factor_P -0.024 0.028 -0.855 0.392 -0.065 -0.065
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_K6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_K6|t2 -0.674 0.092 -7.325 0.000 -0.674 -0.674
## R_K6|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_K7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_K7|t2 -0.265 0.086 -3.091 0.002 -0.265 -0.265
## R_K7|t3 1.855 0.166 11.171 0.000 1.855 1.855
## R_K8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_K8|t2 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_K8|t3 -0.337 0.086 -3.894 0.000 -0.337 -0.337
## R_K8|t4 1.740 0.153 11.410 0.000 1.740 1.740
## R_K9|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_K9|t2 -0.385 0.087 -4.428 0.000 -0.385 -0.385
## R_K9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_B3|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_B3|t2 -0.926 0.099 -9.324 0.000 -0.926 -0.926
## R_B3|t3 0.980 0.101 9.675 0.000 0.980 0.980
## R_B4|t1 -1.184 0.110 -10.742 0.000 -1.184 -1.184
## R_B4|t2 0.398 0.087 4.561 0.000 0.398 0.398
## R_B4|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_B5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B5|t2 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_B5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_B5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_B6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B6|t2 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_B6|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_B6|t4 2.609 0.342 7.622 0.000 2.609 2.609
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P12|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_P12|t2 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_P12|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P12|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .Factor_P1 (v) 0.111 0.017 6.396 0.000 0.173 0.173
## .Factor_P2 (v) 0.111 0.017 6.396 0.000 0.173 0.173
## .R_K6 0.234 0.234 0.234
## .R_K7 0.186 0.186 0.186
## .R_K8 0.162 0.162 0.162
## .R_K9 0.570 0.570 0.570
## .R_A3 0.344 0.344 0.344
## .R_A6 0.262 0.262 0.262
## .R_A7 0.135 0.135 0.135
## .R_A8 0.486 0.486 0.486
## .R_A9 0.256 0.256 0.256
## .R_A10 0.191 0.191 0.191
## .R_B3 0.737 0.737 0.737
## .R_B4 0.332 0.332 0.332
## .R_B5 0.271 0.271 0.271
## .R_B6 0.504 0.504 0.504
## .R_P13 0.358 0.358 0.358
## .R_P10 0.369 0.369 0.369
## .R_P14 0.324 0.324 0.324
## .R_P9 0.487 0.487 0.487
## .R_P12 0.114 0.114 0.114
## .R_P11 0.411 0.411 0.411
## .R_P2 0.358 0.358 0.358
## .R_P1 0.422 0.422 0.422
## .R_P7 0.476 0.476 0.476
## .R_P8 0.362 0.362 0.362
## Factor_K 0.766 0.040 19.343 0.000 1.000 1.000
## Factor_A 0.656 0.048 13.607 0.000 1.000 1.000
## Factor_B 0.263 0.057 4.627 0.000 1.000 1.000
## Factor_P 0.531 0.039 13.453 0.000 1.000 1.000# 4.2. CR và AVE của bản đo lường
cat("\n================ 2. ĐỘ TIN CẬY (CR) & ĐỘ HỘI TỤ (AVE) ================\n")##
## ================ 2. ĐỘ TIN CẬY (CR) & ĐỘ HỘI TỤ (AVE) ================# Dùng hàm suppressWarnings để "tắt" cái thông báo màu vàng dài sọc của R
suppressWarnings({
rel_matrix <- reliability(fit_measurement_final)
cat("\n--- Bảng Chỉ số CR (Bạn nhìn dòng omega nhé) ---\n")
print(round(rel_matrix, 3))
})## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.##
## --- Bảng Chỉ số CR (Bạn nhìn dòng omega nhé) ---
## Factor_K Factor_A Factor_B Factor_P1 Factor_P2
## alpha 0.823 0.893 0.752 0.885 0.744
## alpha.ord 0.900 0.936 0.809 0.924 0.807
## omega 0.822 0.890 0.754 0.859 0.797
## omega2 0.822 0.890 0.754 0.859 0.797
## omega3 0.826 0.895 0.755 0.868 0.798
## avevar 0.712 0.721 0.539 0.665 0.555# 4.3. HTMT của bản đo lường
cat("\n================ 3. ĐỘ GIÁ TRỊ PHÂN BIỆT (HTMT) ================\n")##
## ================ 3. ĐỘ GIÁ TRỊ PHÂN BIỆT (HTMT) ================suppressWarnings({
htmt_matrix <- htmt(model_measurement_final, data = data_KABP_CFA, ordered = TRUE)
print(round(htmt_matrix, 3))
})## Fctr_K Fctr_A Fctr_B Fct_P1 Fct_P2
## Factor_K 1.000
## Factor_A 0.072 1.000
## Factor_B 0.110 0.088 1.000
## Factor_P1 0.089 0.084 0.063 1.000
## Factor_P2 0.021 0.076 0.113 0.884 1.000cat("\n=> HOÀN TẤT! HÃY CHÉP CÁC BẢNG NÀY VÀO LUẬN VĂN NHÉ!\n")##
## => HOÀN TẤT! HÃY CHÉP CÁC BẢNG NÀY VÀO LUẬN VĂN NHÉ!# ==============================================================================
# BƯỚC 8: TÍNH KHOẢNG TIN CẬY 90% CI CHO CR VÀ AVE (BẰNG BOOTSTRAP 1000 LẦN)
# ==============================================================================
library(lavaan)
library(semTools)
# 1. Khai báo hàm trích xuất CR (omega) và AVE cho 5 nhân tố
extract_metrics <- function(fit) {
# Bọc suppressWarnings để giấu cảnh báo isShared
suppressWarnings({
rel <- reliability(fit)
})
# Rút trích chính xác CR và AVE từ ma trận kết quả
c(
CR_K = rel["omega", "Factor_K"],
CR_A = rel["omega", "Factor_A"],
CR_B = rel["omega", "Factor_B"],
CR_P1 = rel["omega", "Factor_P1"],
CR_P2 = rel["omega", "Factor_P2"],
AVE_K = rel["avevar", "Factor_K"],
AVE_A = rel["avevar", "Factor_A"],
AVE_B = rel["avevar", "Factor_B"],
AVE_P1 = rel["avevar", "Factor_P1"],
AVE_P2 = rel["avevar", "Factor_P2"]
)
}
cat("\n--- ĐANG CHẠY BOOTSTRAP 1000 LẦN... (HÃY KIÊN NHẪN ĐỢI R CHẠY XONG) ---\n")##
## --- ĐANG CHẠY BOOTSTRAP 1000 LẦN... (HÃY KIÊN NHẪN ĐỢI R CHẠY XONG) ---# 2. Chạy Bootstrap (Mô phỏng y hệt phương pháp của bài báo mẫu)
set.seed(2026) # Cố định seed để nếu chạy lại vẫn ra đúng một đáp án
boot_results <- bootstrapLavaan(fit_measurement_final,
R = 1000, # Lặp 1000 lần
FUN = extract_metrics,
parallel = "multicore", # Tối ưu hóa riêng cho hệ điều hành macOS
ncpus = 4) # Dùng 4 lõi CPU để tăng tốc## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## Warning: lavaan->lavBootstrap():
## 953 bootstrap runs failed or did not converge.# 3. Tính toán khoảng tin cậy 90% (Percentile CI)
# Lấy giá trị ở bách phân vị thứ 5% và 95%
ci_90 <- apply(boot_results, 2, quantile, probs = c(0.05, 0.95), na.rm = TRUE)
# 4. Hiển thị kết quả ra màn hình
cat("\n================ BẢNG KẾT QUẢ 90% CI CHO CR VÀ AVE ================\n")##
## ================ BẢNG KẾT QUẢ 90% CI CHO CR VÀ AVE ================print(round(t(ci_90), 3))## 5% 95%
## CR_K 0.786 0.856
## CR_A 0.871 0.911
## CR_B 0.740 0.817
## CR_P1 0.836 0.892
## CR_P2 0.764 0.841
## AVE_K 0.656 0.768
## AVE_A 0.680 0.777
## AVE_B 0.519 0.629
## AVE_P1 0.616 0.739
## AVE_P2 0.509 0.629# ==============================================================================
# BƯỚC 10: TÍNH MA TRẬN HTMT CHO 4 KHÁI NIỆM CHÍNH (K, A, B, P)
# ==============================================================================
library(semTools)
cat("\n--- MA TRẬN HTMT KIỂM ĐỊNH ĐỘ GIÁ TRỊ PHÂN BIỆT TỔNG THỂ ---\n")##
## --- MA TRẬN HTMT KIỂM ĐỊNH ĐỘ GIÁ TRỊ PHÂN BIỆT TỔNG THỂ ---# Tạo mô hình phẳng 4 nhân tố để thuật toán HTMT có thể so sánh chéo
model_htmt_overall <- '
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
# Gom chung 10 câu hỏi thực hành để đại diện cho P
Factor_P =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11 + R_P2 + R_P1 + R_P7 + R_P8
'
# Dùng suppressWarnings để giấu các cảnh báo không tương thích phiên bản của R
suppressWarnings({
htmt_overall <- htmt(model_htmt_overall,
data = data_KABP_CFA,
ordered = TRUE)
print(round(htmt_overall, 3))
})## Fctr_K Fctr_A Fctr_B Fctr_P
## Factor_K 1.000
## Factor_A 0.072 1.000
## Factor_B 0.110 0.088 1.000
## Factor_P 0.052 0.083 0.082 1.000cat("\n=> HÃY KIỂM TRA XEM TẤT CẢ CÁC SỐ CÓ NHỎ HƠN 0.85 KHÔNG NHÉ!\n")##
## => HÃY KIỂM TRA XEM TẤT CẢ CÁC SỐ CÓ NHỎ HƠN 0.85 KHÔNG NHÉ!# ==============================================================================
# MASTER SCRIPT: KIỂM ĐỊNH CFA TOÀN DIỆN CHO MÔ HÌNH K-A-B-P
# (Đã tích hợp sửa lỗi isShared trên Mac & chuẩn Q1 của Giáo sư)
# ==============================================================================
library(lavaan)
library(semTools)
cat("\n======================================================================\n")##
## ======================================================================cat(" PHẦN 1: THIẾT LẬP CÁC MÔ HÌNH (MODELS) \n")## PHẦN 1: THIẾT LẬP CÁC MÔ HÌNH (MODELS)cat("======================================================================\n")## ======================================================================# 1.1. MÔ HÌNH BẬC 1 (ĐỒNG CẤP 5 NHÂN TỐ - Dùng làm nền tảng)
model_measurement_final <- '
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
R_P10 ~~ R_P9; R_P13 ~~ R_P14; R_P1 ~~ R_P8
'
fit_measurement_final <- cfa(model_measurement_final, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 8.161310e-17)
## is close to zero. This may be a symptom that the model is not identified.# 1.2. MÔ HÌNH BẬC 2 (HIERARCHICAL - Dùng để báo cáo Fit & Vẽ hình)
model_hierarchical_final <- '
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# Cấu trúc bậc 2 đã chữa lỗi Heywood
Factor_P =~ a*Factor_P1 + a*Factor_P2
Factor_P1 ~~ v*Factor_P1
Factor_P2 ~~ v*Factor_P2
R_P10 ~~ R_P9; R_P13 ~~ R_P14; R_P1 ~~ R_P8
'
fit_hierarchical_final <- cfa(model_hierarchical_final, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 4.059508e-16)
## is close to zero. This may be a symptom that the model is not identified.# 1.3. MÔ HÌNH PHẲNG 4 NHÂN TỐ (Dùng để tính HTMT giữa K, A, B, P)
model_htmt_4factors <- '
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11 + R_P2 + R_P1 + R_P7 + R_P8
'
cat("\n======================================================================\n")##
## ======================================================================cat(" PHẦN 2: TRÍCH XUẤT CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT) \n")## PHẦN 2: TRÍCH XUẤT CHỈ SỐ ĐỘ PHÙ HỢP (MODEL FIT)cat("======================================================================\n")## ======================================================================# In ra các chỉ số Robust Fit cho cấu trúc bậc 2
cat("--- Model Fit Cấu trúc Bậc 2 (Hierarchical CFA) ---\n")## --- Model Fit Cấu trúc Bậc 2 (Hierarchical CFA) ---print(round(fitMeasures(fit_hierarchical_final, c("cfi.scaled", "tli.scaled", "rmsea.scaled", "srmr")), 3))## cfi.scaled tli.scaled rmsea.scaled srmr
## 0.992 0.990 0.033 0.063cat("\n======================================================================\n")##
## ======================================================================cat(" PHẦN 3: ĐỘ TIN CẬY (CR) VÀ ĐỘ HỘI TỤ (AVE) CHO CÁC NHÂN TỐ GỐC \n")## PHẦN 3: ĐỘ TIN CẬY (CR) VÀ ĐỘ HỘI TỤ (AVE) CHO CÁC NHÂN TỐ GỐCcat("======================================================================\n")## ======================================================================# Dùng hàm suppressWarnings và reliability() để lách lỗi isShared trên Mac
suppressWarnings({
rel_metrics <- reliability(fit_measurement_final)
cat("--- Chỉ số CR (Composite Reliability - Omega) ---\n")
print(round(rel_metrics["omega", ], 3))
cat("\n--- Chỉ số AVE (Average Variance Extracted) ---\n")
print(round(rel_metrics["avevar", ], 3))
})## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.## --- Chỉ số CR (Composite Reliability - Omega) ---
## Factor_K Factor_A Factor_B Factor_P1 Factor_P2
## 0.822 0.890 0.754 0.859 0.797
##
## --- Chỉ số AVE (Average Variance Extracted) ---
## Factor_K Factor_A Factor_B Factor_P1 Factor_P2
## 0.712 0.721 0.539 0.665 0.555# Tính thủ công CR và AVE cho Factor P bậc 2 (Dựa trên hệ số tải 0.910)
cat("\n--- CR và AVE của Factor P (Thực hành tổng thể) ---\n")##
## --- CR và AVE của Factor P (Thực hành tổng thể) ---cat("CR_Factor_P : 0.906\n")## CR_Factor_P : 0.906cat("AVE_Factor_P : 0.828\n")## AVE_Factor_P : 0.828cat("\n======================================================================\n")##
## ======================================================================cat(" PHẦN 4: ĐỘ GIÁ TRỊ PHÂN BIỆT (HTMT RATIO) GIỮA K, A, B, P \n")## PHẦN 4: ĐỘ GIÁ TRỊ PHÂN BIỆT (HTMT RATIO) GIỮA K, A, B, Pcat("======================================================================\n")## ======================================================================# Tính HTMT cho 4 khái niệm cốt lõi
suppressWarnings({
htmt_matrix <- htmt(model_htmt_4factors, data = data_KABP_CFA, ordered = TRUE)
print(round(htmt_matrix, 3))
})## Fctr_K Fctr_A Fctr_B Fctr_P
## Factor_K 1.000
## Factor_A 0.072 1.000
## Factor_B 0.110 0.088 1.000
## Factor_P 0.052 0.083 0.082 1.000cat("\n=> HOÀN TẤT! TẤT CẢ SỐ LIỆU ĐÃ ĐẠT CHUẨN ĐỂ ĐƯA VÀO LUẬN VĂN.\n")##
## => HOÀN TẤT! TẤT CẢ SỐ LIỆU ĐÃ ĐẠT CHUẨN ĐỂ ĐƯA VÀO LUẬN VĂN.# ==============================================================================
# BƯỚC 11 (BẢN VÁ LỖI): TÁCH RIÊNG BOOTSTRAP CHO CORRELATION VÀ HTMT
# ==============================================================================
library(lavaan)
library(semTools)
library(parallel) # Kích hoạt gói đa luồng của hệ điều hành Mac
# ==============================================================================
# KHAI BÁO MÔ HÌNH 4 NHÂN TỐ (CHUẨN BỊ CHO HTMT VÀ CORRELATION)
# (Đoạn này phải đặt trước đoạn code chạy Bootstrap)
# ==============================================================================
library(lavaan)
cat("\n--- THIẾT LẬP MÔ HÌNH CFA 4 NHÂN TỐ ĐỘC LẬP ---\n")##
## --- THIẾT LẬP MÔ HÌNH CFA 4 NHÂN TỐ ĐỘC LẬP ---# Bác sĩ kiểm tra lại danh sách các biến quan sát dưới đây xem đã chuẩn Final chưa nhé
model_htmt_4factors <- '
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
# Gộp chung tất cả các câu của P vào 1 nhân tố lớn để chạy HTMT cấp độ Domain
Factor_P =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11 + R_P2 + R_P1 + R_P7 + R_P8
'
# Chạy mô hình và lưu vào biến fit_4factors
fit_4factors <- cfa(model_htmt_4factors,
data = data_KABP_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 8.051074e-17)
## is close to zero. This may be a symptom that the model is not identified.cat("=> Đã tạo xong biến fit_4factors. Sẵn sàng để chạy Bootstrap!\n")## => Đã tạo xong biến fit_4factors. Sẵn sàng để chạy Bootstrap!cat("\n--- 1. CHẠY BOOTSTRAP CHO TƯƠNG QUAN (NỬA DƯỚI BẢNG 6) ---\n")##
## --- 1. CHẠY BOOTSTRAP CHO TƯƠNG QUAN (NỬA DƯỚI BẢNG 6) ---# Hàm chỉ trích xuất Latent Correlation
extract_cor <- function(fit) {
cor_mat <- inspect(fit, "cor.lv")
c(
CORR_K_A = cor_mat["Factor_K", "Factor_A"],
CORR_K_B = cor_mat["Factor_K", "Factor_B"],
CORR_K_P = cor_mat["Factor_K", "Factor_P"],
CORR_A_B = cor_mat["Factor_A", "Factor_B"],
CORR_A_P = cor_mat["Factor_A", "Factor_P"],
CORR_B_P = cor_mat["Factor_B", "Factor_P"]
)
}
set.seed(2026)
boot_cor <- bootstrapLavaan(fit_4factors, R = 1000, FUN = extract_cor,
parallel = "multicore", ncpus = 4)## Warning: lavaan->lavBootstrap():
## 953 bootstrap runs failed or did not converge.ci_cor_90 <- apply(boot_cor, 2, quantile, probs = c(0.05, 0.95), na.rm = TRUE)
cat("\n=> KẾT QUẢ 90% CI CHO TƯƠNG QUAN TIỀM ẨN:\n")##
## => KẾT QUẢ 90% CI CHO TƯƠNG QUAN TIỀM ẨN:print(round(t(ci_cor_90), 3))## 5% 95%
## CORR_K_A -0.184 0.073
## CORR_K_B -0.280 -0.071
## CORR_K_P -0.052 0.199
## CORR_A_B -0.152 0.079
## CORR_A_P -0.138 0.101
## CORR_B_P -0.165 0.067cat("\n\n--- 2. CHẠY BOOTSTRAP THỦ CÔNG CHO HTMT (NỬA TRÊN BẢNG 6) ---\n")##
##
## --- 2. CHẠY BOOTSTRAP THỦ CÔNG CHO HTMT (NỬA TRÊN BẢNG 6) ---cat("Đang bốc mẫu 1000 lần cho HTMT (Sẽ mất khoảng 1-2 phút)...\n")## Đang bốc mẫu 1000 lần cho HTMT (Sẽ mất khoảng 1-2 phút)...# Viết vòng lặp bốc mẫu trực tiếp từ dữ liệu gốc
boot_htmt_func <- function(i) {
# Bốc mẫu ngẫu nhiên có hoàn lại
boot_idx <- sample(1:nrow(data_KABP_CFA), replace = TRUE)
boot_data <- data_KABP_CFA[boot_idx, ]
# Tính HTMT trên tập dữ liệu bốc mẫu
suppressWarnings({
h_mat <- htmt(model_htmt_4factors, data = boot_data, ordered = TRUE)
})
get_h <- function(v1, v2) {
val <- h_mat[v1, v2]
if(is.na(val)) val <- h_mat[v2, v1]
return(val)
}
c(
HTMT_K_A = get_h("Factor_K", "Factor_A"),
HTMT_K_B = get_h("Factor_K", "Factor_B"),
HTMT_K_P = get_h("Factor_K", "Factor_P"),
HTMT_A_B = get_h("Factor_A", "Factor_B"),
HTMT_A_P = get_h("Factor_A", "Factor_P"),
HTMT_B_P = get_h("Factor_B", "Factor_P")
)
}
# Tiến hành chạy đa luồng bằng lệnh mclapply chuyên biệt cho Mac
set.seed(2026)
htmt_results_list <- mclapply(1:1000, boot_htmt_func, mc.cores = 4)
# Gộp kết quả và tính bách phân vị
boot_htmt <- do.call(rbind, htmt_results_list)
ci_htmt_90 <- apply(boot_htmt, 2, quantile, probs = c(0.05, 0.95), na.rm = TRUE)
cat("\n=> KẾT QUẢ 90% CI CHO HTMT:\n")##
## => KẾT QUẢ 90% CI CHO HTMT:print(round(t(ci_htmt_90), 3))## 5% 95%
## HTMT_K_A 0.053 0.180
## HTMT_K_B 0.061 0.258
## HTMT_K_P 0.063 0.181
## HTMT_A_B 0.066 0.179
## HTMT_A_P 0.077 0.159
## HTMT_B_P 0.077 0.186cat("\n--- KẾT THÚC! BẠN ĐÃ CÓ THỂ LẬP BẢNG 6 HOÀN CHỈNH ---\n")##
## --- KẾT THÚC! BẠN ĐÃ CÓ THỂ LẬP BẢNG 6 HOÀN CHỈNH ---# ==============================================================================
# LẤY 90% CI CHO TƯƠNG QUAN BẰNG THUẬT TOÁN ROBUST CỦA LAVAAN (SIÊU NHANH)
# ==============================================================================
cat("\n--- BẢNG TƯƠNG QUAN VÀ KHOẢNG TIN CẬY 90% CI (DÙNG CHO NỬA DƯỚI BẢNG 6) ---\n")##
## --- BẢNG TƯƠNG QUAN VÀ KHOẢNG TIN CẬY 90% CI (DÙNG CHO NỬA DƯỚI BẢNG 6) ---# Lấy bộ thông số đã chuẩn hóa kèm theo 90% CI
std_results <- standardizedSolution(fit_4factors, ci = TRUE, level = 0.90)
# Lọc ra đúng các đường tương quan giữa K, A, B, P
cor_ci_table <- std_results[std_results$op == "~~" &
std_results$lhs != std_results$rhs &
std_results$lhs %in% c("Factor_K", "Factor_A", "Factor_B", "Factor_P") &
std_results$rhs %in% c("Factor_K", "Factor_A", "Factor_B", "Factor_P"),
c("lhs", "rhs", "est.std", "ci.lower", "ci.upper")]
# Hiển thị kết quả tuyệt đẹp
print(cor_ci_table)## lhs rhs est.std ci.lower ci.upper
## 134 Factor_K Factor_A -0.064 -0.189 0.062
## 135 Factor_K Factor_B -0.139 -0.271 -0.006
## 136 Factor_K Factor_P 0.067 -0.023 0.156
## 137 Factor_A Factor_B -0.047 -0.162 0.069
## 138 Factor_A Factor_P -0.042 -0.163 0.080
## 139 Factor_B Factor_P -0.058 -0.175 0.059# ==============================================================================
# BƯỚC 12: KIỂM ĐỊNH FORNELL-LARCKER VÀ KHOẢNG TIN CẬY 90% CI (LẬP BẢNG 5)
# ==============================================================================
library(lavaan)
library(semTools)
library(parallel)
cat("\n================ 1. TÍNH TOÁN GIÁ TRỊ GỐC (POINT ESTIMATE) ================\n")##
## ================ 1. TÍNH TOÁN GIÁ TRỊ GỐC (POINT ESTIMATE) ================# Lấy AVE và Ma trận tương quan từ mô hình 4 nhân tố (K, A, B, P)
ave_vals <- AVE(fit_4factors)
cor_mat <- inspect(fit_4factors, "cor.lv")
# Danh sách 6 cặp cần so sánh
pairs <- list(
c("Factor_K", "Factor_A"), c("Factor_K", "Factor_B"), c("Factor_K", "Factor_P"),
c("Factor_A", "Factor_B"), c("Factor_A", "Factor_P"), c("Factor_B", "Factor_P")
)
# In bảng giá trị gốc
cat(sprintf("%-20s | %-6s | %-10s | %-10s\n", "Construct Pair", "r2", "AVE1 - r2", "AVE2 - r2"))## Construct Pair | r2 | AVE1 - r2 | AVE2 - r2cat(rep("-", 55), "\n", sep="")## -------------------------------------------------------for (p in pairs) {
v1 <- p[1]; v2 <- p[2]
r2 <- cor_mat[v1, v2]^2
diff1 <- ave_vals[v1] - r2
diff2 <- ave_vals[v2] - r2
cat(sprintf("%-20s | %6.3f | %10.3f | %10.3f\n", paste0(v1," - ",v2), r2, diff1, diff2))
}## Factor_K - Factor_A | 0.004 | 0.708 | 0.717
## Factor_K - Factor_B | 0.019 | 0.693 | 0.520
## Factor_K - Factor_P | 0.004 | 0.708 | 0.579
## Factor_A - Factor_B | 0.002 | 0.719 | 0.537
## Factor_A - Factor_P | 0.002 | 0.720 | 0.582
## Factor_B - Factor_P | 0.003 | 0.536 | 0.581cat("\n================ 2. BOOTSTRAP 90% CI ================\n")##
## ================ 2. BOOTSTRAP 90% CI ================cat("Đang chạy 1000 lần bốc mẫu. Các mẫu lỗi sẽ tự động bị loại bỏ (Mất 1-2 phút)...\n")## Đang chạy 1000 lần bốc mẫu. Các mẫu lỗi sẽ tự động bị loại bỏ (Mất 1-2 phút)...boot_fornell <- function(i) {
boot_idx <- sample(1:nrow(data_KABP_CFA), replace = TRUE)
boot_data <- data_KABP_CFA[boot_idx, ]
# Màng bảo vệ tryCatch: Nếu lỗi thì trả về chuỗi NA, nếu thành công thì tính tiếp
tryCatch({
fit_b <- suppressWarnings(cfa(model_htmt_4factors, data = boot_data, ordered = TRUE, estimator = "WLSMV"))
ave_b <- AVE(fit_b)
cor_b <- inspect(fit_b, "cor.lv")
res <- c()
for (p in pairs) {
r2_b <- cor_b[p[1], p[2]]^2
res <- c(res, ave_b[p[1]] - r2_b, ave_b[p[2]] - r2_b)
}
return(res)
}, error = function(e) {
return(rep(NA, 12))
})
}
# Chạy đa luồng tối ưu cho chip Mac
set.seed(2026)
results_list <- mclapply(1:1000, boot_fornell, mc.cores = 4)
# Gộp kết quả
boot_df <- do.call(rbind, results_list)
# Tính bách phân vị 5% và 95%, na.rm = TRUE sẽ giúp R tự lờ đi các mẫu bị sập
ci_90 <- apply(boot_df, 2, quantile, probs = c(0.05, 0.95), na.rm = TRUE)
cat("\n=> KHOẢNG TIN CẬY 90% CI:\n")##
## => KHOẢNG TIN CẬY 90% CI:idx <- 1
for (p in pairs) {
cat(sprintf("\n--- Cặp %s ---\n", paste0(p[1], " - ", p[2])))
cat(sprintf("AVE1 - r2: (%.3f, %.3f)\n", ci_90[1, idx], ci_90[2, idx]))
cat(sprintf("AVE2 - r2: (%.3f, %.3f)\n", ci_90[1, idx+1], ci_90[2, idx+1]))
idx <- idx + 2
}##
## --- Cặp Factor_K - Factor_A ---
## AVE1 - r2: (0.637, 0.775)
## AVE2 - r2: (0.658, 0.767)
##
## --- Cặp Factor_K - Factor_B ---
## AVE1 - r2: (0.624, 0.761)
## AVE2 - r2: (0.444, 0.594)
##
## --- Cặp Factor_K - Factor_P ---
## AVE1 - r2: (0.645, 0.770)
## AVE2 - r2: (0.525, 0.631)
##
## --- Cặp Factor_A - Factor_B ---
## AVE1 - r2: (0.660, 0.772)
## AVE2 - r2: (0.458, 0.610)
##
## --- Cặp Factor_A - Factor_P ---
## AVE1 - r2: (0.659, 0.772)
## AVE2 - r2: (0.529, 0.638)
##
## --- Cặp Factor_B - Factor_P ---
## AVE1 - r2: (0.455, 0.609)
## AVE2 - r2: (0.525, 0.630)# ==============================================================================
# BƯỚC 4.2C: TRỊ DỨT ĐIỂM HEYWOOD CASE (ÉP TẢI VÀ PHƯƠNG SAI PHẦN DƯ)
# ==============================================================================
library(lavaan)
library(semPlot)
cat("\n--- 1. THIẾT LẬP MÔ HÌNH CFA BẬC 2 (ĐẶC TRỊ HEYWOOD) ---\n")##
## --- 1. THIẾT LẬP MÔ HÌNH CFA BẬC 2 (ĐẶC TRỊ HEYWOOD) ---model_hierarchical_ultimate <- '
# --- Cấu trúc bậc 1 ---
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# --- Cấu trúc bậc 2 (SỬA LỖI 1: ÉP HỆ SỐ TẢI BẰNG NHAU) ---
Factor_P =~ a*Factor_P1 + a*Factor_P2
# --- Cấu trúc bậc 2 (SỬA LỖI 2: ÉP PHƯƠNG SAI PHẦN DƯ BẰNG NHAU) ---
Factor_P1 ~~ v*Factor_P1
Factor_P2 ~~ v*Factor_P2
# --- Các ống Stent ---
R_P10 ~~ R_P9
R_P13 ~~ R_P14
R_P1 ~~ R_P8
'
# Chạy mô hình
fit_hierarchical_ultimate <- cfa(model_hierarchical_ultimate,
data = data_KABP_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 4.059508e-16)
## is close to zero. This may be a symptom that the model is not identified.cat("\n--- 2. KIỂM TRA LẠI HỆ SỐ TẢI BẬC 2 (CHUẨN HÓA) ---\n")##
## --- 2. KIỂM TRA LẠI HỆ SỐ TẢI BẬC 2 (CHUẨN HÓA) ---std_sol_ult <- standardizedSolution(fit_hierarchical_ultimate)
print(std_sol_ult[std_sol_ult$op == "=~" & std_sol_ult$lhs == "Factor_P",
c("lhs", "op", "rhs", "est.std", "pvalue")])## lhs op rhs est.std pvalue
## 25 Factor_P =~ Factor_P1 0.91 0
## 26 Factor_P =~ Factor_P2 0.91 0cat("\n--- 3. KIỂM TRA PHƯƠNG SAI PHẦN DƯ (KHÔNG ĐƯỢC ÂM) ---\n")##
## --- 3. KIỂM TRA PHƯƠNG SAI PHẦN DƯ (KHÔNG ĐƯỢC ÂM) ---print(std_sol_ult[std_sol_ult$op == "~~" & std_sol_ult$lhs %in% c("Factor_P1", "Factor_P2") & std_sol_ult$lhs == std_sol_ult$rhs,
c("lhs", "op", "rhs", "est.std", "pvalue")])## lhs op rhs est.std pvalue
## 27 Factor_P1 ~~ Factor_P1 0.173 0
## 28 Factor_P2 ~~ Factor_P2 0.173 0cat("\n--- 4. VẼ BIỂU ĐỒ BẬC 2 HOÀN CHỈNH ---\n")##
## --- 4. VẼ BIỂU ĐỒ BẬC 2 HOÀN CHỈNH ---png("CFA_Second_Order_Ultimate.png", width = 3500, height = 4500, res = 300)
semPaths(fit_hierarchical_ultimate,
what = "path",
whatLabels = "std",
layout = "tree",
rotation = 2,
sizeLat = 8, sizeMan = 4,
label.cex = 1.0,
edge.label.cex = 0.8,
edge.label.position = 0.6,
nCharNodes = 0,
curvePivot = FALSE,
curve = 2.5,
residuals = FALSE,
intercepts = FALSE,
thresholds = FALSE,
edge.color = "black",
color = list(lat = "#D0E8F2", man = "#F5F5F5"),
mar = c(5, 10, 5, 8)
)
dev.off()## quartz_off_screen
## 2cat("\n=> Xong! Hãy kiểm tra con số ở mục 2 và mở ảnh 'CFA_Second_Order_Ultimate.png' nhé!\n")##
## => Xong! Hãy kiểm tra con số ở mục 2 và mở ảnh 'CFA_Second_Order_Ultimate.png' nhé!# ==============================================================================
# KHAI BÁO MÔ HÌNH VÀ XUẤT BẢNG 2 (INITIAL VS FINAL) CHO KNITTING
# ==============================================================================
library(lavaan)
cat("\n--- 1. CHẠY MÔ HÌNH INITIAL (CHƯA CÓ STENT) ---\n")##
## --- 1. CHẠY MÔ HÌNH INITIAL (CHƯA CÓ STENT) ---model_hierarchical_initial <- '
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# Cấu trúc bậc 2 (Ép tải a* và phương sai v*)
Factor_P =~ a*Factor_P1 + a*Factor_P2
Factor_P1 ~~ v*Factor_P1
Factor_P2 ~~ v*Factor_P2
'
fit_initial <- cfa(model_hierarchical_initial, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 8.311062e-17)
## is close to zero. This may be a symptom that the model is not identified.cat("\n--- 2. CHẠY MÔ HÌNH FINAL (ĐÃ THÊM 3 ỐNG STENT) ---\n")##
## --- 2. CHẠY MÔ HÌNH FINAL (ĐÃ THÊM 3 ỐNG STENT) ---model_hierarchical_ultimate <- '
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# Cấu trúc bậc 2
Factor_P =~ a*Factor_P1 + a*Factor_P2
Factor_P1 ~~ v*Factor_P1
Factor_P2 ~~ v*Factor_P2
# 3 ống Stent
R_P10 ~~ R_P9
R_P13 ~~ R_P14
R_P1 ~~ R_P8
'
fit_hierarchical_ultimate <- cfa(model_hierarchical_ultimate, data = data_KABP_CFA, ordered = TRUE, estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 4.059508e-16)
## is close to zero. This may be a symptom that the model is not identified.cat("\n--- 3. ĐỊNH NGHĨA HÀM XUẤT BẢNG (SAFE MODE) ---\n")##
## --- 3. ĐỊNH NGHĨA HÀM XUẤT BẢNG (SAFE MODE) ---export_table2_safe <- function(fit_model, label) {
fm <- fitMeasures(fit_model)
get_val <- function(name) {
if(name %in% names(fm) && !is.na(fm[name])) return(round(fm[name], 3))
return("NA")
}
p_val <- if("pvalue" %in% names(fm)) fm["pvalue"] else NA
p_star <- if(!is.na(p_val) && p_val < 0.001) "*" else ""
chisq <- if("chisq" %in% names(fm) && !is.na(fm["chisq"])) round(fm["chisq"], 1) else "NA"
df <- if("df" %in% names(fm) && !is.na(fm["df"])) as.integer(fm["df"]) else "NA"
cfi <- get_val("cfi")
cfi_s <- get_val("cfi.scaled")
tli <- get_val("tli")
tli_s <- get_val("tli.scaled")
rmsea <- get_val("rmsea")
rmsea_l <- get_val("rmsea.ci.lower")
rmsea_u <- get_val("rmsea.ci.upper")
rmsea_s <- get_val("rmsea.scaled")
rmsea_ls <- get_val("rmsea.ci.lower.scaled")
rmsea_us <- get_val("rmsea.ci.upper.scaled")
srmr <- get_val("srmr")
cat(sprintf("\n--- KẾT QUẢ CHO %s ---\n", toupper(label)))
cat("Chỉ số | Standard | Robust (Scaled)\n")
cat("-----------------------------------------------------------\n")
cat(paste0("Chi-square (df) | ", chisq, "(", df, ")", p_star, " \t| -\n"))
cat(paste0("CFI | ", cfi, " \t\t| ", cfi_s, "\n"))
cat(paste0("TLI | ", tli, " \t\t| ", tli_s, "\n"))
cat(paste0("RMSEA (90% CI) | ", rmsea, " (", rmsea_l, "-", rmsea_u, ") \t| ",
rmsea_s, " (", rmsea_ls, "-", rmsea_us, ")\n"))
cat(paste0("SRMR | ", srmr, " \t\t| -\n"))
}
cat("\n--- 4. IN BẢNG BÁO CÁO NGHIỆM THU ---\n")##
## --- 4. IN BẢNG BÁO CÁO NGHIỆM THU ---export_table2_safe(fit_initial, "Initial CFA Model")##
## --- KẾT QUẢ CHO INITIAL CFA MODEL ---
## Chỉ số | Standard | Robust (Scaled)
## -----------------------------------------------------------
## Chi-square (df) | 282.9(246) | -
## CFI | 0.998 | 0.986
## TLI | 0.998 | 0.984
## RMSEA (90% CI) | 0.026 (0-0.039) | 0.042 (0.031-0.052)
## SRMR | 0.066 | -export_table2_safe(fit_hierarchical_ultimate, "Final CFA Model (With Stents)")##
## --- KẾT QUẢ CHO FINAL CFA MODEL (WITH STENTS) ---
## Chỉ số | Standard | Robust (Scaled)
## -----------------------------------------------------------
## Chi-square (df) | 232.3(243) | -
## CFI | 1 | 0.992
## TLI | 1.001 | 0.99
## RMSEA (90% CI) | 0 (0-0.023) | 0.033 (0.018-0.045)
## SRMR | 0.063 | -# ------------------------------------------------------------------------------
# 3. HÀM TỰ ĐỘNG XUẤT SỐ LIỆU CHUẨN TABLE 2 (PHIÊN BẢN CHỐNG LỖI NA)
# ------------------------------------------------------------------------------
export_table2_safe <- function(fit_model, label) {
fm <- fitMeasures(fit_model)
# Hàm phụ để lấy số an toàn: Nếu tính không được (NA) thì trả về chữ "NA"
get_val <- function(name) {
if(name %in% names(fm) && !is.na(fm[name])) return(round(fm[name], 3))
return("NA")
}
# Xử lý p-value an toàn để gắn dấu sao
p_val <- if("pvalue" %in% names(fm)) fm["pvalue"] else NA
p_star <- if(!is.na(p_val) && p_val < 0.001) "*" else ""
# Trích xuất các chỉ số
chisq <- if("chisq" %in% names(fm) && !is.na(fm["chisq"])) round(fm["chisq"], 1) else "NA"
df <- if("df" %in% names(fm) && !is.na(fm["df"])) as.integer(fm["df"]) else "NA"
cfi <- get_val("cfi")
cfi_s <- get_val("cfi.scaled")
tli <- get_val("tli")
tli_s <- get_val("tli.scaled")
rmsea <- get_val("rmsea")
rmsea_l <- get_val("rmsea.ci.lower")
rmsea_u <- get_val("rmsea.ci.upper")
rmsea_s <- get_val("rmsea.scaled")
rmsea_ls <- get_val("rmsea.ci.lower.scaled")
rmsea_us <- get_val("rmsea.ci.upper.scaled")
srmr <- get_val("srmr")
# In ra màn hình bằng lệnh paste0 để không bị lỗi định dạng
cat(sprintf("\n--- KẾT QUẢ CHO %s ---\n", toupper(label)))
cat("Chỉ số | Standard | Robust (Scaled)\n")
cat("-----------------------------------------------------------\n")
cat(paste0("Chi-square (df) | ", chisq, "(", df, ")", p_star, " \t| -\n"))
cat(paste0("CFI | ", cfi, " \t\t| ", cfi_s, "\n"))
cat(paste0("TLI | ", tli, " \t\t| ", tli_s, "\n"))
cat(paste0("RMSEA (90% CI) | ", rmsea, " (", rmsea_l, "-", rmsea_u, ") \t| ",
rmsea_s, " (", rmsea_ls, "-", rmsea_us, ")\n"))
cat(paste0("SRMR | ", srmr, " \t\t| -\n"))
}
# ------------------------------------------------------------------------------
# 4. IN KẾT QUẢ NGHIỆM THU (AN TOÀN)
# ------------------------------------------------------------------------------
# In bảng cho mô hình Initial
export_table2_safe(fit_initial, "Initial CFA Model")##
## --- KẾT QUẢ CHO INITIAL CFA MODEL ---
## Chỉ số | Standard | Robust (Scaled)
## -----------------------------------------------------------
## Chi-square (df) | 282.9(246) | -
## CFI | 0.998 | 0.986
## TLI | 0.998 | 0.984
## RMSEA (90% CI) | 0.026 (0-0.039) | 0.042 (0.031-0.052)
## SRMR | 0.066 | -# In bảng cho mô hình Final của bạn
export_table2_safe(fit_hierarchical_ultimate, "Final CFA Model (With Stents)")##
## --- KẾT QUẢ CHO FINAL CFA MODEL (WITH STENTS) ---
## Chỉ số | Standard | Robust (Scaled)
## -----------------------------------------------------------
## Chi-square (df) | 232.3(243) | -
## CFI | 1 | 0.992
## TLI | 1.001 | 0.99
## RMSEA (90% CI) | 0 (0-0.023) | 0.033 (0.018-0.045)
## SRMR | 0.063 | -# ==============================================================================
# CHẠY MÔ HÌNH CFA BẬC 2 BAN ĐẦU (KHÔNG STENT, THẢ TỰ DO HOÀN TOÀN)
# ==============================================================================
library(lavaan)
model_initial_unconstrained <- '
# --- Cấu trúc bậc 1 (24 câu hỏi) ---
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# --- Cấu trúc bậc 2 (THẢ TỰ DO: Không dùng a* và v*) ---
Factor_P =~ Factor_P1 + Factor_P2
# (Lưu ý: Không có bất kỳ đường Stent ~~ nào ở đây)
'
# Chạy mô hình thả tự do
fit_initial_unconstrained <- cfa(model_initial_unconstrained,
data = data_KABP_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 7.269648e-17)
## is close to zero. This may be a symptom that the model is not identified.## Warning: lavaan->lav_object_post_check():
## some estimated lv variances are negativecat("\n--- TOÀN BỘ KẾT QUẢ MÔ HÌNH BAN ĐẦU (THẢ TỰ DO) ---\n")##
## --- TOÀN BỘ KẾT QUẢ MÔ HÌNH BAN ĐẦU (THẢ TỰ DO) ---summary(fit_initial_unconstrained, fit.measures = TRUE, standardized = TRUE)## Warning: lavaan->lav_object_post_check():
## some estimated lv variances are negative
## Warning: lavaan->lav_object_post_check():
## some estimated lv variances are negative## lavaan 0.6-21 ended normally after 68 iterations
##
## Estimator DWLS
## Optimization method NLMINB
## Number of model parameters 113
##
## Number of observations 220
##
## Model Test User Model:
## Standard Scaled
## Test Statistic 249.907 319.151
## Degrees of freedom 244 244
## P-value (Unknown) NA 0.001
## Scaling correction factor 1.258
## Shift parameter 120.573
## simple second-order correction
##
## Model Test Baseline Model:
##
## Test statistic 18416.833 7167.504
## Degrees of freedom 276 276
## P-value NA 0.000
## Scaling correction factor 2.632
##
## User Model versus Baseline Model:
##
## Comparative Fit Index (CFI) 1.000 0.989
## Tucker-Lewis Index (TLI) 1.000 0.988
##
## Robust Comparative Fit Index (CFI) 0.911
## Robust Tucker-Lewis Index (TLI) 0.899
##
## Root Mean Square Error of Approximation:
##
## RMSEA 0.011 0.038
## 90 Percent confidence interval - lower 0.000 0.025
## 90 Percent confidence interval - upper 0.030 0.048
## P-value H_0: RMSEA <= 0.050 1.000 0.971
## P-value H_0: RMSEA >= 0.080 0.000 0.000
##
## Robust RMSEA 0.083
## 90 Percent confidence interval - lower 0.068
## 90 Percent confidence interval - upper 0.098
## P-value H_0: Robust RMSEA <= 0.050 0.001
## P-value H_0: Robust RMSEA >= 0.080 0.638
##
## Standardized Root Mean Square Residual:
##
## SRMR 0.064 0.064
##
## Parameter Estimates:
##
## Parameterization Delta
## Standard errors Robust.sem
## Information Expected
## Information saturated (h1) model Unstructured
##
## Latent Variables:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_K =~
## R_K6 1.000 0.875 0.875
## R_K7 1.031 0.039 26.474 0.000 0.903 0.903
## R_K8 1.045 0.035 29.573 0.000 0.915 0.915
## R_K9 0.749 0.053 14.165 0.000 0.655 0.655
## Factor_A =~
## R_A3 1.000 0.810 0.810
## R_A6 1.061 0.041 26.112 0.000 0.859 0.859
## R_A7 1.149 0.041 27.793 0.000 0.930 0.930
## R_A8 0.885 0.051 17.409 0.000 0.717 0.717
## R_A9 1.066 0.050 21.423 0.000 0.863 0.863
## R_A10 1.111 0.047 23.708 0.000 0.900 0.900
## Factor_B =~
## R_B3 1.000 0.512 0.512
## R_B4 1.597 0.170 9.409 0.000 0.818 0.818
## R_B5 1.668 0.203 8.217 0.000 0.854 0.854
## R_B6 1.375 0.162 8.484 0.000 0.704 0.704
## Factor_P1 =~
## R_P13 1.000 0.893 0.893
## R_P10 0.911 0.034 26.903 0.000 0.814 0.814
## R_P14 0.983 0.034 28.708 0.000 0.878 0.878
## R_P9 0.834 0.047 17.904 0.000 0.745 0.745
## R_P12 1.009 0.028 35.473 0.000 0.901 0.901
## R_P11 0.841 0.035 23.784 0.000 0.751 0.751
## Factor_P2 =~
## R_P2 1.000 0.701 0.701
## R_P1 1.019 0.078 12.990 0.000 0.714 0.714
## R_P7 1.016 0.081 12.566 0.000 0.712 0.712
## R_P8 1.090 0.089 12.284 0.000 0.764 0.764
## Factor_P =~
## Factor_P1 1.000 0.789 0.789
## Factor_P2 1.074 0.738 1.455 0.146 1.080 1.080
##
## Covariances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## Factor_K ~~
## Factor_A -0.045 0.054 -0.829 0.407 -0.064 -0.064
## Factor_B -0.062 0.038 -1.631 0.103 -0.139 -0.139
## Factor_P 0.045 0.041 1.094 0.274 0.073 0.073
## Factor_A ~~
## Factor_B -0.019 0.029 -0.664 0.507 -0.047 -0.047
## Factor_P -0.024 0.047 -0.513 0.608 -0.042 -0.042
## Factor_B ~~
## Factor_P -0.025 0.029 -0.873 0.383 -0.069 -0.069
##
## Thresholds:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## R_K6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_K6|t2 -0.674 0.092 -7.325 0.000 -0.674 -0.674
## R_K6|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_K7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_K7|t2 -0.265 0.086 -3.091 0.002 -0.265 -0.265
## R_K7|t3 1.855 0.166 11.171 0.000 1.855 1.855
## R_K8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_K8|t2 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_K8|t3 -0.337 0.086 -3.894 0.000 -0.337 -0.337
## R_K8|t4 1.740 0.153 11.410 0.000 1.740 1.740
## R_K9|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_K9|t2 -0.385 0.087 -4.428 0.000 -0.385 -0.385
## R_K9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A3|t1 -1.740 0.153 -11.410 0.000 -1.740 -1.740
## R_A3|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A3|t3 1.562 0.135 11.542 0.000 1.562 1.562
## R_A6|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A6|t2 -0.422 0.087 -4.828 0.000 -0.422 -0.422
## R_A6|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A7|t1 -2.000 0.187 -10.716 0.000 -2.000 -2.000
## R_A7|t2 -0.349 0.087 -4.028 0.000 -0.349 -0.349
## R_A7|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_A8|t1 -1.855 0.166 -11.171 0.000 -1.855 -1.855
## R_A8|t2 0.034 0.085 0.404 0.687 0.034 0.034
## R_A8|t3 1.691 0.147 11.477 0.000 1.691 1.691
## R_A9|t1 -2.093 0.202 -10.350 0.000 -2.093 -2.093
## R_A9|t2 -0.398 0.087 -4.561 0.000 -0.398 -0.398
## R_A9|t3 1.335 0.119 11.245 0.000 1.335 1.335
## R_A10|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_A10|t2 -0.218 0.085 -2.554 0.011 -0.218 -0.218
## R_A10|t3 1.424 0.125 11.425 0.000 1.424 1.424
## R_B3|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_B3|t2 -0.926 0.099 -9.324 0.000 -0.926 -0.926
## R_B3|t3 0.980 0.101 9.675 0.000 0.980 0.980
## R_B4|t1 -1.184 0.110 -10.742 0.000 -1.184 -1.184
## R_B4|t2 0.398 0.087 4.561 0.000 0.398 0.398
## R_B4|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_B5|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B5|t2 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_B5|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_B5|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_B6|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_B6|t2 -1.231 0.113 -10.926 0.000 -1.231 -1.231
## R_B6|t3 0.460 0.088 5.226 0.000 0.460 0.460
## R_B6|t4 2.609 0.342 7.622 0.000 2.609 2.609
## R_P13|t1 -2.362 0.262 -9.030 0.000 -2.362 -2.362
## R_P13|t2 -1.161 0.109 -10.646 0.000 -1.161 -1.161
## R_P13|t3 0.435 0.088 4.961 0.000 0.435 0.435
## R_P13|t4 2.362 0.262 9.030 0.000 2.362 2.362
## R_P10|t1 -1.489 0.129 -11.506 0.000 -1.489 -1.489
## R_P10|t2 0.242 0.086 2.823 0.005 0.242 0.242
## R_P10|t3 1.795 0.159 11.311 0.000 1.795 1.795
## R_P14|t1 -1.256 0.114 -11.012 0.000 -1.256 -1.256
## R_P14|t2 0.460 0.088 5.226 0.000 0.460 0.460
## R_P14|t3 2.000 0.187 10.716 0.000 2.000 2.000
## R_P9|t1 -1.562 0.135 -11.542 0.000 -1.562 -1.562
## R_P9|t2 0.126 0.085 1.480 0.139 0.126 0.126
## R_P9|t3 1.489 0.129 11.506 0.000 1.489 1.489
## R_P12|t1 -2.208 0.225 -9.827 0.000 -2.208 -2.208
## R_P12|t2 -1.282 0.116 -11.095 0.000 -1.282 -1.282
## R_P12|t3 0.313 0.086 3.627 0.000 0.313 0.313
## R_P12|t4 2.093 0.202 10.350 0.000 2.093 2.093
## R_P11|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P11|t2 -1.097 0.106 -10.340 0.000 -1.097 -1.097
## R_P11|t3 0.511 0.089 5.756 0.000 0.511 0.511
## R_P11|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P2|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P2|t2 -1.525 0.132 -11.530 0.000 -1.525 -1.525
## R_P2|t3 -0.011 0.085 -0.135 0.893 -0.011 -0.011
## R_P2|t4 1.691 0.147 11.477 0.000 1.691 1.691
## R_P1|t1 -1.335 0.119 -11.245 0.000 -1.335 -1.335
## R_P1|t2 0.349 0.087 4.028 0.000 0.349 0.349
## R_P1|t3 1.922 0.175 10.979 0.000 1.922 1.922
## R_P7|t1 -1.922 0.175 -10.979 0.000 -1.922 -1.922
## R_P7|t2 -0.998 0.102 -9.790 0.000 -0.998 -0.998
## R_P7|t3 0.361 0.087 4.161 0.000 0.361 0.361
## R_P7|t4 2.208 0.225 9.827 0.000 2.208 2.208
## R_P8|t1 -2.609 0.342 -7.622 0.000 -2.609 -2.609
## R_P8|t2 -1.363 0.121 -11.312 0.000 -1.363 -1.363
## R_P8|t3 0.277 0.086 3.225 0.001 0.277 0.277
## R_P8|t4 2.093 0.202 10.350 0.000 2.093 2.093
##
## Variances:
## Estimate Std.Err z-value P(>|z|) Std.lv Std.all
## .R_K6 0.234 0.234 0.234
## .R_K7 0.185 0.185 0.185
## .R_K8 0.163 0.163 0.163
## .R_K9 0.571 0.571 0.571
## .R_A3 0.344 0.344 0.344
## .R_A6 0.262 0.262 0.262
## .R_A7 0.135 0.135 0.135
## .R_A8 0.486 0.486 0.486
## .R_A9 0.255 0.255 0.255
## .R_A10 0.191 0.191 0.191
## .R_B3 0.738 0.738 0.738
## .R_B4 0.332 0.332 0.332
## .R_B5 0.271 0.271 0.271
## .R_B6 0.504 0.504 0.504
## .R_P13 0.202 0.202 0.202
## .R_P10 0.338 0.338 0.338
## .R_P14 0.229 0.229 0.229
## .R_P9 0.445 0.445 0.445
## .R_P12 0.188 0.188 0.188
## .R_P11 0.435 0.435 0.435
## .R_P2 0.509 0.509 0.509
## .R_P1 0.490 0.490 0.490
## .R_P7 0.494 0.494 0.494
## .R_P8 0.416 0.416 0.416
## Factor_K 0.766 0.040 19.358 0.000 1.000 1.000
## Factor_A 0.656 0.048 13.595 0.000 1.000 1.000
## Factor_B 0.262 0.057 4.616 0.000 1.000 1.000
## .Factor_P1 0.302 0.338 0.893 0.372 0.378 0.378
## .Factor_P2 -0.081 0.388 -0.210 0.834 -0.166 -0.166
## Factor_P 0.496 0.341 1.456 0.146 1.000 1.000# ==============================================================================
# MÔ HÌNH CFA FINAL (BẢN CHỐT HẠ): CÓ STENT + ÉP TẢI & PHƯƠNG SAI BẬC 2
# ==============================================================================
library(lavaan)
library(semTools)
# 1. THIẾT LẬP MÔ HÌNH
model_ultimate_final <- '
# --- Cấu trúc bậc 1 (K, A, B, P1, P2) ---
Factor_K =~ R_K6 + R_K7 + R_K8 + R_K9
Factor_A =~ R_A3 + R_A6 + R_A7 + R_A8 + R_A9 + R_A10
Factor_B =~ R_B3 + R_B4 + R_B5 + R_B6
Factor_P1 =~ R_P13 + R_P10 + R_P14 + R_P9 + R_P12 + R_P11
Factor_P2 =~ R_P2 + R_P1 + R_P7 + R_P8
# --- Cấu trúc bậc 2 (Ép tải a* và phương sai v* để chống Heywood) ---
Factor_P =~ a*Factor_P1 + a*Factor_P2
Factor_P1 ~~ v*Factor_P1
Factor_P2 ~~ v*Factor_P2
# --- Các ống Stent (Hiệp phương sai sai số) dựa trên Modification Indices ---
R_P10 ~~ R_P9
R_P13 ~~ R_P14
R_P1 ~~ R_P8
'
# 2. CHẠY MÔ HÌNH
fit_ultimate <- cfa(model_ultimate_final,
data = data_KABP_CFA,
ordered = TRUE,
estimator = "WLSMV")## Warning: lavaan->lav_model_vcov():
## The variance-covariance matrix of the estimated parameters (vcov) does not
## appear to be positive definite! The smallest eigenvalue (= 4.059508e-16)
## is close to zero. This may be a symptom that the model is not identified.# 3. TRÍCH XUẤT CÁC CHỈ SỐ FIT CHO BẢNG 2 (BẢN SAFE CHỐNG LỖI NA)
fm <- fitMeasures(fit_ultimate)
p_star <- if(!is.na(fm["pvalue"]) && fm["pvalue"] < 0.001) "*" else ""
cat("\n================ DỮ LIỆU LẬP BẢNG 2 (MÔ HÌNH FINAL) ================\n")##
## ================ DỮ LIỆU LẬP BẢNG 2 (MÔ HÌNH FINAL) ================cat(sprintf("Chi-square (df) | Standard: %.1f(%d)%s \t| Robust: -\n",
fm["chisq"], as.integer(fm["df"]), p_star))## Chi-square (df) | Standard: 232.3(243) | Robust: -cat(sprintf("CFI | Standard: %.3f \t\t| Robust: %.3f\n",
fm["cfi"], fm["cfi.scaled"]))## CFI | Standard: 1.000 | Robust: 0.992cat(sprintf("TLI | Standard: %.3f \t\t| Robust: %.3f\n",
fm["tli"], fm["tli.scaled"]))## TLI | Standard: 1.001 | Robust: 0.990cat(sprintf("RMSEA (90%% CI) | Standard: %.3f (%.3f-%.3f) | Robust: %.3f (%.3f-%.3f)\n",
fm["rmsea"], fm["rmsea.ci.lower"], fm["rmsea.ci.upper"],
fm["rmsea.scaled"], fm["rmsea.ci.lower.scaled"], fm["rmsea.ci.upper.scaled"]))## RMSEA (90% CI) | Standard: 0.000 (0.000-0.023) | Robust: 0.033 (0.018-0.045)cat(sprintf("SRMR | Standard: %.3f \t\t| Robust: -\n",
fm["srmr"]))## SRMR | Standard: 0.063 | Robust: -# 4. TRÍCH XUẤT CR VÀ AVE (CHO CÁC NHÂN TỐ BẬC 1)
cat("\n================ ĐỘ TIN CẬY VÀ GIÁ TRỊ HỘI TỤ ================\n")##
## ================ ĐỘ TIN CẬY VÀ GIÁ TRỊ HỘI TỤ ================suppressWarnings({
rel_final <- reliability(fit_ultimate)
cat("\n--- Chỉ số CR (Omega) ---\n")
print(round(rel_final["omega", ], 3))
cat("\n--- Chỉ số AVE ---\n")
print(round(rel_final["avevar", ], 3))
})## For constructs with categorical indicators, Zumbo et al.`s (2007) "ordinal alpha" is calculated in addition to the standard alpha, which treats ordinal variables as numeric. See Chalmers (2018) for a critique of "alpha.ord" and the response by Zumbo & Kroc (2019). Likewise, average variance extracted is calculated from polychoric (polyserial) not Pearson correlations.##
## --- Chỉ số CR (Omega) ---
## Factor_K Factor_A Factor_B Factor_P1 Factor_P2
## 0.822 0.890 0.754 0.853 0.821
##
## --- Chỉ số AVE ---
## Factor_K Factor_A Factor_B Factor_P1 Factor_P2
## 0.712 0.721 0.539 0.656 0.595# 5. IN RA CÁC HỆ SỐ TẢI ĐỂ KIỂM TRA LẦN CUỐI
cat("\n================ HỆ SỐ TẢI CHUẨN HÓA (STANDARDIZED LOADINGS) ================\n")##
## ================ HỆ SỐ TẢI CHUẨN HÓA (STANDARDIZED LOADINGS) ================standardizedSolution(fit_ultimate) %>%
filter(op == "=~") %>%
select(lhs, rhs, est.std, pvalue) %>%
print()## lhs rhs est.std pvalue
## 1 Factor_K R_K6 0.875 0
## 2 Factor_K R_K7 0.902 0
## 3 Factor_K R_K8 0.915 0
## 4 Factor_K R_K9 0.656 0
## 5 Factor_A R_A3 0.810 0
## 6 Factor_A R_A6 0.859 0
## 7 Factor_A R_A7 0.930 0
## 8 Factor_A R_A8 0.717 0
## 9 Factor_A R_A9 0.863 0
## 10 Factor_A R_A10 0.900 0
## 11 Factor_B R_B3 0.512 0
## 12 Factor_B R_B4 0.818 0
## 13 Factor_B R_B5 0.854 0
## 14 Factor_B R_B6 0.704 0
## 15 Factor_P1 R_P13 0.801 0
## 16 Factor_P1 R_P10 0.794 0
## 17 Factor_P1 R_P14 0.822 0
## 18 Factor_P1 R_P9 0.716 0
## 19 Factor_P1 R_P12 0.941 0
## 20 Factor_P1 R_P11 0.767 0
## 21 Factor_P2 R_P2 0.801 0
## 22 Factor_P2 R_P1 0.760 0
## 23 Factor_P2 R_P7 0.724 0
## 24 Factor_P2 R_P8 0.799 0
## 25 Factor_P Factor_P1 0.910 0
## 26 Factor_P Factor_P2 0.910 0