# Clear workspace
rm(list = ls())

# Load packages
suppressPackageStartupMessages({
  library("here")
  library("openxlsx")
})

# Load performance indicators
pind <- readRDS(here::here("data", "simind.rds"))

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
#
write_xlsx <- function(var, file, crit = NULL, crit_type = "interval", 
                       digits = 0, mce = FALSE) {
  
  # Create new workbook
  wb <- openxlsx::createWorkbook("Simulation of MASEM")
  
  # Create sheet with legend
  legend <- data.frame(
    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") {
      txt <- paste0("Bold values indicate estimates for which the ",
                    "95% jackknife interval includes ", 
                    crit, ".")
    } else {
      txt <- paste0("Bold values indicate estimates for which the ",
                    "upper bound of the 95% jackknife interval ",
                    "is smaller than ", crit, ".")
    }
    legend <- rbind(
      legend,
      data.frame(Variable = "", Description = txt)
    )
  }
  openxlsx::addWorksheet(wb, "Legend", gridLines = TRUE)
  openxlsx::writeData(
    wb, 
    sheet = "Legend", 
    legend, 
    rowNames = FALSE, 
    keepNA = FALSE
  )
  openxlsx::setColWidths(wb, sheet = "Legend", cols = 1, widths = 15) 
  openxlsx::setColWidths(wb, sheet = "Legend", cols = 2, widths = 50) 
  bodyStyle <- createStyle(
    fontSize = 12, 
    halign = "center", 
    numFmt = "TEXT"
  )
  openxlsx::addStyle(
    wb, 
    sheet = "Legend",
    bodyStyle, 
    rows = 1:20, 
    cols = 1, 
    gridExpand = TRUE
  )
  bodyStyle <- createStyle(
    fontSize = 12,
    halign = "left",
    numFmt = "TEXT"
  )
  openxlsx::addStyle(
    wb, 
    sheet = "Legend", 
    bodyStyle, 
    rows = 1:20, 
    cols = 2,
    gridExpand = TRUE
  )
  headerStyle <- createStyle(
    fontSize = 12, 
    halign = "center", 
    border = "TopBottom", 
    textDecoration = "bold"
  )
  openxlsx::addStyle(
    wb, 
    sheet = "Legend", 
    headerStyle,
    rows = 1, 
    cols = 1:2, 
    gridExpand = TRUE
  )
  
  # Create results tables
  .get_tab <- function(models, bound = NULL) {
    y <- lapply(pind, \(x) {
      if (mce) {
        est <- paste0(var, "_err")
      } else {
        est <- ifelse(is.null(bound), var, paste0(var, "_", bound))
      }
      x <- x[[est]][models, ]
      if (!(paste0(var, "_WONX") %in% colnames(x))) 
        x[[paste0(var, "_WONX")]] <- NA
      if (!(paste0(var, "_YONW") %in% colnames(x))) 
        x[[paste0(var, "_YONW")]] <- NA
      if (!(paste0(var, "_YONM") %in% colnames(x))) 
        x[[paste0(var, "_YONM")]] <- NA
      x <- t(x[, paste0(var, c("_MONX", "_WONX", "_YONM", 
                               "_YONW", "_YONX", "_IND"))])
      rownames(x) <- c("a_M", "a_W", "b_M", "b_W", "c", "Indirect")
      colnames(x) <- c("No", "Yes")
      x <- data.frame(Effect = rownames(x), x)
      x
    })
    y1 <- Reduce(rbind, y[paste0("simple", 1:6)])
    y2 <- Reduce(rbind, y[paste0("parallel", 1:6)])
    y3 <- Reduce(rbind, y[paste0("sequential", 1:6)])
    return(cbind(y1, y2, y3))
  }
  .get_sig <- function(models) {
    crit <- abs(crit)
    lb <- .get_tab(models, bound = "lb")
    ub <- .get_tab(models, bound = "ub")
    z <- lb
    for (i in seq_len(ncol(z))[-c(1, 4, 7)]) {
      for (j in seq_len(nrow(z))) {
        bnds_ <- c(abs(lb[j, i]), abs(ub[j, i]))
        if (all(!is.na(bnds_))) {
          if (crit_type == "interval")  {
            z[j, i] <- (crit > min(bnds_)) & (crit < max(bnds_))
          } else {
            z[j, i] <- all(crit > bnds_)
          }
        }
      }
    }
    return(z)
  }
  tabs <- list(
    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)) {
    z <-  list(
      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
    openxlsx::addWorksheet(wb, i, gridLines = TRUE)
    openxlsx::writeData(
      wb, 
      sheet = i, 
      tabs[[i]], 
      startRow = 2,
      startCol = 2,
      colNames = TRUE,
      rowNames = FALSE, 
      keepNA = FALSE
    )
    
    # Format data
    if (digits > 0) {
      numFmt <- paste0("0.", paste(rep("0", digits), collapse = ""))
    } else {
      numFmt <- "0"
    }
    bodyStyle <- openxlsx::createStyle(
      fontSize = 12, 
      halign = "center",
      numFmt = numFmt
    )
    openxlsx::addStyle(
      wb, 
      sheet = i, 
      bodyStyle, 
      rows = 3:1000, 
      cols = c(3:4, 6:7, 9:10), 
      gridExpand = TRUE
    )
      
    # Format significance
    if (!is.null(crit)) {
      bodyStyle <- openxlsx::createStyle(
        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") {
            openxlsx::addStyle(
              wb, 
              sheet = i, 
              bodyStyle, 
              rows = j + 2,
              cols = k + 1, 
              gridExpand = TRUE
            )
          }
        }
      }
    }

    # Add first row of headings
    openxlsx::writeData(
      wb, 
      sheet = i, 
      data.frame(
        "Simple mediation", "", "",
        "Parallel mediation", "", "", 
        "Sequential mediation", "", ""
      ), 
      startCol = 2,
      colNames = FALSE,
      rowNames = FALSE, 
      keepNA = FALSE
    )
    openxlsx::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)
    
    # Add first column of headings
    openxlsx::writeData(
      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
    )
    openxlsx::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)
    
    # Format second row of headings
    headerStyle <- openxlsx::createStyle(
      fontSize = 12, 
      halign = "center", 
      border = "TopBottom", 
      textDecoration = "bold"
    )
    openxlsx::addStyle(
      wb, 
      sheet = i, 
      headerStyle, 
      rows = 2,
      cols = 1:10,
      gridExpand = TRUE
    )
    
    # Format first row and column of headings

    headerStyle <- openxlsx::createStyle(
      fontSize = 12, 
      halign = "center",
      valign = "center"
    )
    openxlsx::addStyle(
      wb, 
      sheet = i, 
      headerStyle, 
      rows = c(1, 3:1000),
      cols = c(1, 2, 5, 8),
      gridExpand = TRUE
    )
      
    # Set col widths
    openxlsx::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)
}


