# Mixed ANOVA Analysis for Domain Means # EOHI Experiment Data Analysis - Domain Level Analysis # Variables: NPast_mean_pref, NPast_mean_pers, NPast_mean_val, NPast_mean_life # NFut_mean_pref, NFut_mean_pers, NFut_mean_val, NFut_mean_life # Load required libraries library(tidyverse) library(ez) library(car) library(nortest) # For normality tests library(ggplot2) # For plotting library(emmeans) # For post-hoc comparisons # Global options to remove scientific notation options(scipen = 999) setwd("C:/Users/irina/Documents/DND/EOHI/eohi1") # Read the data data <- read.csv("exp1.csv") # Display basic information about the dataset print(dim(data)) print(length(unique(data$pID))) # Check experimental conditions print(table(data$GROUP, data$TEMPORAL_DO, data$ITEM_DO)) # Check what domain mean columns are available domain_mean_cols <- colnames(data)[grepl("mean_(pref|pers|val|life)", colnames(data))] print(domain_mean_cols) # Verify the specific variables we need required_vars <- c("NPast_mean_pref", "NPast_mean_pers", "NPast_mean_val", "NPast_mean_life", "NFut_mean_pref", "NFut_mean_pers", "NFut_mean_val", "NFut_mean_life") missing_vars <- required_vars[!required_vars %in% colnames(data)] if (length(missing_vars) > 0) { print(paste("Warning: Missing variables:", paste(missing_vars, collapse = ", "))) } else { print("All required domain mean variables found!") } # Define domain mapping domain_mapping <- data.frame( variable = c("NPast_mean_pref", "NPast_mean_pers", "NPast_mean_val", "NPast_mean_life", "NFut_mean_pref", "NFut_mean_pers", "NFut_mean_val", "NFut_mean_life"), time = c(rep("Past", 4), rep("Future", 4)), domain = rep(c("Preferences", "Personality", "Values", "Life"), 2), stringsAsFactors = FALSE ) print(domain_mapping) # Function to pivot data to long format pivot_domain_means <- function(data, domain_mapping) { long_data <- data.frame() for (i in 1:nrow(domain_mapping)) { var_name <- domain_mapping$variable[i] time_level <- domain_mapping$time[i] domain_level <- domain_mapping$domain[i] # Check if variable exists if (!var_name %in% colnames(data)) { print(paste("Warning: Variable", var_name, "not found in data")) next } # Create subset for this variable subset_data <- data[, c("pID", "ResponseId", "TEMPORAL_DO", var_name)] subset_data$TIME <- time_level subset_data$DOMAIN <- domain_level subset_data$MEAN_DIFFERENCE <- subset_data[[var_name]] subset_data[[var_name]] <- NULL # Remove original column # Add to long data long_data <- rbind(long_data, subset_data) } # Convert to factors with proper levels long_data$TIME <- factor(long_data$TIME, levels = c("Past", "Future")) long_data$DOMAIN <- factor(long_data$DOMAIN, levels = c("Preferences", "Personality", "Values", "Life")) long_data$pID <- as.factor(long_data$pID) long_data$TEMPORAL_DO <- as.factor(long_data$TEMPORAL_DO) return(long_data) } # Pivot data to long format tryCatch({ long_data <- pivot_domain_means(data, domain_mapping) }, error = function(e) { print(paste("Error in data pivoting:", e$message)) stop("Cannot proceed without proper data structure") }) print(dim(long_data)) print(length(unique(long_data$pID))) print(levels(long_data$TIME)) print(levels(long_data$DOMAIN)) # Check data types print(is.factor(long_data$TIME)) print(is.factor(long_data$DOMAIN)) print(is.factor(long_data$pID)) print(is.numeric(long_data$MEAN_DIFFERENCE)) # Show first 20 rows print(utils::head(long_data, 20)) # Display structure and sample str(long_data) print(utils::head(long_data, 10)) # Show example data for one participant participant_1_data <- long_data[long_data$pID == 1, c("pID", "TEMPORAL_DO", "TIME", "DOMAIN", "MEAN_DIFFERENCE")] print(participant_1_data) # ============================================================================= # DESCRIPTIVE STATISTICS # ============================================================================= # Overall descriptive statistics by TIME and DOMAIN desc_stats <- long_data %>% group_by(TIME, DOMAIN) %>% summarise( n = n(), mean = round(mean(MEAN_DIFFERENCE, na.rm = TRUE), 5), variance = round(var(MEAN_DIFFERENCE, na.rm = TRUE), 5), sd = round(sd(MEAN_DIFFERENCE, na.rm = TRUE), 5), median = round(median(MEAN_DIFFERENCE, na.rm = TRUE), 5), q1 = round(quantile(MEAN_DIFFERENCE, 0.25, na.rm = TRUE), 5), q3 = round(quantile(MEAN_DIFFERENCE, 0.75, na.rm = TRUE), 5), min = round(min(MEAN_DIFFERENCE, na.rm = TRUE), 5), max = round(max(MEAN_DIFFERENCE, na.rm = TRUE), 5), .groups = 'drop' ) print("Descriptive statistics by TIME and DOMAIN:") print(desc_stats) # Descriptive statistics by between-subjects factors desc_stats_by_temporal <- long_data %>% group_by(TEMPORAL_DO, TIME, DOMAIN) %>% summarise( n = n(), mean = round(mean(MEAN_DIFFERENCE, na.rm = TRUE), 5), variance = round(var(MEAN_DIFFERENCE, na.rm = TRUE), 5), sd = round(sd(MEAN_DIFFERENCE, na.rm = TRUE), 5), .groups = 'drop' ) print("Descriptive statistics by TEMPORAL_DO, TIME, and DOMAIN:") print(desc_stats_by_temporal) # ============================================================================= # ASSUMPTION TESTING # ============================================================================= # Remove missing values for assumption testing long_data_clean <- long_data[!is.na(long_data$MEAN_DIFFERENCE), ] print(paste("Data after removing missing values:", dim(long_data_clean))) # 1. Missing values check missing_summary <- long_data %>% group_by(TIME, DOMAIN) %>% summarise( n_total = n(), n_missing = sum(is.na(MEAN_DIFFERENCE)), pct_missing = round(100 * n_missing / n_total, 2), .groups = 'drop' ) print("Missing values by TIME and DOMAIN:") print(missing_summary) # 2. Outlier detection outlier_summary <- long_data_clean %>% group_by(TIME, DOMAIN) %>% summarise( n = n(), mean = mean(MEAN_DIFFERENCE), sd = sd(MEAN_DIFFERENCE), q1 = quantile(MEAN_DIFFERENCE, 0.25), q3 = quantile(MEAN_DIFFERENCE, 0.75), iqr = q3 - q1, lower_bound = q1 - 1.5 * iqr, upper_bound = q3 + 1.5 * iqr, n_outliers = sum(MEAN_DIFFERENCE < lower_bound | MEAN_DIFFERENCE > upper_bound), .groups = 'drop' ) print("Outlier summary (IQR method):") print(outlier_summary) # 3. Normality tests normality_results <- long_data_clean %>% group_by(TIME, DOMAIN) %>% summarise( n = n(), shapiro_W = ifelse(n >= 3 & n <= 5000, shapiro.test(MEAN_DIFFERENCE)$statistic, NA), shapiro_p = ifelse(n >= 3 & n <= 5000, shapiro.test(MEAN_DIFFERENCE)$p.value, NA), anderson_A = ifelse(n >= 7, ad.test(MEAN_DIFFERENCE)$statistic, NA), anderson_p = ifelse(n >= 7, ad.test(MEAN_DIFFERENCE)$p.value, NA), .groups = 'drop' ) print("Normality test results:") print(normality_results) # Note: Anderson-Darling p-values may appear identical due to machine precision limits # All p-values are extremely small (< 2.2e-16) indicating strong non-normality # The test statistics (A values) are actually different across conditions # Debug: Check if Anderson-Darling test is working properly print("\n=== DEBUG: Anderson-Darling Test Details ===") # Get unique combinations of TIME and DOMAIN unique_combos <- long_data_clean %>% select(TIME, DOMAIN) %>% distinct() # Run Anderson-Darling test for each combination for(i in 1:nrow(unique_combos)) { time_val <- unique_combos$TIME[i] domain_val <- unique_combos$DOMAIN[i] # Subset data for this combination subset_data <- long_data_clean %>% filter(TIME == time_val, DOMAIN == domain_val) cat("TIME:", time_val, "DOMAIN:", domain_val, "n =", nrow(subset_data), "\n") # Run Anderson-Darling test if(nrow(subset_data) >= 7) { ad_result <- ad.test(subset_data$MEAN_DIFFERENCE) print(ad_result) } else { cat("Sample size too small for Anderson-Darling test\n") } cat("\n") } # 4. Homogeneity of variance (Levene's test) # Test homogeneity across TIME within each DOMAIN homogeneity_time <- long_data_clean %>% group_by(DOMAIN) %>% summarise( levene_F = leveneTest(MEAN_DIFFERENCE ~ TIME)$`F value`[1], levene_p = leveneTest(MEAN_DIFFERENCE ~ TIME)$`Pr(>F)`[1], .groups = 'drop' ) print("Homogeneity of variance across TIME within each DOMAIN:") print(homogeneity_time) # Test homogeneity across DOMAIN within each TIME homogeneity_domain <- long_data_clean %>% group_by(TIME) %>% summarise( levene_F = leveneTest(MEAN_DIFFERENCE ~ DOMAIN)$`F value`[1], levene_p = leveneTest(MEAN_DIFFERENCE ~ DOMAIN)$`Pr(>F)`[1], .groups = 'drop' ) print("Homogeneity of variance across DOMAIN within each TIME:") print(homogeneity_domain) # ============================================================================= # HARTLEY'S F-MAX TEST WITH BOOTSTRAP CRITICAL VALUES # ============================================================================= # Function to calculate Hartley's F-max ratio calculate_hartley_ratio <- function(variances) { max(variances, na.rm = TRUE) / min(variances, na.rm = TRUE) } # Function to bootstrap critical values for Hartley's F-max test bootstrap_hartley_critical <- function(data, group_var, response_var, n_iter = 1000) { # Get unique groups and their sample sizes groups <- unique(data[[group_var]]) n_groups <- length(groups) # Calculate observed variances for each group observed_vars <- data %>% group_by(!!sym(group_var)) %>% summarise(var = var(!!sym(response_var), na.rm = TRUE), .groups = 'drop') %>% pull(var) # Calculate observed F-max ratio observed_ratio <- calculate_hartley_ratio(observed_vars) # Bootstrap under null hypothesis (equal variances) # Pool all data and resample to create equal variance scenario pooled_data <- data[[response_var]] pooled_mean <- mean(pooled_data, na.rm = TRUE) pooled_var <- var(pooled_data, na.rm = TRUE) # Bootstrap F-max ratios under null hypothesis bootstrap_ratios <- replicate(n_iter, { # Generate samples from normal distribution with pooled variance sample_vars <- map_dbl(groups, ~ { group_data <- data[data[[group_var]] == .x, response_var] n_group <- length(group_data) var(rnorm(n = n_group, mean = pooled_mean, sd = sqrt(pooled_var))) }) calculate_hartley_ratio(sample_vars) }) # Calculate critical value (95th percentile) # Remove any NaN or infinite values valid_ratios <- bootstrap_ratios[is.finite(bootstrap_ratios) & !is.na(bootstrap_ratios)] if(length(valid_ratios) == 0) { stop("No valid bootstrap ratios generated") } critical_95 <- quantile(valid_ratios, 0.95, na.rm = TRUE) return(list( observed_ratio = observed_ratio, critical_95 = critical_95, bootstrap_ratios = bootstrap_ratios )) } # Test 1: Hartley's F-max across TIME within each DOMAIN print("\n=== HARTLEY'S F-MAX TEST: TIME within each DOMAIN ===") set.seed(123) # For reproducibility hartley_time_results <- long_data_clean %>% group_by(DOMAIN) %>% summarise( hartley_result = list(bootstrap_hartley_critical(cur_data(), "TIME", "MEAN_DIFFERENCE")), .groups = 'drop' ) %>% mutate( observed_ratio = map_dbl(hartley_result, ~ .x$observed_ratio), critical_95 = map_dbl(hartley_result, ~ .x$critical_95), significant = observed_ratio > critical_95 ) %>% select(DOMAIN, observed_ratio, critical_95, significant) print(hartley_time_results) # Test 2: Hartley's F-max across DOMAIN within each TIME print("\n=== HARTLEY'S F-MAX TEST: DOMAIN within each TIME ===") hartley_domain_results <- long_data_clean %>% group_by(TIME) %>% summarise( hartley_result = list(bootstrap_hartley_critical(cur_data(), "DOMAIN", "MEAN_DIFFERENCE")), .groups = 'drop' ) %>% mutate( observed_ratio = map_dbl(hartley_result, ~ .x$observed_ratio), critical_95 = map_dbl(hartley_result, ~ .x$critical_95), significant = observed_ratio > critical_95 ) %>% select(TIME, observed_ratio, critical_95, significant) print(hartley_domain_results)