The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.
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.5.2 (2025-10-31)
#> Platform: aarch64-apple-darwin20
#> Running under: macOS Tahoe 26.3.1
#>
#> Matrix products: default
#> BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
#> LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.1
#>
#> locale:
#> [1] C/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
#>
#> time zone: America/New_York
#> tzcode source: internal
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] FAPA_0.1.1
#>
#> loaded via a namespace (and not attached):
#> [1] digest_0.6.39 R6_2.6.1 fastmap_1.2.0 xfun_0.52
#> [5] cachem_1.1.0 knitr_1.50 htmltools_0.5.8.1 rmarkdown_2.30
#> [9] lifecycle_1.0.4 cli_3.6.5 sass_0.4.10 jquerylib_0.1.4
#> [13] compiler_4.5.2 rstudioapi_0.17.1 tools_4.5.2 evaluate_1.0.5
#> [17] bslib_0.9.0 yaml_2.3.10 rlang_1.1.6 jsonlite_2.0.0These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.