## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 5 ) ## ----setup-------------------------------------------------------------------- library(ggplot2) library(dplyr) library(F2Adonis2) ## ----------------------------------------------------------------------------- ################################################################################ # F2Adonis2 Vignette: Univariate Validation and Welch's F Comparison ################################################################################ library(ggplot2) library(dplyr) library(vegan) library(F2Adonis2) library(onewaytests) # ============================================================================== # 1. Simulate three unbalanced groups, same means, different variances: # ============================================================================== set.seed(93939) Xf <- factor(c(rep("Lev1", 15), rep("Lev2", 10), rep("Lev3", 5))) y1 <- rnorm(n = 30, mean = rep(0, 30), sd = 20 * as.numeric(Xf)) df1 <- data.frame(y1, Xf) # Visualize the heterogeneity (The Behrens-Fisher Problem) df1 %>% ggplot(aes(x = Xf, y = y1, fill = Xf)) + geom_violin(alpha = 0.3) + geom_point() + theme_minimal() + labs(title = "Simulation: Same Means, Heterogeneous Variance") # Standard ANOVA - Strong evidence (p=0.031) because it is biased by the variance anova(lm(y1 ~ Xf, data = df1)) # ============================================================================== # 2. Welch's F-test and Permutational Null # ============================================================================== welch_res <- oneway.test(y1 ~ Xf, data = df1) print(welch_res) get_welch_f <- function(y, groups) { oneway.test(y ~ groups)$statistic } # Generate Permutational Null Distribution for Welch's F set.seed(123) n_perm <- 99 welch_obs <- get_welch_f(y1, Xf) welch_perms <- replicate(n_perm, { get_welch_f(y1, sample(Xf)) }) p_welch_perm <- (sum(welch_perms >= welch_obs) + 1) / (n_perm + 1) cat("Permutational Welch's F p-value:", p_welch_perm, "\n") ## ----eval = FALSE------------------------------------------------------------- # # ============================================================================== # # 3. F2 (F2Adonis2) Univariate Implementation & Manual Null Capture # # ============================================================================== # # Get Observed F2 - Using permutations = 1 to avoid subscript errors # set.seed(123) # fit_f2 <- F2_adonis2(y1 ~ Xf, data = df1, method = "euclidean", permutations = 1, plot.dist = FALSE) # f2_obs <- fit_f2["Model", "F2"] # # # Manually capture the F2 null distribution by shuffling labels and calling # # F2_adonis2() with permutations = 1 for each shuffle # cat("Generating F2 null distribution...\n") # set.seed(123) # f2_perms <- numeric(n_perm) # # for(i in 1:n_perm) { # shuffled_df <- df1 # shuffled_df$Xf <- sample(df1$Xf) # # tmp <- F2_adonis2(y1 ~ Xf, data = shuffled_df, method = "euclidean", permutations = 1, plot.dist = FALSE) # f2_perms[i] <- tmp["Model", "F2"] # } # # # ============================================================================== # # 4. Compare Percentiles and Distributions # # ============================================================================== # perc_welch <- mean(welch_perms <= welch_obs, na.rm = TRUE) # perc_f2 <- mean(f2_perms <= f2_obs, na.rm = TRUE) # # cat("\n--- Comparison of Observed Quantiles ---\n") # cat(sprintf("Welch's F Observed Percentile: %.4f\n", perc_welch)) # cat(sprintf("F2 Statistic Observed Percentile: %.4f\n", perc_f2)) # # null_df <- data.frame( # Value = c(welch_perms, f2_perms), # Test = c(rep("Welch F", length(welch_perms)), rep("F2 Stat", length(f2_perms))) # ) # # ggplot(null_df, aes(x = Value, fill = Test)) + # geom_density(alpha = 0.4) + # geom_vline(xintercept = welch_obs, color = "blue", linetype = "dashed", linewidth = 1) + # geom_vline(xintercept = f2_obs, color = "red", linetype = "dashed", linewidth = 1) + # theme_minimal() + # labs(title = "Permutational Distributions: Welch F vs F2", # subtitle = "Dashed lines represent observed statistics", # x = "Statistic Value", y = "Density") ## ----------------------------------------------------------------------------- library(F2Adonis2) library(vegan) # Load package datasets data(norway_pa) data(norway_metadata) # Unbalanced design overview table(norway_metadata$Area) ## ----------------------------------------------------------------------------- dist_jaccard <- vegdist(norway_pa, method = "jaccard") mod_disp <- betadisper(dist_jaccard, norway_metadata$Area) # Plotting dispersions plot(mod_disp, main = "Multivariate Dispersions (Norway Data)") library(yarrr) # Extract data into a frame for plotting disp_data <- data.frame( Distance = mod_disp$distances, Area = mod_disp$group ) # Enhanced Pirate Plot pirateplot(formula = Distance ~ Area, data = disp_data, main = "Multivariate Dispersions (Norway Data)", xlab = "Geographic Area", ylab = "Distance to Centroid", theme = 1, # Clean theme pal = "basel", # Professional palette point.o = 0.9, # Transparency of raw points avg.line.o = 0.8, # High visibility for mean bean.f.o = 0.2, # Light density bean inf.method = "hdi") # High-density interval for inference ## ----------------------------------------------------------------------------- set.seed(123) # Conventional perMANOVA pseudo-F: fit_results1 <- adonis2( formula = norway_pa ~ Area, data = norway_metadata, method = "jaccard", permutations = 99 ) fit_results1 # Running the F2 test fit_results2 <- F2_adonis2( formula = norway_pa ~ Area, data = norway_metadata, method = "jaccard", permutations = 99, bootstrap = TRUE, bias.adjust = TRUE, plot.dist = FALSE ) fit_results2 ## ----------------------------------------------------------------------------- # ============================================================================== # High-Dimensional Case Study (PKD Metabolomics) # ============================================================================== # Demonstrating scaling to 1,554 variables where Welch's F is unavailable. library(dplyr) library(F2Adonis2) set.seed(123) cat("\n--- Loading PKD Data ---\n") # Load pre-packaged internal data objects data("pkd_metadata", package = "F2Adonis2") data("pkd_metabolites", package = "F2Adonis2") group_labels <- factor(pkd_metadata$Group) Y_pkd_final <- as.matrix(pkd_metabolites) cat(sprintf("Final Processed Data: %d samples x %d metabolites\n", nrow(Y_pkd_final), ncol(Y_pkd_final))) # ============================================================================== # PERFORM F2 ANALYSIS # ============================================================================== cat("\n--- Running F2 PERMANOVA ---\n") pkd_meta <- data.frame(Group = group_labels) # Run F2 with 99 permutations and bias-adjusted bootstrap. # permutations = 99 is used here to keep the vignette fast to build; the # accompanying JOSS paper reports results at permutations = 999. pkd_f2_results <- F2_adonis2( formula = Y_pkd_final ~ Group, data = pkd_meta, method = "euclidean", permutations = 99, bootstrap = TRUE, bias.adjust = TRUE, plot.dist = FALSE ) print(pkd_f2_results)