# 
# Export rates of convergence errors to Excel file
#
# @param file    file path
#
write_err <- function(file) {
  
  # Create new workbook
  wb <- openxlsx::createWorkbook("Simulation of MASEM")
  
  # Convergence errors
  x <- t(sapply(pind, \(x) colMeans(x$err)))
  x <- x[, grepl("(0|1)[a-f]$", colnames(x))]
  colnames(x) <- c("No adjustements", 
                   "Individual correlations", 
                   "Pooled correlations",
                   "No adjustments", 
                   "Individual correlations", 
                   "Implied correlations")
  
  # Add data to worksheet
  openxlsx::addWorksheet(wb, "Convergence rate", gridLines = TRUE)
  openxlsx::writeData(
    wb, 
    sheet = 1, 
    x, 
    startRow = 2,
    startCol = 3,
    colNames = TRUE,
    rowNames = FALSE, 
    keepNA = FALSE
  )
  
  # Format data
  bodyStyle <- openxlsx::createStyle(
    fontSize = 12, 
    halign = "center",
    numFmt = "0.0"
  )
  openxlsx::addStyle(
    wb, 
    sheet = 1, 
    bodyStyle, 
    rows = 2:1000, 
    cols = 3:20, 
    gridExpand = TRUE
  )
  
  # Add first row of heading
  openxlsx::writeData(
    wb, 
    sheet = 1, 
    data.frame(
      "TSMASEM", "", "", 
      "OSMASEM", "", ""
    ), 
    startCol = 3,
    colNames = FALSE,
    rowNames = FALSE, 
    keepNA = FALSE
  )
  openxlsx::mergeCells(wb, 1, cols = 3:5, rows = 1)
  openxlsx::mergeCells(wb, 1, cols = 6:8, rows = 1)
  
  # Add first column of headings
  openxlsx::writeData(
    wb, 
    sheet = 1, 
    c("Simple mediation", "", "", "", "", "",
      "Parallel mediation", "", "", "", "", "",
      "Sequential mediation", "", "", "", "", ""), 
    startRow = 3,
    startCol = 1,
    colNames = FALSE,
    rowNames = FALSE, 
    keepNA = FALSE
  )
  openxlsx::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)
  
  # Add second column of headings
  openxlsx::writeData(
    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
  headerStyle <- openxlsx::createStyle(
    fontSize = 12, 
    halign = "center", 
    border = "TopBottom", 
    textDecoration = "bold"
  )
  openxlsx::addStyle(
    wb, 
    sheet = 1, 
    headerStyle, 
    rows = 2,
    cols = 1:8,
    gridExpand = TRUE
  )
  
  # Format first row and column of headings
  headerStyle <- openxlsx::createStyle(
    fontSize = 12, 
    halign = "center",
    valign = "center"
  )
  openxlsx::addStyle(
    wb, 
    sheet = 1, 
    headerStyle, 
    cols = c(1, 2),
    rows = 3:100,
    gridExpand = TRUE
  )
  openxlsx::addStyle(
    wb, 
    sheet = 1, 
    headerStyle, 
    cols = 1:100,
    rows = 1,
    gridExpand = TRUE
  )
  
  # Set column widths
  openxlsx::setColWidths(wb, sheet = 1, cols = 1:20, widths = 25)
  
  # Save results
  openxlsx::saveWorkbook(wb, file = file, overwrite = TRUE)
}

1 Generated tables

# 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"))