Validasi skala keterlibatan pelanggan tiga dimensi pada komunitas merek

# Contoh kode R: Confirmatory Factor Analysis (CFA)
suppressPackageStartupMessages({
  library(ggplot2)
  library(patchwork)
  library(lavaan)
})
set.seed(42)
# ---- Gaya grafik ----
pal <- c("#1f6feb", "#e8590c", "#2f9e44", "#ae3ec9", "#f59f00")
warna <- list(bg = "#f4f6fa", panel = "#ffffff", teks = "#1f2933", redup = "#5f6b78", grid = "#e3e8ee", bar = "#1d3557")
tata <- 1
theme_set(theme_minimal(base_size = 11) + theme(legend.position = "bottom"))

# ---- Data sintetis: instrumen 12 butir Likert 1-5, tiga dimensi (4 butir per dimensi) ----
n <- 200
rho <- runif(3, 0.3, 0.6)                                       # korelasi antardimensi
R <- matrix(c(1, rho[1], rho[2], rho[1], 1, rho[3], rho[2], rho[3], 1), 3)
eta <- matrix(rnorm(n * 3), n) %*% chol(R)                      # skor laten berkorelasi
likert <- function(e, k) {
  sapply(seq_len(k), function(j) {
    l <- runif(1, 0.68, 0.92)
    s <- l * e + rnorm(length(e), 0, sqrt(1 - l^2))
    findInterval(s, sort(c(-2, -1.1, -0.2, 0.9) + runif(1, -0.3, 0.2))) + 1
  })
}
d <- data.frame(likert(eta[, 1], 4), likert(eta[, 2], 4), likert(eta[, 3], 4))
names(d) <- c(paste0("cognitive_engagement", "_", 1:4), paste0("affective_engagement", "_", 1:4), paste0("behavioural_engagement", "_", 1:4))
write.csv(d, "data_contoh.csv", row.names = FALSE)

# ---- CFA tiga faktor berkorelasi ----
model <- paste0(
  "cognitive_engagement =~ ", paste(names(d)[1:4], collapse = " + "), "\n",
  "affective_engagement =~ ", paste(names(d)[5:8], collapse = " + "), "\n",
  "behavioural_engagement =~ ", paste(names(d)[9:12], collapse = " + "), "\n")
fit <- cfa(model, data = d, estimator = "MLR", std.lv = TRUE)
print(summary(fit, fit.measures = TRUE, standardized = TRUE))
fm <- fitMeasures(fit, c("cfi.robust", "tli.robust", "rmsea.robust", "srmr", "cfi", "tli", "rmsea", "chisq.scaled", "df", "pvalue.scaled"))
pilih <- function(r, s) if (is.finite(fm[[r]])) fm[[r]] else fm[[s]]
idx <- c(CFI = pilih("cfi.robust", "cfi"), TLI = pilih("tli.robust", "tli"),
         RMSEA = pilih("rmsea.robust", "rmsea"), SRMR = fm[["srmr"]])
print(round(idx, 3))

# ---- Validitas konvergen (AVE), reliabilitas komposit (CR), validitas diskriminan ----
ss <- standardizedSolution(fit)
muat <- ss[ss$op == "=~", c("lhs", "rhs", "est.std", "pvalue")]
fak <- c("cognitive_engagement", "affective_engagement", "behavioural_engagement")
ave <- sapply(fak, function(f) mean(muat$est.std[muat$lhs == f]^2))
cr <- sapply(fak, function(f) { l <- muat$est.std[muat$lhs == f]; sum(l)^2 / (sum(l)^2 + sum(1 - l^2)) })
kor <- lavInspect(fit, "cor.lv")[fak, fak]                      # korelasi antarfaktor
fl <- kor; diag(fl) <- sqrt(ave)                                # matriks Fornell-Larcker
print(round(rbind(AVE = ave, CR = cr), 3)); print(round(fl, 3))
diskr <- all(sqrt(ave) > apply(abs(kor - diag(3)), 1, max))     # akar AVE > korelasi dengan faktor lain


