This vignette demonstrates the complete FAPA workflow using a pre-treatment / post-treatment Eating Disorder Inventory-2 (EDI-2) dataset. The data comprise 2,599 clinical cases, each described by 22 subscale scores (11 pre-treatment + 11 post-treatment administrations of the 11 EDI-2 subscales: Drive for Thinness, Bulimia, Body Dissatisfaction, Ineffectiveness, Perfectionism, Interpersonal Distrust, Interoceptive Awareness, Maturity Fears, Asceticism, Impulse Regulation, and Social Insecurity).
## ---- paths and labels -------------------------------------------------------
data_path <- "Calibration.csv" # replace with your own path
out_prefix <- "fapa"
## ---- analysis parameters ----------------------------------------------------
seed <- 1
B_boot <- 2000
alpha <- 0.05
angle_thresh <- 30 # Stage 2: principal angle stability bound (degrees)
cc_thresh <- 0.85 # Stage 3: Tucker CC acceptability lower bound
K_extra <- 3 # extra dimensions beyond K_pa for verification contrast
participants <- 1:5 # row IDs for individual-level bootstrap inference
## ---- EDI-2 variable labels --------------------------------------------------
edi_tags <- c("Dt","Bu","Bd","In","Pf","Id","Ia","Mf","As","Ir","Si")
before_labels <- paste0("Before_", 1:11, "_", edi_tags)
after_labels <- paste0("After_", 12:22, "_", edi_tags)
testname <- c(before_labels, after_labels)dat <- load_and_ipsatize(data_path, col_labels = testname)
raw <- dat$raw
Xtilde <- dat$ipsatized
message(sprintf("%d persons x %d variables", nrow(Xtilde), ncol(Xtilde)))Variance-matched parallel analysis determines the number of
components to retain. Random matrices are row-centred and rescaled to
the same Frobenius norm as Xtilde before comparison,
ensuring the null distribution is appropriate for ipsatized data.
set.seed(seed)
pa_result <- fapa_pa(Xtilde, B = B_boot, alpha = alpha, seed = seed)
print_pa(pa_result)
plot_pa_scree(pa_result)
K_pa <- pa_result$n_retain
K_max <- length(pa_result$obs_sv2)
K_report <- min(K_pa + K_extra, K_max)fit_fapa <- fapa_core(Xtilde, K = K_pa)
cat(sprintf("Total ipsatized variance : %.2f\n", fit_fapa$total_var))
cat("Proportion explained :",
paste(round(fit_fapa$prop_var, 4), collapse = " "), "\n")
cat("Cumulative proportion :",
paste(round(fit_fapa$cum_var, 4), collapse = " "), "\n")For each of B bootstrap resamples, the K principal angles between the
bootstrap and original right singular vector subspaces are computed. All
angles must fall below angle_thresh for a replicate to be
declared stable.
pr_result <- fapa_procrustes(Xtilde, K = K_report, B = B_boot,
angle_thresh = angle_thresh, seed = seed)
print_procrustes(pr_result, K_pa = K_pa)
plot_principal_angles(pr_result)Tucker’s CC is computed between each original core profile and its bootstrap counterpart, with sign ambiguity resolved by maximising the absolute CC before storage.
tc_result <- fapa_tucker(Xtilde, K = K_report, B = B_boot,
cc_thresh = cc_thresh, seed = seed)
print_tucker(tc_result, cc_thresh = cc_thresh, K_pa = K_pa)
plot_tucker_cc(tc_result, cc_thresh = cc_thresh)bca_result <- fapa_bca(Xtilde, K = K_pa, B = B_boot,
alpha = alpha, seed = seed)
## Plot each retained core profile
for (k in seq_len(K_pa))
plot_fapa_core(bca_result, i = k, split_at = 11)
## Person overlay for participant 1
if (K_pa >= 2)
plot_person_match(bca_result, Xtilde, p = 1, K = min(2, K_pa))person_result <- fapa_person(Xtilde, fit_fapa,
participants = participants,
B_boot = B_boot, alpha = alpha, seed = seed)
cat(sprintf("Mean person R² : %.4f\n", person_result$R2_mean))## Correlation of CP1 with subscale grand means
cp1 <- fit_fapa$X[, 1]
cor_cp1_means <- cor(colMeans(raw), cp1)
message(sprintf("cor(grand means, CP1) = %.3f", cor_cp1_means))
if (abs(cor_cp1_means) > 0.70)
message("NOTE: CP1 may reflect the normative symptom gradient.")
## Write CSVs
write_fapa_results(bca_result, prefix = out_prefix)
write_verification(pa_result, pr_result, tc_result,
prefix = out_prefix, K_pa = K_pa)
write.csv(person_result$weights,
file = paste0(out_prefix, "_PersonWeights.csv"),
row.names = FALSE)sessionInfo()
#> R version 4.6.1 (2026-06-24)
#> Platform: x86_64-pc-linux-gnu
#> Running under: Ubuntu 26.04 LTS
#>
#> Matrix products: default
#> BLAS: /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3
#> LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.32.so; LAPACK version 3.12.0
#>
#> locale:
#> [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
#> [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
#> [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
#> [7] LC_PAPER=en_US.UTF-8 LC_NAME=C
#> [9] LC_ADDRESS=C LC_TELEPHONE=C
#> [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
#>
#> time zone: Etc/UTC
#> tzcode source: system (glibc)
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] FAPA_0.1.1 rmarkdown_2.31
#>
#> loaded via a namespace (and not attached):
#> [1] digest_0.6.39 R6_2.6.1 fastmap_1.2.0 xfun_0.60
#> [5] maketools_1.3.2 cachem_1.1.0 knitr_1.51 htmltools_0.5.9
#> [9] buildtools_1.0.0 lifecycle_1.0.5 cli_3.6.6 sass_0.4.10
#> [13] jquerylib_0.1.4 compiler_4.6.1 sys_3.4.3 tools_4.6.1
#> [17] evaluate_1.0.5 bslib_0.11.0 yaml_2.3.12 otel_0.2.0
#> [21] jsonlite_2.0.0 rlang_1.3.0