# Clear workspace
rm(list = ls())
# Load packages
suppressPackageStartupMessages({
library("here")
library("openxlsx")
})
# Load performance indicators
<- readRDS(here::here("data", "simind.rds")) pind
The performance indicators for each condition are restructured in a table format and exported to various excel files saved to “./tables”.
#
# Export evaluation criteria to Excel file
#
# @param x names of evaluation criteria
# @param file file path
#
<- function(var, file, crit = NULL, crit_type = "interval",
write_xlsx digits = 0, mce = FALSE) {
# Create new workbook
<- openxlsx::createWorkbook("Simulation of MASEM")
wb
# Create sheet with legend
<- data.frame(
legend Variable = c("", "No", "Yes", "",
"a_M", "a_W", "b_M", "b_W",
"c", "Indirect", "",
"TSMASEM1", "TSMASEM2", "OSMASEM1", "OSMASEM2", ""),
Description =
c("",
"No adjustments for unreliability",
"All variables adjusted for unreliability",
"",
"Effect of X on M",
"Effect of X on W (for parallel mediation)",
"Effect of M on Y",
"Effect of W on Y (for parallel mediation)",
"Effect of X on Y",
"Indirect effect of X on Y via M and W",
"",
"Two-stage MASEM with adjustments of sample correlations",
"Two-stage MASEM with adjustments of pooled correlations",
"One-stage MASEM with adjustments of sample correlations",
"One-stage MASEM with adjustments of implied correlations",
"")
)if (!is.null(crit)) {
if (crit_type == "interval") {
<- paste0("Bold values indicate estimates for which the ",
txt "95% jackknife interval includes ",
".")
crit, else {
} <- paste0("Bold values indicate estimates for which the ",
txt "upper bound of the 95% jackknife interval ",
"is smaller than ", crit, ".")
}<- rbind(
legend
legend,data.frame(Variable = "", Description = txt)
)
}::addWorksheet(wb, "Legend", gridLines = TRUE)
openxlsx::writeData(
openxlsx
wb, sheet = "Legend",
legend, rowNames = FALSE,
keepNA = FALSE
)::setColWidths(wb, sheet = "Legend", cols = 1, widths = 15)
openxlsx::setColWidths(wb, sheet = "Legend", cols = 2, widths = 50)
openxlsx<- createStyle(
bodyStyle fontSize = 12,
halign = "center",
numFmt = "TEXT"
)::addStyle(
openxlsx
wb, sheet = "Legend",
bodyStyle, rows = 1:20,
cols = 1,
gridExpand = TRUE
)<- createStyle(
bodyStyle fontSize = 12,
halign = "left",
numFmt = "TEXT"
)::addStyle(
openxlsx
wb, sheet = "Legend",
bodyStyle, rows = 1:20,
cols = 2,
gridExpand = TRUE
)<- createStyle(
headerStyle fontSize = 12,
halign = "center",
border = "TopBottom",
textDecoration = "bold"
)::addStyle(
openxlsx
wb, sheet = "Legend",
headerStyle,rows = 1,
cols = 1:2,
gridExpand = TRUE
)
# Create results tables
<- function(models, bound = NULL) {
.get_tab <- lapply(pind, \(x) {
y if (mce) {
<- paste0(var, "_err")
est else {
} <- ifelse(is.null(bound), var, paste0(var, "_", bound))
est
}<- x[[est]][models, ]
x if (!(paste0(var, "_WONX") %in% colnames(x)))
paste0(var, "_WONX")]] <- NA
x[[if (!(paste0(var, "_YONW") %in% colnames(x)))
paste0(var, "_YONW")]] <- NA
x[[if (!(paste0(var, "_YONM") %in% colnames(x)))
paste0(var, "_YONM")]] <- NA
x[[<- t(x[, paste0(var, c("_MONX", "_WONX", "_YONM",
x "_YONW", "_YONX", "_IND"))])
rownames(x) <- c("a_M", "a_W", "b_M", "b_W", "c", "Indirect")
colnames(x) <- c("No", "Yes")
<- data.frame(Effect = rownames(x), x)
x
x
})<- Reduce(rbind, y[paste0("simple", 1:6)])
y1 <- Reduce(rbind, y[paste0("parallel", 1:6)])
y2 <- Reduce(rbind, y[paste0("sequential", 1:6)])
y3 return(cbind(y1, y2, y3))
}<- function(models) {
.get_sig <- abs(crit)
crit <- .get_tab(models, bound = "lb")
lb <- .get_tab(models, bound = "ub")
ub <- lb
z for (i in seq_len(ncol(z))[-c(1, 4, 7)]) {
for (j in seq_len(nrow(z))) {
<- c(abs(lb[j, i]), abs(ub[j, i]))
bnds_ if (all(!is.na(bnds_))) {
if (crit_type == "interval") {
<- (crit > min(bnds_)) & (crit < max(bnds_))
z[j, i] else {
} <- all(crit > bnds_)
z[j, i]
}
}
}
}return(z)
}<- list(
tabs TSMASEM1 = .get_tab(c("a", "b")),
TSMASEM2 = .get_tab(c("a", "c")),
OSMASEM1 = .get_tab(c("d", "e")),
OSMASEM2 = .get_tab(c("d", "f"))
)if (!is.null(crit)) {
<- list(
z TSMASEM1 = .get_sig(c("a", "b")),
TSMASEM2 = .get_sig(c("a", "c")),
OSMASEM1 = .get_sig(c("d", "e")),
OSMASEM2 = .get_sig(c("d", "f"))
)
}
# Create sheet for each MASEM method
for (i in names(tabs)) {
# Add data to worksheet
::addWorksheet(wb, i, gridLines = TRUE)
openxlsx::writeData(
openxlsx
wb, sheet = i,
tabs[[i]], startRow = 2,
startCol = 2,
colNames = TRUE,
rowNames = FALSE,
keepNA = FALSE
)
# Format data
if (digits > 0) {
<- paste0("0.", paste(rep("0", digits), collapse = ""))
numFmt else {
} <- "0"
numFmt
}<- openxlsx::createStyle(
bodyStyle fontSize = 12,
halign = "center",
numFmt = numFmt
)::addStyle(
openxlsx
wb, sheet = i,
bodyStyle, rows = 3:1000,
cols = c(3:4, 6:7, 9:10),
gridExpand = TRUE
)
# Format significance
if (!is.null(crit)) {
<- openxlsx::createStyle(
bodyStyle fontSize = 12,
halign = "center",
numFmt = numFmt,
textDecoration = "bold"
)for (k in seq_len(ncol(z[[i]]))) {
for (j in seq_len(nrow(z[[i]]))) {
if (z[[i]][j, k] %in% "1") {
::addStyle(
openxlsx
wb, sheet = i,
bodyStyle, rows = j + 2,
cols = k + 1,
gridExpand = TRUE
)
}
}
}
}
# Add first row of headings
::writeData(
openxlsx
wb, sheet = i,
data.frame(
"Simple mediation", "", "",
"Parallel mediation", "", "",
"Sequential mediation", "", ""
), startCol = 2,
colNames = FALSE,
rowNames = FALSE,
keepNA = FALSE
)::mergeCells(wb, i, cols = 2:4, rows = 1)
openxlsx::mergeCells(wb, i, cols = 5:7, rows = 1)
openxlsx::mergeCells(wb, i, cols = 8:10, rows = 1)
openxlsx
# Add first column of headings
::writeData(
openxlsx
wb, sheet = i,
c(
"Low reliability", "", "", "", "", "",
"High reliability", "", "", "", "", "",
"Small indirect effect", "", "", "", "", "",
"Large indirect effect", "", "", "", "", "",
"Small a-path", "", "", "", "", "",
"Large a-path", "", "", "", "", ""
), startRow = 3,
colNames = FALSE,
rowNames = FALSE,
keepNA = FALSE
)::mergeCells(wb, i, cols = 1, rows = 3:8)
openxlsx::mergeCells(wb, i, cols = 1, rows = 9:14)
openxlsx::mergeCells(wb, i, cols = 1, rows = 15:20)
openxlsx::mergeCells(wb, i, cols = 1, rows = 21:26)
openxlsx::mergeCells(wb, i, cols = 1, rows = 27:32)
openxlsx::mergeCells(wb, i, cols = 1, rows = 33:38)
openxlsx
# Format second row of headings
<- openxlsx::createStyle(
headerStyle fontSize = 12,
halign = "center",
border = "TopBottom",
textDecoration = "bold"
)::addStyle(
openxlsx
wb, sheet = i,
headerStyle, rows = 2,
cols = 1:10,
gridExpand = TRUE
)
# Format first row and column of headings
<- openxlsx::createStyle(
headerStyle fontSize = 12,
halign = "center",
valign = "center"
)::addStyle(
openxlsx
wb, sheet = i,
headerStyle, rows = c(1, 3:1000),
cols = c(1, 2, 5, 8),
gridExpand = TRUE
)
# Set col widths
::setColWidths(wb, sheet = i, cols = 2:20, widths = 15)
openxlsx::setColWidths(wb, sheet = i, cols = 1, widths = 20)
openxlsx
}::saveWorkbook(wb, file = file, overwrite = TRUE)
openxlsx
}
#
# Export rates of convergence errors to Excel file
#
# @param file file path
#
<- function(file) {
write_err
# Create new workbook
<- openxlsx::createWorkbook("Simulation of MASEM")
wb
# Convergence errors
<- t(sapply(pind, \(x) colMeans(x$err)))
x <- x[, grepl("(0|1)[a-f]$", colnames(x))]
x colnames(x) <- c("No adjustements",
"Individual correlations",
"Pooled correlations",
"No adjustments",
"Individual correlations",
"Implied correlations")
# Add data to worksheet
::addWorksheet(wb, "Convergence rate", gridLines = TRUE)
openxlsx::writeData(
openxlsx
wb, sheet = 1,
x, startRow = 2,
startCol = 3,
colNames = TRUE,
rowNames = FALSE,
keepNA = FALSE
)
# Format data
<- openxlsx::createStyle(
bodyStyle fontSize = 12,
halign = "center",
numFmt = "0.0"
)::addStyle(
openxlsx
wb, sheet = 1,
bodyStyle, rows = 2:1000,
cols = 3:20,
gridExpand = TRUE
)
# Add first row of heading
::writeData(
openxlsx
wb, sheet = 1,
data.frame(
"TSMASEM", "", "",
"OSMASEM", "", ""
), startCol = 3,
colNames = FALSE,
rowNames = FALSE,
keepNA = FALSE
)::mergeCells(wb, 1, cols = 3:5, rows = 1)
openxlsx::mergeCells(wb, 1, cols = 6:8, rows = 1)
openxlsx
# Add first column of headings
::writeData(
openxlsx
wb, sheet = 1,
c("Simple mediation", "", "", "", "", "",
"Parallel mediation", "", "", "", "", "",
"Sequential mediation", "", "", "", "", ""),
startRow = 3,
startCol = 1,
colNames = FALSE,
rowNames = FALSE,
keepNA = FALSE
)::mergeCells(wb, 1, cols = 1, rows = 3:8)
openxlsx::mergeCells(wb, 1, cols = 1, rows = 9:14)
openxlsx::mergeCells(wb, 1, cols = 1, rows = 15:20)
openxlsx
# Add second column of headings
::writeData(
openxlsx
wb, sheet = 1,
rep(c("Low reliability",
"High reliability",
"Small indirect effect",
"Large indirect effect",
"Small a-path",
"Large a-path"), 3),
startRow = 3,
startCol = 2,
colNames = FALSE,
rowNames = FALSE,
keepNA = FALSE
)
# Format second row of headings
<- openxlsx::createStyle(
headerStyle fontSize = 12,
halign = "center",
border = "TopBottom",
textDecoration = "bold"
)::addStyle(
openxlsx
wb, sheet = 1,
headerStyle, rows = 2,
cols = 1:8,
gridExpand = TRUE
)
# Format first row and column of headings
<- openxlsx::createStyle(
headerStyle fontSize = 12,
halign = "center",
valign = "center"
)::addStyle(
openxlsx
wb, sheet = 1,
headerStyle, cols = c(1, 2),
rows = 3:100,
gridExpand = TRUE
)::addStyle(
openxlsx
wb, sheet = 1,
headerStyle, cols = 1:100,
rows = 1,
gridExpand = TRUE
)
# Set column widths
::setColWidths(wb, sheet = 1, cols = 1:20, widths = 25)
openxlsx
# Save results
::saveWorkbook(wb, file = file, overwrite = TRUE)
openxlsx }
# Raw bias
write_xlsx(
"bias",
file = here::here("tables", "raw_bias.xlsx"),
digits = 2
)write_xlsx(
"bias",
file = here::here("tables", "raw_bias_mce.xlsx"),
digits = 3,
mce = TRUE
)
# Percent bias
write_xlsx(
"pbias",
file = here::here("tables", "percent_bias.xlsx"),
crit = 5,
crit_type = "below",
digits = 0
)write_xlsx(
"pbias",
file = here::here("tables", "percent_bias_mce.xlsx"),
digits = 2,
mce = TRUE
)
# Root mean squared error
write_xlsx(
"rmse",
file = here::here("tables", "rmse.xlsx"),
digits = 2
)write_xlsx(
"rmse",
file = here::here("tables", "rmse_mce.xlsx"),
digits = 3,
mce = TRUE
)
# Coverage
write_xlsx(
"co",
file = here::here("tables", "coverage.xlsx"),
digits = 0,
crit = 95,
crit_type = "interval"
)write_xlsx(
"co",
file = here::here("tables", "coverage_mce.xlsx"),
digits = 2,
mce = TRUE
)
# Convergence errors
write_err(here::here("tables", "convergence.xlsx"))