Add DA00 F-max, DA01 ANOVA script, knit Rmds; ignore lock files in .gitignore (#6)
Reviewed-on: #6 Co-authored-by: Irina Levit <irina.levit.rn@gmail.com> Co-committed-by: Irina Levit <irina.levit.rn@gmail.com>
This commit is contained in:
parent
42ea52d859
commit
d0d0e0f8d4
4
.gitignore
vendored
4
.gitignore
vendored
@ -1,2 +1,4 @@
|
||||
.history/
|
||||
eohi3_2.csv
|
||||
eohi3_2.csv
|
||||
*~
|
||||
.~lock*
|
||||
149
eohi3/DA00_fmaxVALS.r
Normal file
149
eohi3/DA00_fmaxVALS.r
Normal file
@ -0,0 +1,149 @@
|
||||
library(SuppDists)
|
||||
library(dplyr)
|
||||
library(tidyr)
|
||||
|
||||
setwd("/home/ladmin/Documents/DND/EOHI/eohi3")
|
||||
|
||||
between_vars <- c("perspective", "temporalDO")
|
||||
within_vars_MEAN <- c(
|
||||
"past_pref_MEAN", "past_pers_MEAN", "past_val_MEAN",
|
||||
"fut_pref_MEAN", "fut_pers_MEAN", "fut_val_MEAN"
|
||||
)
|
||||
within_vars_DGEN <- c(
|
||||
"past_pref_DGEN", "past_pers_DGEN", "past_val_DGEN",
|
||||
"fut_pref_DGEN", "fut_pers_DGEN", "fut_val_DGEN"
|
||||
)
|
||||
|
||||
df <- read.csv("eohi3.csv", stringsAsFactors = FALSE, check.names = FALSE, na.strings = "NA")
|
||||
|
||||
anova_data_MEAN <- df %>%
|
||||
select(pID, all_of(between_vars), all_of(within_vars_MEAN)) %>%
|
||||
filter(!is.na(perspective), perspective != "",
|
||||
!is.na(temporalDO), temporalDO != "")
|
||||
|
||||
long_data_MEAN <- anova_data_MEAN %>%
|
||||
pivot_longer(
|
||||
cols = all_of(within_vars_MEAN),
|
||||
names_to = "variable",
|
||||
values_to = "MEAN_SCORE"
|
||||
) %>%
|
||||
mutate(
|
||||
time = ifelse(grepl("^past_", variable), "past", "fut"),
|
||||
domain = case_when(
|
||||
grepl("_pref_MEAN$", variable) ~ "pref",
|
||||
grepl("_pers_MEAN$", variable) ~ "pers",
|
||||
grepl("_val_MEAN$", variable) ~ "val",
|
||||
TRUE ~ NA_character_
|
||||
)
|
||||
) %>%
|
||||
mutate(
|
||||
TIME = factor(time, levels = c("past", "fut")),
|
||||
DOMAIN = factor(domain, levels = c("pref", "pers", "val")),
|
||||
perspective = factor(perspective),
|
||||
temporalDO = factor(temporalDO)
|
||||
) %>%
|
||||
select(pID, perspective, temporalDO, TIME, DOMAIN, MEAN_SCORE) %>%
|
||||
filter(!is.na(MEAN_SCORE))
|
||||
|
||||
cell_vars_MEAN <- long_data_MEAN %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n = n(),
|
||||
variance = var(MEAN_SCORE, na.rm = TRUE),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
fmax_by_cell_MEAN <- cell_vars_MEAN %>%
|
||||
group_by(TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
Fmax_observed = max(variance, na.rm = TRUE) / min(variance, na.rm = TRUE),
|
||||
df_min = min(n) - 1L,
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
k <- 4
|
||||
|
||||
fmax_table_MEAN <- fmax_by_cell_MEAN %>%
|
||||
rowwise() %>%
|
||||
mutate(
|
||||
alpha_0.05 = SuppDists::qmaxFratio(0.95, df = df_min, k = k),
|
||||
alpha_0.01 = SuppDists::qmaxFratio(0.99, df = df_min, k = k)
|
||||
) %>%
|
||||
ungroup() %>%
|
||||
mutate(
|
||||
Fmax_observed = round(Fmax_observed, 4),
|
||||
alpha_0.05 = round(alpha_0.05, 4),
|
||||
alpha_0.01 = round(alpha_0.01, 4)
|
||||
) %>%
|
||||
select(TIME, DOMAIN, Fmax_observed, alpha_0.05, alpha_0.01)
|
||||
|
||||
# ---- MEAN: Print observed Hartley ratios ----
|
||||
cat("\n--- Hartley ratios (MEAN) ---\n")
|
||||
fmax_table_MEAN %>%
|
||||
mutate(across(where(is.numeric), ~ format(round(., 4), nsmall = 4))) %>%
|
||||
print()
|
||||
|
||||
# ---- DGEN: Observed Hartley ratios ----
|
||||
anova_data_DGEN <- df %>%
|
||||
select(pID, all_of(between_vars), all_of(within_vars_DGEN)) %>%
|
||||
filter(!is.na(perspective), perspective != "",
|
||||
!is.na(temporalDO), temporalDO != "")
|
||||
|
||||
long_data_DGEN <- anova_data_DGEN %>%
|
||||
pivot_longer(
|
||||
cols = all_of(within_vars_DGEN),
|
||||
names_to = "variable",
|
||||
values_to = "DGEN_SCORE"
|
||||
) %>%
|
||||
mutate(
|
||||
time = ifelse(grepl("^past_", variable), "past", "fut"),
|
||||
domain = case_when(
|
||||
grepl("_pref_DGEN$", variable) ~ "pref",
|
||||
grepl("_pers_DGEN$", variable) ~ "pers",
|
||||
grepl("_val_DGEN$", variable) ~ "val",
|
||||
TRUE ~ NA_character_
|
||||
)
|
||||
) %>%
|
||||
mutate(
|
||||
TIME = factor(time, levels = c("past", "fut")),
|
||||
DOMAIN = factor(domain, levels = c("pref", "pers", "val")),
|
||||
perspective = factor(perspective),
|
||||
temporalDO = factor(temporalDO)
|
||||
) %>%
|
||||
select(pID, perspective, temporalDO, TIME, DOMAIN, DGEN_SCORE) %>%
|
||||
filter(!is.na(DGEN_SCORE))
|
||||
|
||||
cell_vars_DGEN <- long_data_DGEN %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n = n(),
|
||||
variance = var(DGEN_SCORE, na.rm = TRUE),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
fmax_by_cell_DGEN <- cell_vars_DGEN %>%
|
||||
group_by(TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
Fmax_observed = max(variance, na.rm = TRUE) / min(variance, na.rm = TRUE),
|
||||
df_min = min(n) - 1L,
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
fmax_table_DGEN <- fmax_by_cell_DGEN %>%
|
||||
rowwise() %>%
|
||||
mutate(
|
||||
alpha_0.05 = SuppDists::qmaxFratio(0.95, df = df_min, k = k),
|
||||
alpha_0.01 = SuppDists::qmaxFratio(0.99, df = df_min, k = k)
|
||||
) %>%
|
||||
ungroup() %>%
|
||||
mutate(
|
||||
Fmax_observed = round(Fmax_observed, 4),
|
||||
alpha_0.05 = round(alpha_0.05, 4),
|
||||
alpha_0.01 = round(alpha_0.01, 4)
|
||||
) %>%
|
||||
select(TIME, DOMAIN, Fmax_observed, alpha_0.05, alpha_0.01)
|
||||
|
||||
cat("\n--- Hartley ratios (DGEN) ---\n")
|
||||
fmax_table_DGEN %>%
|
||||
mutate(across(where(is.numeric), ~ format(round(., 4), nsmall = 4))) %>%
|
||||
print()
|
||||
235
eohi3/DA01_anova_DS.r
Normal file
235
eohi3/DA01_anova_DS.r
Normal file
@ -0,0 +1,235 @@
|
||||
library(tidyverse)
|
||||
library(rstatix)
|
||||
library(emmeans)
|
||||
library(effectsize)
|
||||
library(afex)
|
||||
library(car)
|
||||
|
||||
options(scipen = 999)
|
||||
afex::set_sum_contrasts()
|
||||
|
||||
setwd("/home/ladmin/Documents/DND/EOHI/eohi3")
|
||||
|
||||
df <- read.csv(
|
||||
"eohi3.csv",
|
||||
stringsAsFactors = FALSE,
|
||||
check.names = FALSE,
|
||||
na.strings = "NA"
|
||||
)
|
||||
|
||||
between_vars <- c("perspective", "temporalDO")
|
||||
within_vars <- c(
|
||||
"past_pref_MEAN", "past_pers_MEAN", "past_val_MEAN",
|
||||
"fut_pref_MEAN", "fut_pers_MEAN", "fut_val_MEAN"
|
||||
)
|
||||
|
||||
missing_vars <- setdiff(c(between_vars, within_vars, "pID"), names(df))
|
||||
if (length(missing_vars) > 0) {
|
||||
stop(paste("Missing required variables:", paste(missing_vars, collapse = ", ")))
|
||||
}
|
||||
|
||||
anova_data <- df %>%
|
||||
select(pID, all_of(between_vars), all_of(within_vars)) %>%
|
||||
filter(
|
||||
!is.na(perspective), perspective != "",
|
||||
!is.na(temporalDO), temporalDO != ""
|
||||
)
|
||||
|
||||
long_data <- anova_data %>%
|
||||
pivot_longer(
|
||||
cols = all_of(within_vars),
|
||||
names_to = "variable",
|
||||
values_to = "MEAN_SCORE"
|
||||
) %>%
|
||||
mutate(
|
||||
time = case_when(
|
||||
grepl("^past_", variable) ~ "past",
|
||||
grepl("^fut_", variable) ~ "fut",
|
||||
TRUE ~ NA_character_
|
||||
),
|
||||
domain = case_when(
|
||||
grepl("_pref_MEAN$", variable) ~ "pref",
|
||||
grepl("_pers_MEAN$", variable) ~ "pers",
|
||||
grepl("_val_MEAN$", variable) ~ "val",
|
||||
TRUE ~ NA_character_
|
||||
)
|
||||
) %>%
|
||||
mutate(
|
||||
TIME = factor(time, levels = c("past", "fut")),
|
||||
DOMAIN = factor(domain, levels = c("pref", "pers", "val")),
|
||||
perspective = factor(perspective),
|
||||
temporalDO = factor(temporalDO),
|
||||
pID = factor(pID)
|
||||
) %>%
|
||||
select(pID, perspective, temporalDO, TIME, DOMAIN, MEAN_SCORE) %>%
|
||||
filter(!is.na(MEAN_SCORE))
|
||||
|
||||
desc_stats <- long_data %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n = n(),
|
||||
mean = round(mean(MEAN_SCORE), 5),
|
||||
variance = round(var(MEAN_SCORE), 5),
|
||||
sd = round(sd(MEAN_SCORE), 5),
|
||||
median = round(median(MEAN_SCORE), 5),
|
||||
q1 = round(quantile(MEAN_SCORE, 0.25), 5),
|
||||
q3 = round(quantile(MEAN_SCORE, 0.75), 5),
|
||||
min = round(min(MEAN_SCORE), 5),
|
||||
max = round(max(MEAN_SCORE), 5),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
print(desc_stats, n = Inf)
|
||||
|
||||
missing_summary <- long_data %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n_total = n(),
|
||||
n_missing = sum(is.na(MEAN_SCORE)),
|
||||
pct_missing = round(100 * n_missing / n_total, 2),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
print(missing_summary, n = Inf)
|
||||
|
||||
outlier_summary <- long_data %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n = n(),
|
||||
n_outliers = sum(abs(scale(MEAN_SCORE)) > 3),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
print(outlier_summary, n = Inf)
|
||||
|
||||
homogeneity_between <- long_data %>%
|
||||
group_by(TIME, DOMAIN) %>%
|
||||
rstatix::levene_test(MEAN_SCORE ~ perspective * temporalDO)
|
||||
|
||||
print(homogeneity_between, n = Inf)
|
||||
|
||||
# Normality: within-subjects residuals (deviation from each participant's mean)
|
||||
resid_within <- long_data %>%
|
||||
group_by(pID) %>%
|
||||
mutate(person_mean = mean(MEAN_SCORE, na.rm = TRUE)) %>%
|
||||
ungroup() %>%
|
||||
mutate(resid = MEAN_SCORE - person_mean) %>%
|
||||
pull(resid)
|
||||
resid_within <- resid_within[!is.na(resid_within)]
|
||||
n_resid <- length(resid_within)
|
||||
if (n_resid < 3L) {
|
||||
message("Too few within-subjects residuals (n < 3); skipping Shapiro-Wilk.")
|
||||
} else {
|
||||
resid_for_shapiro <- if (n_resid > 5000L) {
|
||||
set.seed(1L)
|
||||
sample(resid_within, 5000L)
|
||||
} else {
|
||||
resid_within
|
||||
}
|
||||
print(shapiro.test(resid_for_shapiro))
|
||||
}
|
||||
# qqnorm(resid_within)
|
||||
# qqline(resid_within)
|
||||
|
||||
aov_afex <- aov_ez(
|
||||
id = "pID",
|
||||
dv = "MEAN_SCORE",
|
||||
data = long_data,
|
||||
between = c("perspective", "temporalDO"),
|
||||
within = c("TIME", "DOMAIN"),
|
||||
type = 3
|
||||
)
|
||||
|
||||
# ANOVA table: uncorrected and Greenhouse–Geisser
|
||||
cat("\n--- ANOVA Table (Type 3, uncorrected) ---\n")
|
||||
print(nice(aov_afex, correction = "none"))
|
||||
cat("\n--- ANOVA Table (Type 3, Greenhouse–Geisser correction) ---\n")
|
||||
print(nice(aov_afex, correction = "GG"))
|
||||
|
||||
# Mauchly's test of sphericity and epsilon (via car::Anova on wide data)
|
||||
anova_wide <- anova_data %>%
|
||||
select(pID, perspective, temporalDO, all_of(within_vars)) %>%
|
||||
filter(if_all(all_of(within_vars), ~ !is.na(.)))
|
||||
response_matrix <- as.matrix(anova_wide[, within_vars])
|
||||
rm_model <- lm(response_matrix ~ perspective * temporalDO, data = anova_wide)
|
||||
idata <- data.frame(
|
||||
TIME = factor(rep(c("past", "fut"), each = 3), levels = c("past", "fut")),
|
||||
DOMAIN = factor(rep(c("pref", "pers", "val"), 2), levels = c("pref", "pers", "val"))
|
||||
)
|
||||
rm_anova <- car::Anova(rm_model, idata = idata, idesign = ~ TIME * DOMAIN, type = 3)
|
||||
rm_summary <- summary(rm_anova, multivariate = FALSE)
|
||||
if (!is.null(rm_summary$sphericity.tests)) {
|
||||
cat("\nMauchly's Test of Sphericity:\n")
|
||||
print(rm_summary$sphericity.tests)
|
||||
}
|
||||
if (!is.null(rm_summary$epsilon)) {
|
||||
cat("\nEpsilon (GG, HF):\n")
|
||||
print(rm_summary$epsilon)
|
||||
}
|
||||
|
||||
# Within-subjects residuals: deviation from each participant's mean (one per observation)
|
||||
resid_within <- long_data %>%
|
||||
group_by(pID) %>%
|
||||
mutate(person_mean = mean(MEAN_SCORE, na.rm = TRUE)) %>%
|
||||
ungroup() %>%
|
||||
mutate(resid = MEAN_SCORE - person_mean) %>%
|
||||
pull(resid)
|
||||
resid_within <- resid_within[!is.na(resid_within)]
|
||||
# R's shapiro.test() allows 3 <= n <= 5000; use a random sample of 5000 if we have more
|
||||
n_resid <- length(resid_within)
|
||||
if (n_resid < 3L) {
|
||||
message("Too few within-subjects residuals (n < 3); skipping Shapiro-Wilk.")
|
||||
} else {
|
||||
resid_for_shapiro <- if (n_resid > 5000L) {
|
||||
set.seed(1L)
|
||||
sample(resid_within, 5000L)
|
||||
} else {
|
||||
resid_within
|
||||
}
|
||||
print(shapiro.test(resid_for_shapiro))
|
||||
}
|
||||
|
||||
# qqnorm(resid_within)
|
||||
# qqline(resid_within)
|
||||
|
||||
# POST-HOC COMPARISONS (significant effects only)
|
||||
|
||||
# TIME (main effect)
|
||||
emm_TIME <- emmeans(aov_afex, ~ TIME)
|
||||
print(pairs(emm_TIME, adjust = "bonferroni"))
|
||||
|
||||
# temporalDO:TIME — ~TIME and ~temporalDO
|
||||
emm_temporalDO_TIME <- emmeans(aov_afex, ~ TIME | temporalDO)
|
||||
print(pairs(emm_temporalDO_TIME, adjust = "bonferroni"))
|
||||
emm_temporalDO_temporalDO <- emmeans(aov_afex, ~ temporalDO | TIME)
|
||||
print(pairs(emm_temporalDO_temporalDO, adjust = "bonferroni"))
|
||||
|
||||
# perspective:temporalDO:TIME — ~TIME, ~perspective, ~temporalDO
|
||||
emm_pt_TIME <- emmeans(aov_afex, ~ TIME | perspective + temporalDO)
|
||||
print(pairs(emm_pt_TIME, adjust = "bonferroni"))
|
||||
emm_pt_perspective <- emmeans(aov_afex, ~ perspective | temporalDO + TIME)
|
||||
print(pairs(emm_pt_perspective, adjust = "bonferroni"))
|
||||
emm_pt_temporalDO <- emmeans(aov_afex, ~ temporalDO | perspective + TIME)
|
||||
print(pairs(emm_pt_temporalDO, adjust = "bonferroni"))
|
||||
|
||||
# perspective:DOMAIN — ~perspective and ~DOMAIN
|
||||
emm_perspective_DOMAIN <- emmeans(aov_afex, ~ perspective | DOMAIN)
|
||||
print(pairs(emm_perspective_DOMAIN, adjust = "bonferroni"))
|
||||
emm_perspective_DOMAIN_domain <- emmeans(aov_afex, ~ DOMAIN | perspective)
|
||||
print(pairs(emm_perspective_DOMAIN_domain, adjust = "bonferroni"))
|
||||
|
||||
# perspective:TIME:DOMAIN — ~TIME, ~perspective, ~DOMAIN
|
||||
emm_pt_TIME_domain <- emmeans(aov_afex, ~ TIME | perspective + DOMAIN)
|
||||
print(pairs(emm_pt_TIME_domain, adjust = "bonferroni"))
|
||||
emm_pt_domain_perspective <- emmeans(aov_afex, ~ perspective | TIME + DOMAIN)
|
||||
print(pairs(emm_pt_domain_perspective, adjust = "bonferroni"))
|
||||
emm_pt_domain_domain <- emmeans(aov_afex, ~ DOMAIN | perspective + TIME)
|
||||
print(pairs(emm_pt_domain_domain, adjust = "bonferroni"))
|
||||
|
||||
# perspective:temporalDO:TIME:DOMAIN — ~TIME, ~perspective, ~temporalDO
|
||||
emm_ptt_TIME <- emmeans(aov_afex, ~ TIME | perspective + temporalDO + DOMAIN)
|
||||
print(pairs(emm_ptt_TIME, adjust = "bonferroni"))
|
||||
emm_ptt_perspective <- emmeans(aov_afex, ~ perspective | temporalDO + TIME + DOMAIN)
|
||||
print(pairs(emm_ptt_perspective, adjust = "bonferroni"))
|
||||
emm_ptt_temporalDO <- emmeans(aov_afex, ~ temporalDO | perspective + TIME + DOMAIN)
|
||||
print(pairs(emm_ptt_temporalDO, adjust = "bonferroni"))
|
||||
501
eohi3/knit/DA01_anova_DS.Rmd
Normal file
501
eohi3/knit/DA01_anova_DS.Rmd
Normal file
@ -0,0 +1,501 @@
|
||||
---
|
||||
title: "Mixed ANOVA - Domain Specific Means (DA01)"
|
||||
author: ""
|
||||
date: "`r Sys.Date()`"
|
||||
output:
|
||||
html_document:
|
||||
toc: true
|
||||
toc_float: true
|
||||
code_folding: hide
|
||||
---
|
||||
|
||||
```{r setup, include = FALSE}
|
||||
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = TRUE)
|
||||
```
|
||||
|
||||
# Setup
|
||||
|
||||
```{r libraries}
|
||||
library(tidyverse)
|
||||
library(rstatix)
|
||||
library(emmeans)
|
||||
library(effectsize)
|
||||
library(afex)
|
||||
library(car)
|
||||
|
||||
options(scipen = 999)
|
||||
afex::set_sum_contrasts()
|
||||
```
|
||||
|
||||
# Data
|
||||
|
||||
```{r read-data}
|
||||
# Data file is in parent of knit/ (eohi3/eohi3.csv)
|
||||
df <- read.csv(
|
||||
"/home/ladmin/Documents/DND/EOHI/eohi3/eohi3.csv",
|
||||
stringsAsFactors = FALSE,
|
||||
check.names = FALSE,
|
||||
na.strings = "NA"
|
||||
)
|
||||
|
||||
between_vars <- c("perspective", "temporalDO")
|
||||
within_vars <- c(
|
||||
"past_pref_MEAN", "past_pers_MEAN", "past_val_MEAN",
|
||||
"fut_pref_MEAN", "fut_pers_MEAN", "fut_val_MEAN"
|
||||
)
|
||||
|
||||
missing_vars <- setdiff(c(between_vars, within_vars, "pID"), names(df))
|
||||
if (length(missing_vars) > 0) {
|
||||
stop(paste("Missing required variables:", paste(missing_vars, collapse = ", ")))
|
||||
}
|
||||
|
||||
anova_data <- df %>%
|
||||
select(pID, all_of(between_vars), all_of(within_vars)) %>%
|
||||
filter(
|
||||
!is.na(perspective), perspective != "",
|
||||
!is.na(temporalDO), temporalDO != ""
|
||||
)
|
||||
```
|
||||
|
||||
# Long format
|
||||
|
||||
```{r long-format}
|
||||
long_data <- anova_data %>%
|
||||
pivot_longer(
|
||||
cols = all_of(within_vars),
|
||||
names_to = "variable",
|
||||
values_to = "MEAN_SCORE"
|
||||
) %>%
|
||||
mutate(
|
||||
time = case_when(
|
||||
grepl("^past_", variable) ~ "past",
|
||||
grepl("^fut_", variable) ~ "fut",
|
||||
TRUE ~ NA_character_
|
||||
),
|
||||
domain = case_when(
|
||||
grepl("_pref_MEAN$", variable) ~ "pref",
|
||||
grepl("_pers_MEAN$", variable) ~ "pers",
|
||||
grepl("_val_MEAN$", variable) ~ "val",
|
||||
TRUE ~ NA_character_
|
||||
)
|
||||
) %>%
|
||||
mutate(
|
||||
TIME = factor(time, levels = c("past", "fut")),
|
||||
DOMAIN = factor(domain, levels = c("pref", "pers", "val")),
|
||||
perspective = factor(perspective),
|
||||
temporalDO = factor(temporalDO),
|
||||
pID = factor(pID)
|
||||
) %>%
|
||||
select(pID, perspective, temporalDO, TIME, DOMAIN, MEAN_SCORE) %>%
|
||||
filter(!is.na(MEAN_SCORE))
|
||||
```
|
||||
|
||||
# Descriptive statistics
|
||||
|
||||
```{r desc-stats}
|
||||
desc_stats <- long_data %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n = n(),
|
||||
mean = round(mean(MEAN_SCORE), 5),
|
||||
variance = round(var(MEAN_SCORE), 5),
|
||||
sd = round(sd(MEAN_SCORE), 5),
|
||||
median = round(median(MEAN_SCORE), 5),
|
||||
q1 = round(quantile(MEAN_SCORE, 0.25), 5),
|
||||
q3 = round(quantile(MEAN_SCORE, 0.75), 5),
|
||||
min = round(min(MEAN_SCORE), 5),
|
||||
max = round(max(MEAN_SCORE), 5),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
# Show all rows and columns (no truncation)
|
||||
options(tibble.width = Inf)
|
||||
print(desc_stats, n = Inf)
|
||||
```
|
||||
|
||||
Interpretations:
|
||||
1. Mean and median values are similar, indicating distribution is relatively symmetric and any skew is minimal. Any outliers are not extreme.
|
||||
2. Highest to lowest group n size ratio is 1.14 (139/122). Acceptable ratio for ANOVA (under 1.5).
|
||||
3. Highest to lowest overall group variance ratio is 1.67 (7.93/4.74). Acceptable ratio for ANOVA (under 4).
|
||||
For the sake of consistency w/ the other EHI studies, I also calculated Hartley's F-max ratio.
|
||||
The conservative F-max critical value is 1.60, which is still higher than the highest observed F-max ratio of 1.53.
|
||||
|
||||
# Assumption checks
|
||||
|
||||
## Missing values
|
||||
|
||||
```{r missing}
|
||||
missing_summary <- long_data %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n_total = n(),
|
||||
n_missing = sum(is.na(MEAN_SCORE)),
|
||||
pct_missing = round(100 * n_missing / n_total, 2),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
print(missing_summary, n = Inf)
|
||||
```
|
||||
|
||||
No missing values. As expected.
|
||||
|
||||
## Outliers
|
||||
|
||||
```{r outliers}
|
||||
outlier_summary <- long_data %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n = n(),
|
||||
n_outliers = sum(abs(scale(MEAN_SCORE)) > 3),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
print(outlier_summary, n = Inf)
|
||||
```
|
||||
|
||||
No outliers present. Good.
|
||||
|
||||
## Homogeneity of variance
|
||||
|
||||
```{r homogeneity}
|
||||
homogeneity_between <- long_data %>%
|
||||
group_by(TIME, DOMAIN) %>%
|
||||
rstatix::levene_test(MEAN_SCORE ~ perspective * temporalDO)
|
||||
|
||||
print(homogeneity_between, n = Inf)
|
||||
```
|
||||
|
||||
Levene's test is sigifnicant for two cells: fut-pers and fut-val.
|
||||
However, variance ratios and F-max tests show that any heteroscedasticity is mild.
|
||||
|
||||
## Normality (within-subjects residuals)
|
||||
|
||||
```{r normality}
|
||||
resid_within <- long_data %>%
|
||||
group_by(pID) %>%
|
||||
mutate(person_mean = mean(MEAN_SCORE, na.rm = TRUE)) %>%
|
||||
ungroup() %>%
|
||||
mutate(resid = MEAN_SCORE - person_mean) %>%
|
||||
pull(resid)
|
||||
resid_within <- resid_within[!is.na(resid_within)]
|
||||
|
||||
n_resid <- length(resid_within)
|
||||
if (n_resid < 3L) {
|
||||
message("Too few within-subjects residuals (n < 3); skipping Shapiro-Wilk.")
|
||||
} else {
|
||||
resid_for_shapiro <- if (n_resid > 5000L) {
|
||||
set.seed(1L)
|
||||
sample(resid_within, 5000L)
|
||||
} else {
|
||||
resid_within
|
||||
}
|
||||
print(shapiro.test(resid_for_shapiro))
|
||||
}
|
||||
```
|
||||
|
||||
### Q-Q plot
|
||||
|
||||
```{r qqplot, fig.height = 4}
|
||||
qqnorm(resid_within)
|
||||
qqline(resid_within)
|
||||
```
|
||||
|
||||
Shapiro-Wilk is significant but is sensitive to large sample size.
|
||||
QQ plot shows that centre residuals are normally distributed, with some tail heaviness.
|
||||
ANOVA is robust to violations of normality w/ large sample size.
|
||||
|
||||
Overall, ANOVA can proceed.
|
||||
|
||||
# Mixed ANOVA
|
||||
|
||||
```{r anova}
|
||||
aov_afex <- aov_ez(
|
||||
id = "pID",
|
||||
dv = "MEAN_SCORE",
|
||||
data = long_data,
|
||||
between = c("perspective", "temporalDO"),
|
||||
within = c("TIME", "DOMAIN"),
|
||||
type = 3
|
||||
)
|
||||
|
||||
cat("\n--- ANOVA Table (Type 3, uncorrected) ---\n")
|
||||
print(nice(aov_afex, correction = "none"))
|
||||
cat("\n--- ANOVA Table (Type 3, Greenhouse–Geisser correction) ---\n")
|
||||
print(nice(aov_afex, correction = "GG"))
|
||||
```
|
||||
|
||||
Mauchly's test of sphericity is sig for DOMAIN main effect and interaction (except w/ TIME). Use GG correction for these:
|
||||
- 8 DOMAIN 1.94, 1004.66 1.21 0.63 <.001, p = .529
|
||||
## 9 perspective:DOMAIN 1.94, 1004.66 1.21 7.79 *** <.001, p <.001
|
||||
## 10 temporalDO:DOMAIN 1.94, 1004.66 1.21 0.76 <.001, p = .466
|
||||
## 11 perspective:temporalDO:DOMAIN 1.94, 1004.66 1.21 0.17 <.001, p = .837
|
||||
|
||||
|
||||
The following are significant main effects and interactions:
|
||||
## 15 perspective:temporalDO:TIME:DOMAIN 2, 1036 0.75 3.11 * <.001 .045
|
||||
## 13 perspective:TIME:DOMAIN 2, 1036 0.75 3.58 * <.001 .028
|
||||
## 9 perspective:DOMAIN 1.94, 1004.66 1.21 7.79 *** <.001, p <.001 (GG corrected)
|
||||
## 6 temporalDO:TIME 1, 518 1.86 9.81 ** <.001 .002
|
||||
## 7 perspective:temporalDO:TIME 1, 518 1.86 7.91 ** <.001 .005
|
||||
## 4 TIME 1, 518 1.86 10.05 ** <.001 .002
|
||||
|
||||
|
||||
# Mauchly and epsilon
|
||||
|
||||
```{r mauchly}
|
||||
anova_wide <- anova_data %>%
|
||||
select(pID, perspective, temporalDO, all_of(within_vars)) %>%
|
||||
filter(if_all(all_of(within_vars), ~ !is.na(.)))
|
||||
response_matrix <- as.matrix(anova_wide[, within_vars])
|
||||
rm_model <- lm(response_matrix ~ perspective * temporalDO, data = anova_wide)
|
||||
idata <- data.frame(
|
||||
TIME = factor(rep(c("past", "fut"), each = 3), levels = c("past", "fut")),
|
||||
DOMAIN = factor(rep(c("pref", "pers", "val"), 2), levels = c("pref", "pers", "val"))
|
||||
)
|
||||
rm_anova <- car::Anova(rm_model, idata = idata, idesign = ~ TIME * DOMAIN, type = 3)
|
||||
rm_summary <- summary(rm_anova, multivariate = FALSE)
|
||||
if (!is.null(rm_summary$sphericity.tests)) {
|
||||
cat("\nMauchly's Test of Sphericity:\n")
|
||||
print(rm_summary$sphericity.tests)
|
||||
}
|
||||
if (!is.null(rm_summary$epsilon)) {
|
||||
cat("\nEpsilon (GG, HF):\n")
|
||||
print(rm_summary$epsilon)
|
||||
}
|
||||
```
|
||||
|
||||
# Post-hoc comparisons
|
||||
|
||||
## TIME (main effect)
|
||||
|
||||
```{r posthoc-TIME}
|
||||
emm_TIME <- emmeans(aov_afex, ~ TIME)
|
||||
print(pairs(emm_TIME, adjust = "bonferroni"))
|
||||
```
|
||||
|
||||
Pairwise comparison provide supprot for EHI effect.
|
||||
|
||||
## temporalDO:TIME
|
||||
|
||||
```{r posthoc-temporalDO-TIME}
|
||||
emm_temporalDO_TIME <- emmeans(aov_afex, ~ TIME | temporalDO)
|
||||
print(pairs(emm_temporalDO_TIME, adjust = "bonferroni"))
|
||||
```
|
||||
|
||||
Contrast significant only for temporal display order of past first, then future.
|
||||
When grouped by time instead of temporalDO, no contrasts are significant.
|
||||
|
||||
## perspective:temporalDO:TIME
|
||||
|
||||
```{r posthoc-pt-TIME}
|
||||
emm_pt_TIME <- emmeans(aov_afex, ~ TIME | perspective + temporalDO)
|
||||
print(pairs(emm_pt_TIME, adjust = "bonferroni"))
|
||||
```
|
||||
|
||||
EHI is significant only for self perspective and past first temporal display order.
|
||||
|
||||
When grouped by perspective or temporalDO instead of TIME, no contrasts are significant.
|
||||
|
||||
## perspective:DOMAIN
|
||||
|
||||
```{r posthoc-perspective-DOMAIN}
|
||||
emm_perspective_DOMAIN <- emmeans(aov_afex, ~ perspective | DOMAIN)
|
||||
print(pairs(emm_perspective_DOMAIN, adjust = "bonferroni"))
|
||||
emm_perspective_DOMAIN_domain <- emmeans(aov_afex, ~ DOMAIN | perspective)
|
||||
print(pairs(emm_perspective_DOMAIN_domain, adjust = "bonferroni"))
|
||||
```
|
||||
|
||||
significance is driven by the change from preferences to values in the "other" perspective.
|
||||
|
||||
## perspective:TIME:DOMAIN
|
||||
|
||||
```{r posthoc-pt-DOMAIN}
|
||||
emm_pt_TIME_domain <- emmeans(aov_afex, ~ TIME | perspective + DOMAIN)
|
||||
print(pairs(emm_pt_TIME_domain, adjust = "bonferroni"))
|
||||
```
|
||||
|
||||
EHI effects present for other-perspective in the preferences domain and for self-perspective in the values domain.
|
||||
Estimate is higher in the self-perspective than in the other-perspective.
|
||||
|
||||
```{r posthoc-pt-DOMAIN-domain}
|
||||
emm_pt_domain_domain <- emmeans(aov_afex, ~ DOMAIN | perspective + TIME)
|
||||
print(pairs(emm_pt_domain_domain, adjust = "bonferroni"))
|
||||
```
|
||||
|
||||
Significant contrasts are driven by domain changes from preferences to values in the self vs other perspectives, in the past-oriented questions.
|
||||
Trends reverse depending on perspective, where values have higher estimates than preferences in the self-perspective, but lower estimates than preferences in the other-perspective.
|
||||
|
||||
## perspective:temporalDO:TIME:DOMAIN
|
||||
|
||||
```{r posthoc-ptt-TIME}
|
||||
emm_ptt_TIME <- emmeans(aov_afex, ~ TIME | perspective + temporalDO + DOMAIN)
|
||||
print(pairs(emm_ptt_TIME, adjust = "bonferroni"))
|
||||
```
|
||||
EHI effects are present for three contrasts:
|
||||
- past - fut 0.2806 0.118 518 2.380 0.0177 (other-perspective, preferences domain, past-first temporal display order)
|
||||
- past - fut 0.4358 0.138 518 3.156 0.0017 (self-perspective, personality domain, past-first temporal display order)
|
||||
- past - fut 0.7276 0.141 518 5.169 <0.0001 (self-perspective, values domain, past-first temporal display order)
|
||||
|
||||
A reverse EHI effect is present for 1 contrast:
|
||||
- past - fut -0.2367 0.118 518 -2.001 0.0459 (self-personality, preferences domain, future-first temporal display order)
|
||||
|
||||
```{r posthoc-ptt-perspective}
|
||||
emm_ptt_perspective <- emmeans(aov_afex, ~ perspective | temporalDO + TIME + DOMAIN)
|
||||
print(pairs(emm_ptt_perspective, adjust = "bonferroni"))
|
||||
```
|
||||
1 significant contrast:
|
||||
- other - self -0.6972 0.314 518 -2.220 0.0268 (values domain, past-oriented questions, past-first temporal display order)
|
||||
|
||||
|
||||
not really of theoretical interest but speaks to the perspective:TIME:DOMAIN interaction.
|
||||
|
||||
no significant contrasts when grouped by temporalDO instead of TIME or perspective.
|
||||
|
||||
## Cohen's d (significant contrasts only)
|
||||
|
||||
```{r cohens-d-significant}
|
||||
d_data <- anova_data %>%
|
||||
mutate(
|
||||
past_mean = (past_pref_MEAN + past_pers_MEAN + past_val_MEAN) / 3,
|
||||
fut_mean = (fut_pref_MEAN + fut_pers_MEAN + fut_val_MEAN) / 3,
|
||||
pref_mean = (past_pref_MEAN + fut_pref_MEAN) / 2,
|
||||
pers_mean = (past_pers_MEAN + fut_pers_MEAN) / 2,
|
||||
val_mean = (past_val_MEAN + fut_val_MEAN) / 2
|
||||
)
|
||||
|
||||
cohens_d_results <- tibble(
|
||||
contrast = character(),
|
||||
condition = character(),
|
||||
d = double()
|
||||
)
|
||||
|
||||
# TIME main: past vs fut
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "overall",
|
||||
d = suppressMessages(effectsize::cohens_d(d_data$past_mean, d_data$fut_mean, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# temporalDO:TIME: past vs fut for temporalDO = past
|
||||
d_past_tdo <- d_data %>% filter(temporalDO == "past")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "temporalDO = past",
|
||||
d = suppressMessages(effectsize::cohens_d(d_past_tdo$past_mean, d_past_tdo$fut_mean, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# perspective:temporalDO:TIME: past vs fut for self, past temporalDO
|
||||
d_self_past <- d_data %>% filter(perspective == "self", temporalDO == "past")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "self, temporalDO = past",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_past$past_mean, d_self_past$fut_mean, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# perspective:DOMAIN: pref vs val for perspective = other
|
||||
d_other <- d_data %>% filter(perspective == "other")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pref - val)",
|
||||
condition = "perspective = other",
|
||||
d = suppressMessages(effectsize::cohens_d(d_other$pref_mean, d_other$val_mean, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# perspective:TIME:DOMAIN - TIME: other, pref
|
||||
d_other_pref <- d_data %>% filter(perspective == "other")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "other, pref domain",
|
||||
d = suppressMessages(effectsize::cohens_d(d_other_pref$past_pref_MEAN, d_other_pref$fut_pref_MEAN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# perspective:TIME:DOMAIN - TIME: self, val
|
||||
d_self_val <- d_data %>% filter(perspective == "self")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "self, val domain",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_val$past_val_MEAN, d_self_val$fut_val_MEAN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# perspective:TIME:DOMAIN - DOMAIN: other, past TIME
|
||||
d_other_past <- d_data %>% filter(perspective == "other")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pref - val)",
|
||||
condition = "other, past TIME",
|
||||
d = suppressMessages(effectsize::cohens_d(d_other_past$past_pref_MEAN, d_other_past$past_val_MEAN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# perspective:TIME:DOMAIN - DOMAIN: self, past TIME: pref - pers
|
||||
d_self_past_t <- d_data %>% filter(perspective == "self")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pref - pers)",
|
||||
condition = "self, past TIME",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_past_t$past_pref_MEAN, d_self_past_t$past_pers_MEAN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# perspective:TIME:DOMAIN - DOMAIN: self, past TIME: pref - val
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pref - val)",
|
||||
condition = "self, past TIME",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_past_t$past_pref_MEAN, d_self_past_t$past_val_MEAN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way TIME: self, future temporalDO, pref (reverse EHI)
|
||||
d_self_fut_pref <- d_data %>% filter(perspective == "self", temporalDO == "future")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut) [reverse]",
|
||||
condition = "self, future temporalDO, pref domain",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_fut_pref$past_pref_MEAN, d_self_fut_pref$fut_pref_MEAN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way TIME: other, past temporalDO, pref
|
||||
d_other_past_pref <- d_data %>% filter(perspective == "other", temporalDO == "past")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "other, past temporalDO, pref domain",
|
||||
d = suppressMessages(effectsize::cohens_d(d_other_past_pref$past_pref_MEAN, d_other_past_pref$fut_pref_MEAN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way TIME: self, past temporalDO, pers
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "self, past temporalDO, pers domain",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_past$past_pers_MEAN, d_self_past$fut_pers_MEAN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way TIME: self, past temporalDO, val
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "self, past temporalDO, val domain",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_past$past_val_MEAN, d_self_past$fut_val_MEAN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way perspective: past temporalDO, past TIME, val domain (other - self, between-subjects)
|
||||
d_ptt_val <- d_data %>%
|
||||
filter(temporalDO == "past") %>%
|
||||
select(perspective, past_val_MEAN)
|
||||
d_other_ptt <- d_ptt_val %>% filter(perspective == "other") %>% pull(past_val_MEAN)
|
||||
d_self_ptt <- d_ptt_val %>% filter(perspective == "self") %>% pull(past_val_MEAN)
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "perspective (other - self)",
|
||||
condition = "past temporalDO, past TIME, val domain",
|
||||
d = suppressMessages(effectsize::cohens_d(d_other_ptt, d_self_ptt, paired = FALSE)$Cohens_d)
|
||||
)
|
||||
|
||||
cohens_d_results %>%
|
||||
mutate(d = round(d, 3)) %>%
|
||||
print(n = Inf)
|
||||
```
|
||||
2535
eohi3/knit/DA01_anova_DS.html
Normal file
2535
eohi3/knit/DA01_anova_DS.html
Normal file
File diff suppressed because one or more lines are too long
2345
eohi3/knit/DA02_anova_DGEN.html
Normal file
2345
eohi3/knit/DA02_anova_DGEN.html
Normal file
File diff suppressed because one or more lines are too long
434
eohi3/knit/DA02_anova_DGEN.rmd
Normal file
434
eohi3/knit/DA02_anova_DGEN.rmd
Normal file
@ -0,0 +1,434 @@
|
||||
---
|
||||
title: "Mixed ANOVA - Domain General Vars"
|
||||
author: ""
|
||||
date: "`r Sys.Date()`"
|
||||
output:
|
||||
html_document:
|
||||
toc: true
|
||||
toc_float: true
|
||||
code_folding: hide
|
||||
---
|
||||
|
||||
```{r setup, include = FALSE}
|
||||
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = TRUE)
|
||||
```
|
||||
|
||||
# Setup
|
||||
|
||||
```{r libraries}
|
||||
library(tidyverse)
|
||||
library(rstatix)
|
||||
library(emmeans)
|
||||
library(effectsize)
|
||||
library(afex)
|
||||
library(car)
|
||||
|
||||
options(scipen = 999)
|
||||
afex::set_sum_contrasts()
|
||||
```
|
||||
|
||||
# Data
|
||||
|
||||
```{r read-data}
|
||||
# Data file is in parent of knit/ (eohi3/eohi3.csv)
|
||||
df <- read.csv(
|
||||
"/home/ladmin/Documents/DND/EOHI/eohi3/eohi3.csv",
|
||||
stringsAsFactors = FALSE,
|
||||
check.names = FALSE,
|
||||
na.strings = "NA"
|
||||
)
|
||||
|
||||
between_vars <- c("perspective", "temporalDO")
|
||||
within_vars <- c(
|
||||
"past_pref_DGEN", "past_pers_DGEN", "past_val_DGEN",
|
||||
"fut_pref_DGEN", "fut_pers_DGEN", "fut_val_DGEN"
|
||||
)
|
||||
|
||||
missing_vars <- setdiff(c(between_vars, within_vars, "pID"), names(df))
|
||||
if (length(missing_vars) > 0) {
|
||||
stop(paste("Missing required variables:", paste(missing_vars, collapse = ", ")))
|
||||
}
|
||||
|
||||
anova_data <- df %>%
|
||||
select(pID, all_of(between_vars), all_of(within_vars)) %>%
|
||||
filter(
|
||||
!is.na(perspective), perspective != "",
|
||||
!is.na(temporalDO), temporalDO != ""
|
||||
)
|
||||
```
|
||||
|
||||
# Long format
|
||||
|
||||
```{r long-format}
|
||||
long_data <- anova_data %>%
|
||||
pivot_longer(
|
||||
cols = all_of(within_vars),
|
||||
names_to = "variable",
|
||||
values_to = "DGEN_SCORE"
|
||||
) %>%
|
||||
mutate(
|
||||
time = case_when(
|
||||
grepl("^past_", variable) ~ "past",
|
||||
grepl("^fut_", variable) ~ "fut",
|
||||
TRUE ~ NA_character_
|
||||
),
|
||||
domain = case_when(
|
||||
grepl("_pref_DGEN$", variable) ~ "pref",
|
||||
grepl("_pers_DGEN$", variable) ~ "pers",
|
||||
grepl("_val_DGEN$", variable) ~ "val",
|
||||
TRUE ~ NA_character_
|
||||
)
|
||||
) %>%
|
||||
mutate(
|
||||
TIME = factor(time, levels = c("past", "fut")),
|
||||
DOMAIN = factor(domain, levels = c("pref", "pers", "val")),
|
||||
perspective = factor(perspective),
|
||||
temporalDO = factor(temporalDO),
|
||||
pID = factor(pID)
|
||||
) %>%
|
||||
select(pID, perspective, temporalDO, TIME, DOMAIN, DGEN_SCORE) %>%
|
||||
filter(!is.na(DGEN_SCORE))
|
||||
```
|
||||
|
||||
# Descriptive statistics
|
||||
|
||||
```{r desc-stats}
|
||||
desc_stats <- long_data %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n = n(),
|
||||
mean = round(mean(DGEN_SCORE), 5),
|
||||
variance = round(var(DGEN_SCORE), 5),
|
||||
sd = round(sd(DGEN_SCORE), 5),
|
||||
median = round(median(DGEN_SCORE), 5),
|
||||
q1 = round(quantile(DGEN_SCORE, 0.25), 5),
|
||||
q3 = round(quantile(DGEN_SCORE, 0.75), 5),
|
||||
min = round(min(DGEN_SCORE), 5),
|
||||
max = round(max(DGEN_SCORE), 5),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
# Show all rows and columns (no truncation)
|
||||
options(tibble.width = Inf)
|
||||
print(desc_stats, n = Inf)
|
||||
```
|
||||
|
||||
Interpretation:
|
||||
1. Mean and median values are similar w/ slightly more variation than in the domain specific anova.
|
||||
2. Highest to lowest group n size ratio is 1.14 (139/122). Acceptable ratio for ANOVA (under 1.5).
|
||||
3. Highest to lowest overall group variance ratio is 1.40 (9.32/6.65). Acceptable ratio for ANOVA (under 4).
|
||||
For the sake of consistency w/ the other EHI studies, I also calculated Hartley's F-max ratio.
|
||||
The conservative F-max critical value is 1.60 (same as DS anova since number of groups and n sizes doesn't change), which is still higher than the highest observed F-max ratio of 1.28.
|
||||
|
||||
# Assumption checks
|
||||
|
||||
## Missing values
|
||||
|
||||
```{r missing}
|
||||
missing_summary <- long_data %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n_total = n(),
|
||||
n_missing = sum(is.na(DGEN_SCORE)),
|
||||
pct_missing = round(100 * n_missing / n_total, 2),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
print(missing_summary, n = Inf)
|
||||
```
|
||||
|
||||
No missing values. As expected.
|
||||
|
||||
## Outliers
|
||||
|
||||
```{r outliers}
|
||||
outlier_summary <- long_data %>%
|
||||
group_by(perspective, temporalDO, TIME, DOMAIN) %>%
|
||||
summarise(
|
||||
n = n(),
|
||||
n_outliers = sum(abs(scale(DGEN_SCORE)) > 3),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
print(outlier_summary, n = Inf)
|
||||
```
|
||||
|
||||
No outliers present. Good. Same as DS anova.
|
||||
|
||||
## Homogeneity of variance
|
||||
|
||||
```{r homogeneity}
|
||||
homogeneity_between <- long_data %>%
|
||||
group_by(TIME, DOMAIN) %>%
|
||||
rstatix::levene_test(DGEN_SCORE ~ perspective * temporalDO)
|
||||
|
||||
print(homogeneity_between, n = Inf)
|
||||
```
|
||||
|
||||
Levene's test is signiicant for 1 cell only: past-val. However, variance ratios and F-max tests show that any heteroscedasticity is mild.
|
||||
|
||||
## Normality (within-subjects residuals)
|
||||
|
||||
```{r normality}
|
||||
resid_within <- long_data %>%
|
||||
group_by(pID) %>%
|
||||
mutate(person_mean = mean(DGEN_SCORE, na.rm = TRUE)) %>%
|
||||
ungroup() %>%
|
||||
mutate(resid = DGEN_SCORE - person_mean) %>%
|
||||
pull(resid)
|
||||
resid_within <- resid_within[!is.na(resid_within)]
|
||||
|
||||
n_resid <- length(resid_within)
|
||||
if (n_resid < 3L) {
|
||||
message("Too few within-subjects residuals (n < 3); skipping Shapiro-Wilk.")
|
||||
} else {
|
||||
resid_for_shapiro <- if (n_resid > 5000L) {
|
||||
set.seed(1L)
|
||||
sample(resid_within, 5000L)
|
||||
} else {
|
||||
resid_within
|
||||
}
|
||||
print(shapiro.test(resid_for_shapiro))
|
||||
}
|
||||
```
|
||||
|
||||
### Q-Q plot
|
||||
|
||||
```{r qqplot, fig.height = 4}
|
||||
qqnorm(resid_within)
|
||||
qqline(resid_within)
|
||||
```
|
||||
|
||||
Shapiro-Wilk test is significant but is sensitive to large sample size.
|
||||
QQ plot shows that strict centre residuals are normally distributed, but there is some deviation from normality.
|
||||
ANOVA is robust to violations of normality w/ large sample size.
|
||||
|
||||
Overall, ANOVA can proceed.
|
||||
|
||||
# Mixed ANOVA
|
||||
|
||||
```{r anova}
|
||||
aov_afex <- aov_ez(
|
||||
id = "pID",
|
||||
dv = "DGEN_SCORE",
|
||||
data = long_data,
|
||||
between = c("perspective", "temporalDO"),
|
||||
within = c("TIME", "DOMAIN"),
|
||||
type = 3,
|
||||
anova_table = list(correction = "none")
|
||||
)
|
||||
|
||||
print(aov_afex)
|
||||
```
|
||||
|
||||
Mauchly's test of sphericity is not significant. Using uncorrected values for interpretation and analysis.
|
||||
|
||||
|
||||
Significant main effects and interactions:
|
||||
Effect df MSE F ges p
|
||||
4 TIME 1, 518 3.11 8.39 ** .001 .004
|
||||
8 DOMAIN 2, 1036 2.13 7.85 *** .001 <.001
|
||||
10 temporalDO:DOMAIN 2, 1036 2.13 5.00 ** <.001 .007
|
||||
15 perspective:temporalDO:TIME:DOMAIN 2, 1036 1.52 3.12 * <.001 .045
|
||||
|
||||
|
||||
# Mauchly and epsilon
|
||||
|
||||
```{r mauchly}
|
||||
anova_wide <- anova_data %>%
|
||||
select(pID, perspective, temporalDO, all_of(within_vars)) %>%
|
||||
filter(if_all(all_of(within_vars), ~ !is.na(.)))
|
||||
response_matrix <- as.matrix(anova_wide[, within_vars])
|
||||
rm_model <- lm(response_matrix ~ perspective * temporalDO, data = anova_wide)
|
||||
idata <- data.frame(
|
||||
TIME = factor(rep(c("past", "fut"), each = 3), levels = c("past", "fut")),
|
||||
DOMAIN = factor(rep(c("pref", "pers", "val"), 2), levels = c("pref", "pers", "val"))
|
||||
)
|
||||
rm_anova <- car::Anova(rm_model, idata = idata, idesign = ~ TIME * DOMAIN, type = 3)
|
||||
rm_summary <- summary(rm_anova, multivariate = FALSE)
|
||||
if (!is.null(rm_summary$sphericity.tests)) {
|
||||
print(rm_summary$sphericity.tests)
|
||||
}
|
||||
if (!is.null(rm_summary$epsilon)) {
|
||||
print(rm_summary$epsilon)
|
||||
}
|
||||
```
|
||||
|
||||
# Post hoc comparisons
|
||||
|
||||
## TIME (main effect)
|
||||
|
||||
```{r posthoc-TIME}
|
||||
emm_TIME <- emmeans(aov_afex, ~ TIME)
|
||||
print(pairs(emm_TIME, adjust = "none"))
|
||||
```
|
||||
|
||||
Supports presence of EHI effect.
|
||||
|
||||
## DOMAIN (main effect)
|
||||
|
||||
```{r posthoc-domain}
|
||||
emm_DOMAIN <- emmeans(aov_afex, ~ DOMAIN)
|
||||
print(pairs(emm_DOMAIN, adjust = "tukey"))
|
||||
```
|
||||
|
||||
Only preference to values contrast is significant.
|
||||
|
||||
## temporalDO:DOMAIN
|
||||
|
||||
```{r posthoc-temporaldo-domain}
|
||||
emmeans(aov_afex, pairwise ~ temporalDO | DOMAIN, adjust = "none")$contrasts
|
||||
emmeans(aov_afex, pairwise ~ DOMAIN | temporalDO, adjust = "tukey")$contrasts
|
||||
```
|
||||
|
||||
When grouped by domain, no contrasts are significant.
|
||||
|
||||
|
||||
When grouped by temporalDO, some contrasts are significant:
|
||||
|
||||
Future-first temporal display order:
|
||||
contrast estimate SE df t.ratio p.value
|
||||
pref - pers 0.25065 0.0892 518 2.810 0.0142
|
||||
|
||||
|
||||
Past-first temporal display order:
|
||||
contrast estimate SE df t.ratio p.value
|
||||
pref - val 0.33129 0.0895 518 3.702 0.0007
|
||||
pers - val 0.32478 0.0921 518 3.527 0.0013
|
||||
|
||||
## perspective:temporalDO:TIME:DOMAIN
|
||||
|
||||
### contrasts for TIME grouped by perspective, temporalDO, and DOMAIN
|
||||
```{r posthoc-fourway}
|
||||
emm_fourway <- emmeans(aov_afex, pairwise ~ TIME | perspective * temporalDO * DOMAIN, adjust = "tukey")
|
||||
print(emm_fourway$contrasts)
|
||||
```
|
||||
|
||||
Significant contrasts:
|
||||
|
||||
contrast estimate SE df t.ratio p.value
|
||||
past - fut 0.5285 0.179 518 2.957 0.0032 (self-perspective, personality domain, past-first temporal display order)
|
||||
past - fut 0.5366 0.187 518 2.863 0.0044 (self-perspective, values domain, past-first temporal display order)
|
||||
|
||||
### contrasts for DOMAIN grouped by perspective, TIME, and temporalDO
|
||||
```{r posthoc-fourway2}
|
||||
emm_fourway2 <- emmeans(aov_afex, pairwise ~ DOMAIN | perspective * TIME * temporalDO, adjust = "tukey")
|
||||
print(emm_fourway2$contrasts)
|
||||
```
|
||||
|
||||
Significant contrasts:
|
||||
|
||||
contrast estimate SE df t.ratio p.value
|
||||
pref - val 0.6259 0.166 518 3.778 0.0005 (other-perspective, past-directed questions, past-first temporal display order)
|
||||
pers - val 0.4892 0.160 518 3.056 0.0066 (other-perspective, past-directed questions, past-first temporal display order)
|
||||
pref - val 0.4309 0.168 518 2.559 0.0290 (self-perspective, future-directed questions, past-first temporal display order)
|
||||
|
||||
## Cohen's d (significant contrasts only)
|
||||
|
||||
```{r cohens-d-significant}
|
||||
d_data <- anova_data %>%
|
||||
mutate(
|
||||
past_mean = (past_pref_DGEN + past_pers_DGEN + past_val_DGEN) / 3,
|
||||
fut_mean = (fut_pref_DGEN + fut_pers_DGEN + fut_val_DGEN) / 3,
|
||||
pref_mean = (past_pref_DGEN + fut_pref_DGEN) / 2,
|
||||
pers_mean = (past_pers_DGEN + fut_pers_DGEN) / 2,
|
||||
val_mean = (past_val_DGEN + fut_val_DGEN) / 2
|
||||
)
|
||||
|
||||
cohens_d_results <- tibble(
|
||||
contrast = character(),
|
||||
condition = character(),
|
||||
d = double()
|
||||
)
|
||||
|
||||
# TIME main: past vs fut
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "overall",
|
||||
d = suppressMessages(effectsize::cohens_d(d_data$past_mean, d_data$fut_mean, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# DOMAIN main: pref vs val
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pref - val)",
|
||||
condition = "overall",
|
||||
d = suppressMessages(effectsize::cohens_d(d_data$pref_mean, d_data$val_mean, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# temporalDO:DOMAIN - future: pref vs pers
|
||||
d_fut <- d_data %>% filter(temporalDO == "future")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pref - pers)",
|
||||
condition = "temporalDO = future",
|
||||
d = suppressMessages(effectsize::cohens_d(d_fut$pref_mean, d_fut$pers_mean, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# temporalDO:DOMAIN - past: pref vs val, pers vs val
|
||||
d_past <- d_data %>% filter(temporalDO == "past")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pref - val)",
|
||||
condition = "temporalDO = past",
|
||||
d = suppressMessages(effectsize::cohens_d(d_past$pref_mean, d_past$val_mean, paired = TRUE)$Cohens_d)
|
||||
) %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pers - val)",
|
||||
condition = "temporalDO = past",
|
||||
d = suppressMessages(effectsize::cohens_d(d_past$pers_mean, d_past$val_mean, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way TIME: self, past temporalDO, pers
|
||||
d_self_past <- d_data %>% filter(perspective == "self", temporalDO == "past")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "self, past temporalDO, pers domain",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_past$past_pers_DGEN, d_self_past$fut_pers_DGEN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way TIME: self, past temporalDO, val
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "TIME (past - fut)",
|
||||
condition = "self, past temporalDO, val domain",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_past$past_val_DGEN, d_self_past$fut_val_DGEN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way DOMAIN: other, past TIME, past temporalDO - pref vs val
|
||||
d_other_past_tpast <- d_data %>% filter(perspective == "other", temporalDO == "past")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pref - val)",
|
||||
condition = "other, past TIME, past temporalDO",
|
||||
d = suppressMessages(effectsize::cohens_d(d_other_past_tpast$past_pref_DGEN, d_other_past_tpast$past_val_DGEN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way DOMAIN: other, past TIME, past temporalDO - pers vs val
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pers - val)",
|
||||
condition = "other, past TIME, past temporalDO",
|
||||
d = suppressMessages(effectsize::cohens_d(d_other_past_tpast$past_pers_DGEN, d_other_past_tpast$past_val_DGEN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
# 4-way DOMAIN: self, fut TIME, past temporalDO - pref vs val
|
||||
d_self_fut_tpast <- d_data %>% filter(perspective == "self", temporalDO == "past")
|
||||
cohens_d_results <- cohens_d_results %>%
|
||||
add_row(
|
||||
contrast = "DOMAIN (pref - val)",
|
||||
condition = "self, fut TIME, past temporalDO",
|
||||
d = suppressMessages(effectsize::cohens_d(d_self_fut_tpast$fut_pref_DGEN, d_self_fut_tpast$fut_val_DGEN, paired = TRUE)$Cohens_d)
|
||||
)
|
||||
|
||||
cohens_d_results %>%
|
||||
mutate(d = round(d, 3)) %>%
|
||||
print(n = Inf)
|
||||
```
|
||||
|
||||
Size d Interpretation
|
||||
Small 0.2 Weak effect
|
||||
Medium 0.5 Moderate effect
|
||||
Large 0.8 Strong effect
|
||||
Loading…
x
Reference in New Issue
Block a user