# ---- Grafik ----
singkat <- function(s, w = 18) {                                # nama dimensi pendek untuk grafik
  k <- strsplit(s, " ")[[1]]
  if (nchar(s) > w) k <- k[!tolower(k) %in% c("of", "to", "the", "and", "for", "in", "on", "with")]
  i <- length(k)
  while (nchar(paste(k, collapse = " ")) > w && i >= 1) {
    if (nchar(k[i]) > 5) k[i] <- paste0(substr(k[i], 1, 4), ".")
    i <- i - 1
  }
  substr(paste(k, collapse = " "), 1, w)
}
nm_k <- make.unique(unname(sapply(c("cognitive_engagement", "affective_engagement", "behavioural_engagement"), singkat)), sep = " ")
muat$dimensi <- factor(nm_k[match(muat$lhs, fak)], levels = nm_k)
muat$butir <- paste0(rep(c("D1.", "D2.", "D3."), each = 4), rep(1:4, 3))
muat$butir <- factor(muat$butir, levels = rev(muat$butir))
p1 <- ggplot(muat, aes(est.std, butir, fill = dimensi)) +
  annotate("rect", xmin = 0, xmax = 0.5, ymin = -Inf, ymax = Inf, fill = warna$grid, alpha = 0.6) +
  geom_col(width = 0.68) +
  geom_vline(xintercept = c(0.5, 0.7), linetype = c("dotted", "dashed"), colour = warna$teks) +
  geom_text(aes(label = sprintf("%.2f", est.std)), hjust = -0.2, size = 2.8, colour = warna$teks) +
  scale_fill_manual(values = pal[1:3], name = NULL) +
  scale_x_continuous(limits = c(0, 1.08), breaks = seq(0, 1, 0.25)) +
  labs(title = "Standardised loadings (cut-offs 0.5 / 0.7)", x = "Loading", y = NULL)
lab3 <- paste0("D", 1:3)
dh <- expand.grid(a = lab3, b = lab3)
dh$nilai <- as.vector(fl)
dh$jenis <- ifelse(dh$a == dh$b, "sqrt(AVE)", "Correlation")
dh$b <- factor(dh$b, levels = rev(lab3))
p2 <- ggplot(dh, aes(a, b, fill = nilai)) +
  geom_tile(colour = warna$panel, linewidth = 1.2) +
  geom_text(aes(label = sprintf("%.2f", nilai), fontface = ifelse(jenis == "sqrt(AVE)", "bold", "plain")),
            colour = warna$panel, size = 3.6) +
  scale_fill_gradient(low = pal[4], high = pal[1], limits = c(0, 1), guide = "none") +
  labs(title = "Fornell-Larcker (diagonal = sqrt AVE)", x = NULL, y = NULL,
       subtitle = paste(strwrap(paste0(lab3, " = ", nm_k, collapse = "; "), 48), collapse = "\n"))
df <- data.frame(ukuran = factor(c(names(idx), paste("AVE", lab3), paste("CR", lab3)),
                                 levels = c(names(idx), paste("AVE", lab3), paste("CR", lab3))),
                 nilai = c(unname(idx), ave, cr),
                 grup = rep(c("Fit index", "AVE", "CR"), c(4, 3, 3)))
df$lolos <- ifelse(df$ukuran %in% c("RMSEA", "SRMR"), df$nilai <= 0.08,
                   ifelse(df$grup == "AVE", df$nilai >= 0.5, ifelse(df$grup == "CR", df$nilai >= 0.7, df$nilai >= 0.9)))
df$ukuran <- factor(df$ukuran, levels = rev(levels(df$ukuran)))
p3 <- ggplot(df, aes(nilai, ukuran, fill = lolos)) +
  geom_col(width = 0.65) +
  geom_text(aes(label = sprintf("%.3f", nilai)), hjust = -0.15, size = 2.7, colour = warna$teks) +
  scale_fill_manual(values = c(`TRUE` = pal[3], `FALSE` = pal[2]), labels = c(`TRUE` = "Meets cut-off", `FALSE` = "Below cut-off"),
                    name = NULL, drop = FALSE) +
  scale_x_continuous(limits = c(0, 1.18), breaks = seq(0, 1, 0.25)) +
  labs(title = "Fit, convergent validity and reliability", x = "Value", y = NULL)
p_hasil <- if (tata == 1) p1 | (p2 / p3) else (p1 | p2) / p3

print(p_hasil)