R Under development (unstable) (2024-09-18 r87177 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # library(Qval) > # library(CDM) > # library(openxlsx) > # > # iter.max <- 1 > # > # # ########################### PISA 2000 ################################## > # data_names <- "PISA2000" > # Q_original <- as.matrix(data.pisa00R.ct$q.matrix)[, -c(7, 8)] > # Y <- as.matrix(data.pisa00R.ct$data[, 5:30]) > # Y[, c(7, 12, 13)][which(Y[, c(7, 12, 13)] < 2)] <- 0 > # Y[, c(7, 12, 13)][which(Y[, c(7, 12, 13)] > 1)] <- 1 > # > # J <- nrow(Q_original) > # K <- ncol(Q_original) > # > # CDM_obj <- CDM(Y, Q_original, model="GDINA", method="BM", mono.constr = TRUE, verbose=1) > # > # GDI_ESA <- validation(Y, Q_original, CDM.obj=CDM_obj, model="GDINA", method="GDI", search.method="ESA", maxitr=iter.max) > # GDI_PAA <- validation(Y, Q_original, CDM.obj=CDM_obj, model="GDINA", method="GDI", search.method="PAA", maxitr=iter.max) > # > # Hull_ESA <- validation(Y, Q_original, CDM.obj=CDM_obj, model="GDINA", method="Hull", search.method="ESA", maxitr=iter.max) > # Hull_PAA <- validation(Y, Q_original, CDM.obj=CDM_obj, model="GDINA", method="Hull", search.method="PAA", maxitr=iter.max) > # > # MLR_ESA <- validation(Y, Q_original, CDM.obj=CDM_obj, model="GDINA", method="MLR-B", search.method="ESA", maxitr=iter.max) > # MLR_PAA <- validation(Y, Q_original, CDM.obj=CDM_obj, model="GDINA", method="MLR-B", search.method="PAA", maxitr=iter.max) > # > # model <- c("GDINA") > # fit_names <- c("npar", "-2LL", "AIC", "BIC", "CAIC", "SABIC", > # "M2", "df", "M2.P", "RMSEA2", "SRMSR", "rate") > # fit_original <- > # fit_GDI_ESA <- fit_GDI_PAA <- > # fit_Hull_ESA <- fit_Hull_PAA <- > # fit_MLR_ESA <- fit_MLR_PAA <- rep(0, length(fit_names)) > # > # cat("model:", model, "\n") > # > # cat("original\n") > # fit_original <- c(fit(Y, Q_original, model), sum(abs(Q_original-Q_original))/(J*K)) > # > # cat("GDI ESA\n") > # fit_GDI_ESA <- c(fit(Y, GDI_ESA$Q.sug, model), sum(abs(GDI_ESA$Q.sug-Q_original))/(J*K)) > # cat("GDI PAA\n") > # fit_GDI_PAA <- c(fit(Y, GDI_PAA$Q.sug, model), sum(abs(GDI_PAA$Q.sug-Q_original))/(J*K)) > # > # cat("Hull ESA\n") > # fit_Hull_ESA <- c(fit(Y, Hull_ESA$Q.sug, model), sum(abs(Hull_ESA$Q.sug-Q_original))/(J*K)) > # cat("Hull PAA\n") > # fit_Hull_PAA <- c(fit(Y, Hull_PAA$Q.sug, model), sum(abs(Hull_PAA$Q.sug-Q_original))/(J*K)) > # > # cat("MLR ESA\n") > # fit_MLR_ESA <- c(fit(Y, MLR_ESA$Q.sug, model), sum(abs(MLR_ESA$Q.sug-Q_original))/(J*K)) > # cat("MLR PAA\n") > # fit_MLR_PAA <- c(fit(Y, MLR_PAA$Q.sug, model), sum(abs(MLR_PAA$Q.sug-Q_original))/(J*K)) > # > # fit_obj <- rbind(unlist(fit_original), unlist(fit_GDI_ESA), unlist(fit_GDI_PAA), unlist(fit_Hull_ESA), > # unlist(fit_Hull_PAA), unlist(fit_MLR_ESA), unlist(fit_MLR_PAA)) > # colnames(fit_obj) <- fit_names > # rownames(fit_obj) <- c("original", "GDI-ESA", "GDI-PAA", "Hull-ESA", "Hull-PAA", "MLR-ESA", "MLR-PAA") > # print(round(fit_obj, 3)) > # > # sum(abs(MLR_PAA$Q.sug - Q_original)) > # > # Q_matrix <- list(Q_original=Q_original, > # GDI_ESA=GDI_ESA$Q.sug, GDI_PAA=GDI_PAA$Q.sug, > # Hull_ESA=Hull_ESA$Q.sug, Hull_PAA=Hull_PAA$Q.sug, > # MLR_ESA=MLR_ESA$Q.sug, MLR_PAA=MLR_PAA$Q.sug) > # QRR <- matrix(0, length(Q_matrix), length(Q_matrix)) > # rownames(QRR) <- colnames(QRR) <- c("original", paste0("GDI-", c("ESA", "PAA")), > # paste0("Hull-", c("ESA", "PAA")), paste0("MLR-", c("ESA", "PAA"))) > # for(q in 1:length(Q_matrix)){ > # for(qq in 1:length(Q_matrix)) > # QRR[q, qq] <- zQRR(Q_matrix[[q]], Q_matrix[[qq]]) > # } > # > # wb <- createWorkbook() > # addWorksheet(wb, "fit index") > # addWorksheet(wb, "original") > # addWorksheet(wb, "GDI-ESA") > # addWorksheet(wb, "GDI-PAA") > # addWorksheet(wb, "Hull-ESA") > # addWorksheet(wb, "Hull-PAA") > # addWorksheet(wb, "MLR-ESA") > # addWorksheet(wb, "MLR-PAA") > # addWorksheet(wb, "QRR") > # writeData(wb, "fit index", as.table(fit_obj)) > # writeData(wb, "original", as.table(Q_original)) > # writeData(wb, "GDI-ESA", as.table(GDI_ESA$Q.sug)) > # writeData(wb, "GDI-PAA", as.table(GDI_PAA$Q.sug)) > # writeData(wb, "Hull-ESA", as.table(Hull_ESA$Q.sug)) > # writeData(wb, "Hull-PAA", as.table(Hull_PAA$Q.sug)) > # writeData(wb, "MLR-ESA", as.table(MLR_ESA$Q.sug)) > # writeData(wb, "MLR-PAA", as.table(MLR_PAA$Q.sug)) > # writeData(wb, "QRR", as.table(QRR)) > # saveWorkbook(wb, paste0("results_realdata_", data_names, ".xlsx"),overwrite = TRUE) > # > > proc.time() user system elapsed 0.17 0.07 0.23