---
title: "Mixed ANOVA Analysis for Domain Means"
author: "Irina"
date: "`r Sys.Date()`"
output: 
  html_document:
    toc: true
    toc_float: true
    code_folding: hide
    theme: flatly
    highlight: tango
    fig_width: 10
    fig_height: 6
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
```

# Introduction

This analysis examines domain-level differences in mean scores across time periods using a mixed ANOVA design. The analysis focuses on four domains (Preferences, Personality, Values, Life) across two time periods (Past, Future) with a between-subjects factor (TEMPORAL_DO).

# Data Preparation and Setup

```{r libraries}
library(tidyverse)
library(ez)
library(car)
library(nortest)      # For normality tests
library(emmeans)      # For post-hoc comparisons
library(purrr)        # For map functions
library(effsize)      # For Cohen's d calculations
library(ggplot2)      # For plotting

options(scipen = 999)
options(contrasts = c("contr.sum", "contr.poly"))

setwd("C:/Users/irina/Documents/DND/EOHI/eohi1")
```

```{r data-loading}
# Read the data
data <- read.csv("exp1.csv")

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")

# 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
)
```

```{r data-reshaping}
long_data <- data %>%
  select(pID, ResponseId, TEMPORAL_DO, all_of(required_vars)) %>%
  pivot_longer(
    cols = all_of(required_vars),
    names_to = "variable",
    values_to = "MEAN_DIFFERENCE"
  ) %>%
  left_join(domain_mapping, by = "variable") %>%
  # Convert to factors with proper levels (note: columns are 'time' and 'domain' from mapping)
  mutate(
    TIME = factor(time, levels = c("Past", "Future")),
    DOMAIN = factor(domain, levels = c("Preferences", "Personality", "Values", "Life")),
    pID = as.factor(pID),
    TEMPORAL_DO = as.factor(TEMPORAL_DO)
  ) %>%
  # Select final columns and remove any rows with missing values
  select(pID, ResponseId, TEMPORAL_DO, TIME, DOMAIN, MEAN_DIFFERENCE) %>%
  filter(!is.na(MEAN_DIFFERENCE))

# Create clean dataset for analysis (fixing the reference issue)
long_data_clean <- long_data
```

# Descriptive Statistics

## Overall Descriptive Statistics by TIME and DOMAIN

```{r descriptive-stats}
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(desc_stats)
```

## Descriptive Statistics by Between-Subjects Factors

```{r descriptive-stats-temporal}
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(desc_stats_by_temporal)
```

# Assumption Testing

## Missing Values Check

```{r missing-values}
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_summary)
```

## Outlier Detection

```{r 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),
    median = median(MEAN_DIFFERENCE),
    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)
```

## Anderson-Darling Normality Test

```{r normality-test}
normality_results <- long_data_clean %>%
  group_by(TIME, DOMAIN) %>%
  summarise(
    n = n(),
    ad_statistic = ad.test(.data$MEAN_DIFFERENCE)$statistic,
    ad_p_value = ad.test(.data$MEAN_DIFFERENCE)$p.value,
    .groups = 'drop'
  )

print(normality_results)
```

## Homogeneity of Variance (Levene's Test)

### Test homogeneity across TIME within each DOMAIN

```{r homogeneity-time}
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_time)
```

### Test homogeneity across DOMAIN within each TIME

```{r homogeneity-domain}
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_domain)
```

## Hartley's F-Max Test with Bootstrap Critical Values

```{r hartley-function}
# Function to calculate Hartley's F-max ratio
calculate_hartley_ratio <- function(variances) {
  max(variances, na.rm = TRUE) / min(variances, na.rm = TRUE)
}

# More efficient bootstrap function 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]])
  
  # Calculate observed variances for each group
  observed_vars <- data %>%
    dplyr::group_by(!!rlang::sym(group_var)) %>%
    dplyr::summarise(var = var(!!rlang::sym(response_var), na.rm = TRUE), .groups = 'drop') %>%
    dplyr::pull(var)
  
  # Handle invalid variances
  if(any(observed_vars <= 0 | is.na(observed_vars))) {
    observed_vars[observed_vars <= 0 | is.na(observed_vars)] <- 1e-10
  }
  
  # Calculate observed F-max ratio
  observed_ratio <- max(observed_vars) / min(observed_vars)
  
  # Pre-allocate storage for bootstrap ratios
  bootstrap_ratios <- numeric(n_iter)
  
  # Get group data once
  group_data_list <- map(groups, ~ {
    group_data <- data[data[[group_var]] == .x, response_var]
    group_data[!is.na(group_data)]
  })
  
  # Bootstrap with pre-allocated storage
  for(i in 1:n_iter) {
    # Bootstrap sample from each group independently
    sample_vars <- map_dbl(group_data_list, ~ {
      bootstrap_sample <- sample(.x, size = length(.x), replace = TRUE)
      var(bootstrap_sample, na.rm = TRUE)
    })
    bootstrap_ratios[i] <- max(sample_vars) / min(sample_vars)
  }
  
  # Remove invalid ratios
  valid_ratios <- bootstrap_ratios[is.finite(bootstrap_ratios) & !is.na(bootstrap_ratios)]
  
  if(length(valid_ratios) == 0) {
    stop("No valid bootstrap ratios generated")
  }
  
  # Calculate critical value (95th percentile)
  critical_95 <- quantile(valid_ratios, 0.95, na.rm = TRUE)
  
  # Return only essential information
  return(list(
    observed_ratio = observed_ratio,
    critical_95 = critical_95,
    n_valid_iterations = length(valid_ratios)
  ))
}
```

```{r hartley-results}
# For mixed ANOVA: Test homogeneity across BETWEEN-SUBJECTS factor (TEMPORAL_DO)
# within each combination of within-subjects factors (TIME × DOMAIN)

print(unique(long_data_clean$TEMPORAL_DO))
print(table(long_data_clean$TEMPORAL_DO))

observed_temporal_ratios <- long_data_clean %>%
  group_by(TIME, DOMAIN) %>%
  summarise(
    # Calculate variances for each TEMPORAL_DO level within this TIME × DOMAIN combination
    past_var = var(MEAN_DIFFERENCE[TEMPORAL_DO == "01PAST"], na.rm = TRUE),
    fut_var = var(MEAN_DIFFERENCE[TEMPORAL_DO == "02FUT"], na.rm = TRUE),
    # Calculate F-max ratio
    f_max_ratio = max(past_var, fut_var) / min(past_var, fut_var),
    .groups = 'drop'
  ) %>%
  select(TIME, DOMAIN, past_var, fut_var, f_max_ratio)

print(observed_temporal_ratios)

# Hartley's F-max test across TEMPORAL_DO within each TIME × DOMAIN combination
set.seed(123)  # For reproducibility

hartley_temporal_results <- long_data_clean %>%
  group_by(TIME, DOMAIN) %>%
  summarise(
    hartley_result = list(bootstrap_hartley_critical(pick(TEMPORAL_DO, MEAN_DIFFERENCE), "TEMPORAL_DO", "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, DOMAIN, observed_ratio, critical_95, significant)

print(hartley_temporal_results)
```