# ============================================================
# 0. パッケージ
# ============================================================
library(tidyverse)
## Warning: package 'purrr' was built under R version 4.3.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(readxl)
## Warning: package 'readxl' was built under R version 4.3.3
library(psych)
## Warning: package 'psych' was built under R version 4.3.3
##
## Attaching package: 'psych'
##
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
library(GPArotation)
##
## Attaching package: 'GPArotation'
##
## The following objects are masked from 'package:psych':
##
## equamax, varimin
library(lme4)
## Warning: package 'lme4' was built under R version 4.3.3
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
library(lmerTest)
##
## Attaching package: 'lmerTest'
##
## The following object is masked from 'package:lme4':
##
## lmer
##
## The following object is masked from 'package:stats':
##
## step
library(emmeans)
## Warning: package 'emmeans' was built under R version 4.3.3
## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'
library(car)
## Loading required package: carData
##
## Attaching package: 'car'
##
## The following object is masked from 'package:psych':
##
## logit
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## some
library(broom)
library(broom.mixed)
## Warning: package 'broom.mixed' was built under R version 4.3.3
## Registered S3 method overwritten by 'future':
## method from
## all.equal.connection parallelly
options(mc.cores = 1)
# ============================================================
# 1. データ読み込み
# ============================================================
# engagement_wide.xlsx の「data」シートは2行ヘッダー
# （1行目=construct帯, 2行目=Q番号）になっているため、
# シート全体を読み込んでから1〜2行目をヘッダーとして組み立てる。
# ============================================================
setwd("~/Desktop/writing_emotion")
df_sheet <- read_excel("engagement_wide.xlsx", sheet = "data", col_names = FALSE)
## New names:
## • `` -> `...1`
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`
## • `` -> `...14`
## • `` -> `...15`
## • `` -> `...16`
## • `` -> `...17`
## • `` -> `...18`
## • `` -> `...19`
## • `` -> `...20`
## • `` -> `...21`
## • `` -> `...22`
## • `` -> `...23`
## • `` -> `...24`
## • `` -> `...25`
## • `` -> `...26`
## • `` -> `...27`
## • `` -> `...28`
## • `` -> `...29`
## • `` -> `...30`
## • `` -> `...31`
## • `` -> `...32`
## • `` -> `...33`
## • `` -> `...34`
## • `` -> `...35`
## • `` -> `...36`
## • `` -> `...37`
## • `` -> `...38`
## • `` -> `...39`
## • `` -> `...40`
## • `` -> `...41`
## • `` -> `...42`
## • `` -> `...43`
## • `` -> `...44`
## • `` -> `...45`
## • `` -> `...46`
## • `` -> `...47`
## • `` -> `...48`
## • `` -> `...49`
## • `` -> `...50`
## • `` -> `...51`
## • `` -> `...52`
## • `` -> `...53`
## • `` -> `...54`
## • `` -> `...55`
## • `` -> `...56`
## • `` -> `...57`
## • `` -> `...58`
## • `` -> `...59`
## • `` -> `...60`
header_row1 <- df_sheet %>% slice(1) %>% unlist(use.names = FALSE) %>% as.character()
header_row2 <- df_sheet %>% slice(2) %>% unlist(use.names = FALSE) %>% as.character()
final_header <- if_else(is.na(header_row2) | header_row2 == "", header_row1, header_row2)
stopifnot("列名にNA/空文字が残っています" = all(!is.na(final_header) & final_header != ""))
df_raw <- df_sheet %>% slice(-(1:2))
names(df_raw) <- final_header
codebook <- read_excel("engagement_wide.xlsx", sheet = "codebook")
df_raw <- df_raw %>%
mutate(ID = as.numeric(ID), across(starts_with("Q"), as.numeric))
dim(df_raw)
## [1] 92 60
# ============================================================
# 2. Q列の逆転処理
# ============================================================
# ★重要★ engagement.xlsxのItem番号は、元のEmotion調査
# （Q1〜Q20）とは異なる独自の採番（ランダム化用）になっている。
# 逆転すべき項目は、Constructが"Task difficulty"かつ
# 英語テキストに"easy"/"effortless"を含むものとして、
# 日本語リテラルではなく英語テキストで機械的に特定する
# （このbankではQ19「easy」・Q20「effortless」が該当）。
# ============================================================
reverse_target_items <- codebook %>%
filter(
Construct == "Task difficulty",
str_detect(English, regex("\\beasy\\b|effortless", ignore_case = TRUE))
)
cat("逆転対象:\n")
## 逆転対象:
print(reverse_target_items %>% select(Q, Item, English))
## # A tibble: 2 × 3
## Q Item English
## <chr> <dbl> <chr>
## 1 Q19 19 The task was easy.
## 2 Q20 20 The task was effortless.
stopifnot("逆転対象の項目数が想定(2件)と異なります" = nrow(reverse_target_items) == 2)
reverse_cols <- reverse_target_items$Q
before_vals <- map(reverse_cols, ~ df_raw[[.x]])
for (col in reverse_cols) df_raw[[col]] <- 6 - df_raw[[col]]
for (i in seq_along(reverse_cols)) {
stopifnot(!identical(df_raw[[reverse_cols[i]]], before_vals[[i]]))
}
cat("反転した列:", paste(reverse_cols, collapse = ", "), "\n")
## 反転した列: Q19, Q20
# ============================================================
# 3. 項目 <-> construct 対応表の準備
# ============================================================
get_cols_for_construct <- function(construct_name) {
items <- codebook %>% filter(Construct == construct_name, Collected == "Yes") %>% pull(Item)
map_chr(items, function(it) {
hit <- names(df_raw)[str_detect(names(df_raw), paste0("^Q", it, "$"))]
stopifnot(length(hit) == 1)
hit
})
}
# --- Emotion: 5構成概念 ---
# AnxietyはQ4/Q12相当（speaking特有の文言）をwriting taskへの
# content validityの観点から除外し、2項目のみ使用する
# （writing_emotion.Rmdでの決定と同じ）。
emotion_constructs <- c("Enjoyment", "Boredom", "Pride", "Anxiety", "Task difficulty")
emotion_cols_list <- set_names(map(emotion_constructs, get_cols_for_construct), emotion_constructs)
anxiety_speaking_specific <- codebook %>%
filter(Construct == "Anxiety", str_detect(English, regex("speaking English|understand my English", ignore_case = TRUE)))
cat("Anxietyから除外する項目（speaking特有のため）:\n")
## Anxietyから除外する項目（speaking特有のため）:
print(anxiety_speaking_specific %>% select(Q, Item, English))
## # A tibble: 2 × 3
## Q Item English
## <chr> <dbl> <chr>
## 1 Q10 10 I could feel my heart pounding, worrying if my partner will under…
## 2 Q12 12 I got nervous when speaking English during the task.
stopifnot(nrow(anxiety_speaking_specific) == 2)
emotion_cols_list[["Anxiety"]] <- setdiff(emotion_cols_list[["Anxiety"]], anxiety_speaking_specific$Q)
emotion_items <- unlist(emotion_cols_list, use.names = FALSE)
emotion_item_map <- tibble(Q = emotion_items) %>%
left_join(codebook %>% select(Q, Construct), by = "Q")
cat("\nEmotion項目数:", length(emotion_items), "\n")
##
## Emotion項目数: 18
print(emotion_item_map)
## # A tibble: 18 × 2
## Q Construct
## <chr> <chr>
## 1 Q1 Enjoyment
## 2 Q2 Enjoyment
## 3 Q3 Enjoyment
## 4 Q4 Enjoyment
## 5 Q13 Boredom
## 6 Q14 Boredom
## 7 Q15 Boredom
## 8 Q16 Boredom
## 9 Q5 Pride
## 10 Q6 Pride
## 11 Q7 Pride
## 12 Q8 Pride
## 13 Q9 Anxiety
## 14 Q11 Anxiety
## 15 Q17 Task difficulty
## 16 Q18 Task difficulty
## 17 Q19 Task difficulty
## 18 Q20 Task difficulty
# --- Engagement: 4構成概念（Emotional engagementは未収集） ---
engagement_constructs <- c("Behavioral engagement", "Cognitive engagement", "Agentic engagement", "Social engagement")
engagement_cols_list <- set_names(map(engagement_constructs, get_cols_for_construct), engagement_constructs)
engagement_items <- unlist(engagement_cols_list, use.names = FALSE)
engagement_item_map <- tibble(Q = engagement_items) %>%
left_join(codebook %>% select(Q, Construct), by = "Q")
cat("\nEngagement項目数:", length(engagement_items), "\n")
##
## Engagement項目数: 20
print(engagement_item_map)
## # A tibble: 20 × 2
## Q Construct
## <chr> <chr>
## 1 Q21 Behavioral engagement
## 2 Q22 Behavioral engagement
## 3 Q23 Behavioral engagement
## 4 Q24 Behavioral engagement
## 5 Q25 Behavioral engagement
## 6 Q31 Cognitive engagement
## 7 Q32 Cognitive engagement
## 8 Q33 Cognitive engagement
## 9 Q34 Cognitive engagement
## 10 Q35 Cognitive engagement
## 11 Q36 Agentic engagement
## 12 Q37 Agentic engagement
## 13 Q38 Agentic engagement
## 14 Q39 Agentic engagement
## 15 Q40 Agentic engagement
## 16 Q41 Social engagement
## 17 Q42 Social engagement
## 18 Q43 Social engagement
## 19 Q44 Social engagement
## 20 Q45 Social engagement
# ============================================================
# 4. Emotion：Polychoric相関 + Parallel Analysis
# ============================================================
emotion_data <- df_raw %>% select(all_of(emotion_items)) %>% as.data.frame()
poly_emotion <- psych::polychoric(emotion_data, global = FALSE, correct = 0)
## Warning in psych::polychoric(emotion_data, global = FALSE, correct = 0): The
## items do not have an equal number of response alternatives, global set to
## FALSE.
## Warning in cor.smooth(mat): Matrix was not positive definite, smoothing was
## done
R_emotion <- poly_emotion$rho
pa_emotion <- fa.parallel(
R_emotion, n.obs = nrow(emotion_data), fa = "fa", fm = "minres", n.iter = 50, plot = FALSE
)
## Parallel analysis suggests that the number of factors = 4 and the number of components = NA
pa_emotion
## Call: fa.parallel(x = R_emotion, n.obs = nrow(emotion_data), fm = "minres",
## fa = "fa", n.iter = 50, plot = FALSE)
## Parallel analysis suggests that the number of factors = 4 and the number of components = NA
##
## Eigen Values of
##
## eigen values of factors
## [1] 4.84 2.83 1.35 0.58 0.37 0.08 0.04 -0.09 -0.14 -0.18 -0.33 -0.39
## [13] -0.50 -0.51 -0.66 -0.76 -0.80 -0.89
##
## eigen values of simulated factors
## [1] 1.02 0.71 0.58 0.48 0.37 0.29 0.19 0.11 0.03 -0.04 -0.11 -0.17
## [13] -0.24 -0.32 -0.37 -0.44 -0.50 -0.58
##
## eigen values of components
## [1] 5.39 3.76 2.08 1.41 0.95 0.84 0.73 0.57 0.54 0.45 0.33 0.26 0.25 0.18 0.17
## [16] 0.06 0.03 0.00
##
## eigen values of simulated components
## [1] NA
# --- Parallel Analysis scree plot（可視化） ---
scree_emotion <- tibble(
factor_n = seq_along(pa_emotion$fa.values),
Observed = pa_emotion$fa.values,
Simulated = pa_emotion$fa.sim
) %>%
pivot_longer(-factor_n, names_to = "type", values_to = "eigenvalue")
ggplot(scree_emotion, aes(factor_n, eigenvalue, color = type)) +
geom_line(linewidth = 0.8) +
geom_point(size = 2) +
geom_hline(yintercept = 0, linetype = "dotted", color = "grey60") +
scale_x_continuous(breaks = scree_emotion$factor_n) +
labs(title = "Emotion: Parallel Analysis scree plot", x = "Factor number", y = "Eigenvalue", color = NULL) +
theme_minimal(base_size = 12)
# ============================================================
# 5. Emotion：EFA（5因子、Parallel Analysis・理論と一致）
# ============================================================
efa_emotion <- fa(
R_emotion, nfactors = 5, n.obs = nrow(emotion_data),
rotate = "oblimin", fm = "minres", scores = "regression"
)
## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.
print(efa_emotion$loadings, cutoff = .30, sort = TRUE)
##
## Loadings:
## MR1 MR2 MR3 MR5 MR4
## Q3 -0.742
## Q13 0.596 -0.339
## Q14 0.778 -0.320
## Q15 0.806
## Q17 0.902
## Q18 0.716
## Q19 0.935
## Q20 -0.344 0.576 -0.457
## Q5 0.535
## Q6 0.645
## Q7 0.728
## Q8 0.780
## Q1 -0.334 0.599
## Q4 0.713
## Q9 0.877
## Q11 0.558
## Q2 -0.470 0.361
## Q16 0.453 0.305
##
## MR1 MR2 MR3 MR5 MR4
## SS loadings 2.933 2.824 2.242 1.534 1.437
## Proportion Var 0.163 0.157 0.125 0.085 0.080
## Cumulative Var 0.163 0.320 0.444 0.530 0.609
cat("\n因子間相関:\n")
##
## 因子間相関:
print(round(efa_emotion$Phi, 2))
## MR1 MR2 MR3 MR5 MR4
## MR1 1.00 -0.09 -0.21 -0.33 -0.02
## MR2 -0.09 1.00 -0.07 -0.11 0.32
## MR3 -0.21 -0.07 1.00 0.31 -0.14
## MR5 -0.33 -0.11 0.31 1.00 -0.09
## MR4 -0.02 0.32 -0.14 -0.09 1.00
# 相関行列からのfa()はscoresを直接持たないため、
# 生データから因子得点を推定する（regression法）。
emotion_fscores <- psych::factor.scores(
emotion_data, efa_emotion, method = "Thurstone"
)$scores
colnames(emotion_fscores) <- colnames(efa_emotion$loadings)
# --- 因子負荷量ヒートマップ（可視化） ---
loadings_long_emotion <- unclass(efa_emotion$loadings) %>%
as.data.frame() %>%
rownames_to_column("Item") %>%
mutate(Item = emotion_items) %>%
left_join(emotion_item_map, by = c("Item" = "Q")) %>%
pivot_longer(starts_with("MR"), names_to = "Factor", values_to = "Loading") %>%
mutate(Item = fct_reorder(Item, as.integer(factor(Construct))))
ggplot(loadings_long_emotion, aes(Factor, Item, fill = Loading)) +
geom_tile(color = "white") +
geom_text(aes(label = sprintf("%.2f", Loading)), size = 2.5) +
scale_fill_gradient2(low = "#2166ac", mid = "white", high = "#b2182b", midpoint = 0, limits = c(-1, 1)) +
labs(title = "Emotion EFA: factor loadings", subtitle = "Items grouped by a priori construct", x = NULL, y = NULL) +
theme_minimal(base_size = 11)
# ============================================================
# 6. Emotion：因子の自動ラベリング・符号補正
# ============================================================
# 各構成概念（Construct）について、各因子への平均負荷量を計算し、
# 貪欲法（絶対値最大のペアから順に確定）でconstruct <-> factorを
# 1対1対応させる。負の平均負荷であれば符号を反転させ、
# 「得点が高いほどその構成概念が強い」方向にそろえる。
# ============================================================
label_factors <- function(loadings_mat, item_map, item_col = "Q", construct_col = "Construct") {
constructs <- unique(item_map[[construct_col]])
factors <- colnames(loadings_mat)
score_mat <- matrix(NA, nrow = length(constructs), ncol = length(factors),
dimnames = list(constructs, factors))
for (cons in constructs) {
items_in_cons <- item_map[[item_col]][item_map[[construct_col]] == cons]
for (f in factors) {
score_mat[cons, f] <- mean(loadings_mat[items_in_cons, f])
}
}
assignment <- list()
mat <- score_mat
while (nrow(mat) > 0 && ncol(mat) > 0) {
idx <- which(abs(mat) == max(abs(mat)), arr.ind = TRUE)[1, ]
cons <- rownames(mat)[idx[1]]
fac <- colnames(mat)[idx[2]]
assignment[[cons]] <- list(factor = fac, sign = sign(mat[idx[1], idx[2]]), loading = mat[idx[1], idx[2]])
mat <- mat[rownames(mat) != cons, colnames(mat) != fac, drop = FALSE]
}
assignment
}
emotion_loadings <- unclass(efa_emotion$loadings)
rownames(emotion_loadings) <- emotion_items
emotion_assignment <- label_factors(emotion_loadings, emotion_item_map)
cat("Emotion: construct <-> factor 対応（平均負荷量, 符号）\n")
## Emotion: construct <-> factor 対応（平均負荷量, 符号）
for (cons in names(emotion_assignment)) {
a <- emotion_assignment[[cons]]
cat(sprintf(" %-16s <- %s (mean loading = %.2f, sign = %+d)\n", cons, a$factor, a$loading, a$sign))
}
## Task difficulty <- MR2 (mean loading = 0.78, sign = +1)
## Anxiety <- MR4 (mean loading = 0.72, sign = +1)
## Pride <- MR3 (mean loading = 0.67, sign = +1)
## Boredom <- MR1 (mean loading = 0.66, sign = +1)
## Enjoyment <- MR5 (mean loading = 0.43, sign = +1)
# ============================================================
# 7. Emotion因子得点をデータフレームに追加
# ============================================================
emotion_factor_df <- as.data.frame(emotion_fscores)
names(emotion_factor_df) <- colnames(emotion_fscores)
emotion_name_map <- c(
"Enjoyment" = "Enjoyment", "Boredom" = "Boredom", "Pride" = "Pride",
"Anxiety" = "Anxiety", "Task difficulty" = "TaskDifficulty"
)
for (cons in names(emotion_assignment)) {
a <- emotion_assignment[[cons]]
clean_name <- emotion_name_map[[cons]]
df_raw[[clean_name]] <- a$sign * emotion_factor_df[[a$factor]]
}
df_raw %>% select(all_of(unname(emotion_name_map))) %>% psych::describe()
## vars n mean sd median trimmed mad min max range skew
## Enjoyment 1 92 0 0.94 -0.04 -0.02 0.98 -1.81 2.40 4.22 0.21
## Boredom 2 92 0 1.00 0.08 -0.01 0.99 -1.90 2.37 4.27 0.10
## Pride 3 92 0 0.99 0.04 -0.08 1.01 -1.73 3.31 5.03 0.71
## Anxiety 4 92 0 1.01 0.24 0.10 1.03 -2.63 1.52 4.14 -0.73
## TaskDifficulty 5 92 0 1.04 0.31 0.12 0.99 -2.79 1.18 3.97 -0.83
## kurtosis se
## Enjoyment -0.42 0.10
## Boredom -0.61 0.10
## Pride 0.48 0.10
## Anxiety -0.31 0.11
## TaskDifficulty -0.36 0.11
# ============================================================
# 8. Engagement：Polychoric相関 + Parallel Analysis
# ============================================================
engagement_data <- df_raw %>% select(all_of(engagement_items)) %>% as.data.frame()
poly_engagement <- psych::polychoric(engagement_data, global = FALSE, correct = 0)
## Warning in psych::polychoric(engagement_data, global = FALSE, correct = 0): The
## items do not have an equal number of response alternatives, global set to
## FALSE.
## Warning in cor.smooth(mat): Matrix was not positive definite, smoothing was
## done
R_engagement <- poly_engagement$rho
pa_engagement <- fa.parallel(
R_engagement, n.obs = nrow(engagement_data), fa = "fa", fm = "minres", n.iter = 50, plot = FALSE
)
## Parallel analysis suggests that the number of factors = 3 and the number of components = NA
pa_engagement
## Call: fa.parallel(x = R_engagement, n.obs = nrow(engagement_data),
## fm = "minres", fa = "fa", n.iter = 50, plot = FALSE)
## Parallel analysis suggests that the number of factors = 3 and the number of components = NA
##
## Eigen Values of
##
## eigen values of factors
## [1] 4.96 2.88 0.79 0.51 0.44 0.35 0.26 0.04 -0.05 -0.15 -0.26 -0.31
## [13] -0.37 -0.45 -0.48 -0.52 -0.57 -0.59 -0.70 -0.82
##
## eigen values of simulated factors
## [1] 1.09 0.80 0.65 0.55 0.43 0.34 0.26 0.18 0.10 0.02 -0.05 -0.12
## [13] -0.18 -0.24 -0.31 -0.37 -0.42 -0.48 -0.55 -0.61
##
## eigen values of components
## [1] 5.56 3.69 1.58 1.33 1.28 1.10 0.97 0.81 0.68 0.63 0.53 0.46 0.33 0.30 0.24
## [16] 0.20 0.15 0.10 0.03 0.00
##
## eigen values of simulated components
## [1] NA
# --- Parallel Analysis scree plot（可視化） ---
scree_engagement <- tibble(
factor_n = seq_along(pa_engagement$fa.values),
Observed = pa_engagement$fa.values,
Simulated = pa_engagement$fa.sim
) %>%
pivot_longer(-factor_n, names_to = "type", values_to = "eigenvalue")
ggplot(scree_engagement, aes(factor_n, eigenvalue, color = type)) +
geom_line(linewidth = 0.8) +
geom_point(size = 2) +
geom_hline(yintercept = 0, linetype = "dotted", color = "grey60") +
scale_x_continuous(breaks = scree_engagement$factor_n) +
labs(
title = "Engagement: Parallel Analysis scree plot",
subtitle = "Suggests 3 factors, while theory assumes 4 (see note below)",
x = "Factor number", y = "Eigenvalue", color = NULL
) +
theme_minimal(base_size = 12)
# ============================================================
# 9. Engagement：EFA（3因子版）
# ============================================================
# ★このファイルはParallel Analysisが支持する3因子解を採用する★
# （4因子理論版はmain_analysis.Rmdを参照）。
# 3因子では4つのa priori construct（Behavioral/Cognitive/Agentic/
# Social）を1対1で割り当てられないため、次のSTEPで各因子に
# 複数のconstructを結合したラベルを付与する。
# ============================================================
efa_engagement <- fa(
R_engagement, nfactors = 3, n.obs = nrow(engagement_data),
rotate = "oblimin", fm = "minres", scores = "regression"
)
## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.
print(efa_engagement$loadings, cutoff = .30, sort = TRUE)
##
## Loadings:
## MR2 MR1 MR3
## Q23 0.591
## Q24 0.842
## Q25 0.652
## Q31 0.541 0.326
## Q32 0.691
## Q33 0.549
## Q35 0.539
## Q36 0.540
## Q39 -0.369 0.636
## Q41 1.024
## Q42 0.718
## Q43 0.428 0.567
## Q21 0.553
## Q34 0.776
## Q22 0.450
## Q37 0.391 0.471
## Q38 0.354 0.349
## Q40 0.423
## Q44 0.414
## Q45 0.471 0.464
##
## MR2 MR1 MR3
## SS loadings 3.682 3.450 1.813
## Proportion Var 0.184 0.172 0.091
## Cumulative Var 0.184 0.357 0.447
cat("\n因子間相関:\n")
##
## 因子間相関:
print(round(efa_engagement$Phi, 2))
## MR2 MR1 MR3
## MR2 1.00 -0.27 0.04
## MR1 -0.27 1.00 0.28
## MR3 0.04 0.28 1.00
engagement_fscores <- psych::factor.scores(
engagement_data, efa_engagement, method = "Thurstone"
)$scores
colnames(engagement_fscores) <- colnames(efa_engagement$loadings)
# --- 因子負荷量ヒートマップ（可視化） ---
# クロスローディングが多いことが視覚的にも確認できる
loadings_long_engagement <- unclass(efa_engagement$loadings) %>%
as.data.frame() %>%
rownames_to_column("Item") %>%
mutate(Item = engagement_items) %>%
left_join(engagement_item_map, by = c("Item" = "Q")) %>%
pivot_longer(starts_with("MR"), names_to = "Factor", values_to = "Loading") %>%
mutate(Item = fct_reorder(Item, as.integer(factor(Construct))))
ggplot(loadings_long_engagement, aes(Factor, Item, fill = Loading)) +
geom_tile(color = "white") +
geom_text(aes(label = sprintf("%.2f", Loading)), size = 2.3) +
scale_fill_gradient2(low = "#2166ac", mid = "white", high = "#b2182b", midpoint = 0, limits = c(-1, 1)) +
labs(
title = "Engagement EFA: factor loadings (3-factor solution)",
subtitle = "Items grouped by a priori construct — note the cross-loading",
x = NULL, y = NULL
) +
theme_minimal(base_size = 11)
# ============================================================
# 10. Engagement：因子の自動ラベリング・符号補正（3因子版）
# ============================================================
# 4因子版で使ったlabel_factors()は「construct <-> factor」を
# 1対1で貪欲マッチングする関数だが、3因子では1つの因子に
# 複数のconstructがまたがることが避けられない。
# そのため、各因子について平均負荷量の絶対値がthreshold(.30)を
# 超えるconstructをすべて拾い、寄与の大きい順に結合したラベルを
# 生成するlabel_factors_multi()を新たに定義して使う。
# ============================================================
label_factors_multi <- function(loadings_mat, item_map, item_col = "Q", construct_col = "Construct", threshold = 0.30) {
constructs <- unique(item_map[[construct_col]])
factors <- colnames(loadings_mat)
score_mat <- matrix(NA, nrow = length(constructs), ncol = length(factors),
dimnames = list(constructs, factors))
for (cons in constructs) {
items_in_cons <- item_map[[item_col]][item_map[[construct_col]] == cons]
for (f in factors) {
score_mat[cons, f] <- mean(loadings_mat[items_in_cons, f])
}
}
assignment <- list()
for (f in factors) {
col <- score_mat[, f]
contributing <- names(col)[abs(col) > threshold]
contributing <- contributing[order(-abs(col[contributing]))]
if (length(contributing) == 0) contributing <- names(col)[which.max(abs(col))]
assignment[[f]] <- list(
label = paste(contributing, collapse = " + "),
sign = sign(col[contributing[1]]),
contributing = contributing
)
}
assignment
}
engagement_loadings <- unclass(efa_engagement$loadings)
rownames(engagement_loadings) <- engagement_items
engagement_assignment <- label_factors_multi(engagement_loadings, engagement_item_map)
cat("Engagement(3因子): factor構成（寄与するconstructと符号）\n")
## Engagement(3因子): factor構成（寄与するconstructと符号）
for (f in names(engagement_assignment)) {
a <- engagement_assignment[[f]]
cat(sprintf(" %s <- %s (sign = %+d)\n", f, a$label, a$sign))
}
## MR2 <- Behavioral engagement + Cognitive engagement (sign = +1)
## MR1 <- Social engagement + Agentic engagement (sign = +1)
## MR3 <- Cognitive engagement (sign = +1)
# ============================================================
# 11. Engagement因子得点をデータフレームに追加（3因子版）
# ============================================================
# 因子ラベルから半角英数字の変数名を自動生成する
# （例: "Behavioral engagement + Cognitive engagement" ->
# "BehavioralCognitiveEngagement"）。
# ============================================================
engagement_factor_df <- as.data.frame(engagement_fscores)
names(engagement_factor_df) <- colnames(engagement_fscores)
clean_engagement_varname <- function(label) {
label %>%
str_split(" \\+ ") %>%
unlist() %>%
str_remove(" engagement") %>%
str_remove_all(" ") %>%
paste(collapse = "") %>%
paste0("Engagement")
}
engagement_name_map <- set_names(
map_chr(names(engagement_assignment), ~ clean_engagement_varname(engagement_assignment[[.x]]$label)),
names(engagement_assignment)
)
cat("因子 -> 変数名 の対応:\n")
## 因子 -> 変数名 の対応:
print(engagement_name_map)
## MR2 MR1
## "BehavioralCognitiveEngagement" "SocialAgenticEngagement"
## MR3
## "CognitiveEngagement"
for (f in names(engagement_assignment)) {
a <- engagement_assignment[[f]]
clean_name <- engagement_name_map[[f]]
df_raw[[clean_name]] <- a$sign * engagement_factor_df[[f]]
}
df_raw %>% select(all_of(unname(engagement_name_map))) %>% psych::describe()
## vars n mean sd median trimmed mad min max
## BehavioralCognitiveEngagement 1 92 0 1.02 0.14 0.09 1.05 -2.67 1.90
## SocialAgenticEngagement 2 92 0 1.11 -0.51 -0.17 0.67 -1.22 3.70
## CognitiveEngagement 3 92 0 0.96 -0.11 -0.05 1.15 -1.58 3.09
## range skew kurtosis se
## BehavioralCognitiveEngagement 4.57 -0.69 -0.13 0.11
## SocialAgenticEngagement 4.92 1.20 0.70 0.12
## CognitiveEngagement 4.67 0.48 -0.19 0.10
# ============================================================
# 12. 分析用データセットの作成
# ============================================================
# Emotion・Engagementはいずれも因子得点（EFA regression score）。
# ReflectionTimeは秒->分に変換（係数の解釈しやすさのため、
# 有意性・p値には影響しない線形変換）。
# ============================================================
emotion_vars <- unname(emotion_name_map)
engagement_vars <- unname(engagement_name_map)
df_final <- df_raw %>%
transmute(
ID, Class = factor(Class), condition = factor(condition),
Pre_Total = as.numeric(Pre_Total),
Post_Total = as.numeric(Post_Total),
Development = as.numeric(Development),
across(all_of(emotion_vars)),
across(all_of(engagement_vars)),
ReflectionTime = as.numeric(Reflection) / 60
)
cat("欠損値:\n")
## 欠損値:
print(colSums(is.na(df_final)))
## ID Class
## 0 0
## condition Pre_Total
## 0 0
## Post_Total Development
## 0 0
## Enjoyment Boredom
## 0 0
## Pride Anxiety
## 0 0
## TaskDifficulty BehavioralCognitiveEngagement
## 0 0
## SocialAgenticEngagement CognitiveEngagement
## 0 0
## ReflectionTime
## 1
cat("\nClass別サンプルサイズ（ランダム切片の推定に利用）:\n")
##
## Class別サンプルサイズ（ランダム切片の推定に利用）:
print(table(df_final$Class))
##
## Mon3 Thu3 Thu4 Wed3 水曜4限
## 17 16 22 17 20
df_final
## # A tibble: 92 × 15
## ID Class condition Pre_Total Post_Total Development Enjoyment Boredom
## <dbl> <fct> <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 202402601 Mon3 model text 17 17 0 1.50 -1.75
## 2 202402717 Mon3 model text 16 19 3 0.0458 -0.202
## 3 202402735 Mon3 ai-wcf 16 13 -3 1.34 1.10
## 4 202402738 Mon3 ai-wcf 14 20 6 -0.217 0.668
## 5 202402763 Mon3 ai-wcf 19 17 -2 0.517 0.456
## 6 202402766 Mon3 model text 20 16 -4 0.938 -0.428
## 7 202402776 Mon3 ai-wcf 19 19 0 -0.0771 0.338
## 8 202402779 Mon3 control 15 18 3 -0.0997 -0.649
## 9 202402782 Mon3 control 13 16 3 0.337 0.188
## 10 202402805 Mon3 control 8 16 8 1.75 1.89
## # ℹ 82 more rows
## # ℹ 7 more variables: Pride <dbl>, Anxiety <dbl>, TaskDifficulty <dbl>,
## # BehavioralCognitiveEngagement <dbl>, SocialAgenticEngagement <dbl>,
## # CognitiveEngagement <dbl>, ReflectionTime <dbl>
# --- 各predictorの分布（可視化） ---
df_final %>%
select(all_of(emotion_vars), all_of(engagement_vars), ReflectionTime) %>%
pivot_longer(everything(), names_to = "Variable", values_to = "Value") %>%
mutate(Variable = factor(Variable, levels = c(emotion_vars, engagement_vars, "ReflectionTime"))) %>%
ggplot(aes(Value, fill = Variable)) +
geom_histogram(bins = 15, color = "white") +
facet_wrap(~Variable, scales = "free", ncol = 5) +
labs(title = "Distribution of each predictor", x = NULL, y = "Count") +
theme_minimal(base_size = 10) +
theme(legend.position = "none")
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_bin()`).
# --- condition別のEmotion/Engagement因子得点（可視化） ---
df_final %>%
select(ID, condition, all_of(emotion_vars), all_of(engagement_vars)) %>%
pivot_longer(-c(ID, condition), names_to = "Variable", values_to = "Score") %>%
mutate(
Variable = factor(Variable, levels = c(emotion_vars, engagement_vars)),
Group = if_else(Variable %in% emotion_vars, "Emotion", "Engagement")
) %>%
ggplot(aes(condition, Score, fill = condition)) +
geom_boxplot(alpha = 0.6, outlier.shape = NA) +
geom_jitter(width = 0.15, alpha = 0.4, size = 1) +
facet_wrap(~Variable, nrow = 2) +
labs(title = "Emotion / Engagement factor scores by condition", x = NULL, y = "Factor score (z)") +
theme_minimal(base_size = 10) +
theme(legend.position = "none", axis.text.x = element_text(angle = 45, hjust = 1))
# --- Pre vs Post 散布図（可視化） ---
ggplot(df_final, aes(Pre_Total, Post_Total, color = condition)) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "grey60") +
geom_point(alpha = 0.7) +
geom_smooth(method = "lm", se = FALSE) +
labs(title = "Pre_Total vs Post_Total by condition", x = "Pre_Total", y = "Post_Total") +
theme_minimal(base_size = 12)
## `geom_smooth()` using formula = 'y ~ x'
# ============================================================
# 13. 記述統計・相関
# ============================================================
df_final %>%
select(Pre_Total, Post_Total, all_of(emotion_vars), all_of(engagement_vars), ReflectionTime) %>%
psych::describe()
## vars n mean sd median trimmed mad min
## Pre_Total 1 92 12.83 4.67 13.50 13.03 5.19 4.00
## Post_Total 2 92 15.16 3.67 16.00 15.58 2.97 4.00
## Enjoyment 3 92 0.00 0.94 -0.04 -0.02 0.98 -1.81
## Boredom 4 92 0.00 1.00 0.08 -0.01 0.99 -1.90
## Pride 5 92 0.00 0.99 0.04 -0.08 1.01 -1.73
## Anxiety 6 92 0.00 1.01 0.24 0.10 1.03 -2.63
## TaskDifficulty 7 92 0.00 1.04 0.31 0.12 0.99 -2.79
## BehavioralCognitiveEngagement 8 92 0.00 1.02 0.14 0.09 1.05 -2.67
## SocialAgenticEngagement 9 92 0.00 1.11 -0.51 -0.17 0.67 -1.22
## CognitiveEngagement 10 92 0.00 0.96 -0.11 -0.05 1.15 -1.58
## ReflectionTime 11 91 3.73 2.84 3.38 3.46 3.01 0.05
## max range skew kurtosis se
## Pre_Total 21.00 17.00 -0.34 -1.02 0.49
## Post_Total 21.00 17.00 -1.14 1.20 0.38
## Enjoyment 2.40 4.22 0.21 -0.42 0.10
## Boredom 2.37 4.27 0.10 -0.61 0.10
## Pride 3.31 5.03 0.71 0.48 0.10
## Anxiety 1.52 4.14 -0.73 -0.31 0.11
## TaskDifficulty 1.18 3.97 -0.83 -0.36 0.11
## BehavioralCognitiveEngagement 1.90 4.57 -0.69 -0.13 0.11
## SocialAgenticEngagement 3.70 4.92 1.20 0.70 0.12
## CognitiveEngagement 3.09 4.67 0.48 -0.19 0.10
## ReflectionTime 10.00 9.95 0.65 -0.57 0.30
cor_mat_all <- df_final %>%
select(Pre_Total, Post_Total, all_of(emotion_vars), all_of(engagement_vars), ReflectionTime) %>%
cor(use = "pairwise.complete.obs")
cor_long_all <- cor_mat_all %>%
as.data.frame() %>% rownames_to_column("Var1") %>%
pivot_longer(-Var1, names_to = "Var2", values_to = "r") %>%
mutate(Var1 = factor(Var1, levels = rownames(cor_mat_all)), Var2 = factor(Var2, levels = rownames(cor_mat_all)))
ggplot(cor_long_all, aes(Var2, Var1, fill = r)) +
geom_tile(color = "white") +
geom_text(aes(label = sprintf("%.2f", r)), size = 2.8) +
scale_fill_gradient2(low = "#2166ac", mid = "white", high = "#b2182b", midpoint = 0, limits = c(-1, 1)) +
labs(title = "Correlation matrix (EFA factor scores)", x = NULL, y = NULL, fill = "r") +
theme_minimal(base_size = 11) +
theme(axis.text.x = element_text(angle = 45, hjust = 1), panel.grid = element_blank())
# ============================================================
# 14. Analysis 1: Writing development
# ============================================================
# Score ~ Time * condition + (1|Class) + (1|ID)
# 個人内（Pre/Post 反復測定）はID、学級レベルの依存関係はClassの
# ランダム切片で扱う（IDはClassにネストしているため、
# (1|Class)+(1|ID)で問題なく推定できる）。
# ============================================================
df_long_writing <- df_final %>%
select(ID, Class, condition, Pre_Total, Post_Total) %>%
pivot_longer(c(Pre_Total, Post_Total), names_to = "Time", values_to = "Score") %>%
mutate(Time = factor(if_else(Time == "Pre_Total", "Pre", "Post"), levels = c("Pre", "Post")))
m_development <- lmer(Score ~ Time * condition + (1 | Class) + (1 | ID), data = df_long_writing)
summary(m_development)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Score ~ Time * condition + (1 | Class) + (1 | ID)
## Data: df_long_writing
##
## REML criterion at convergence: 982.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.35824 -0.44003 0.01934 0.56631 1.90207
##
## Random effects:
## Groups Name Variance Std.Dev.
## ID (Intercept) 8.207 2.865
## Class (Intercept) 3.683 1.919
## Residual 6.706 2.590
## Number of obs: 184, groups: ID, 92; Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 12.3976 1.1122 8.1034 11.147 3.39e-06 ***
## TimePost 2.9333 0.6686 89.0000 4.387 3.14e-05 ***
## conditioncontrol 0.3695 0.9903 130.9070 0.373 0.710
## conditionmodel text 1.1083 0.9946 130.9448 1.114 0.267
## TimePost:conditioncontrol -1.2237 0.9379 89.0000 -1.305 0.195
## TimePost:conditionmodel text -0.5462 0.9379 89.0000 -0.582 0.562
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) TimPst cndtnc cndtnt TmPst:
## TimePost -0.301
## condtncntrl -0.453 0.338
## cndtnmdltxt -0.453 0.336 0.509
## TmPst:cndtn 0.214 -0.713 -0.474 -0.240
## TmPst:cndtt 0.214 -0.713 -0.241 -0.472 0.508
anova(m_development)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Time 252.543 252.543 1 89.000 37.6612 2.285e-08 ***
## condition 11.333 5.667 2 85.239 0.8450 0.4331
## Time:condition 11.473 5.736 2 89.000 0.8555 0.4286
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
emm_within <- emmeans(m_development, ~ Time | condition)
pairs(emm_within)
## condition = ai-wcf:
## contrast estimate SE df t.ratio p.value
## Pre - Post -2.93 0.669 89 -4.387 <.0001
##
## condition = control:
## contrast estimate SE df t.ratio p.value
## Pre - Post -1.71 0.658 89 -2.599 0.0109
##
## condition = model text:
## contrast estimate SE df t.ratio p.value
## Pre - Post -2.39 0.658 89 -3.629 0.0005
##
## Degrees-of-freedom method: kenward-roger
emm_between <- emmeans(m_development, ~ Time * condition)
contrast(emm_between, interaction = "pairwise")
## Time_pairwise condition_pairwise estimate SE df t.ratio p.value
## Pre - Post (ai-wcf) - control -1.224 0.938 89 -1.305 0.1954
## Pre - Post (ai-wcf) - model text -0.546 0.938 89 -0.582 0.5618
## Pre - Post control - model text 0.677 0.930 89 0.728 0.4684
##
## Degrees-of-freedom method: kenward-roger
emm_df <- as.data.frame(emm_within)
ggplot(emm_df, aes(Time, emmean, color = condition, group = condition)) +
geom_line(linewidth = 1, position = position_dodge(width = 0.1)) +
geom_point(size = 2.5, position = position_dodge(width = 0.1)) +
geom_errorbar(aes(ymin = emmean - SE, ymax = emmean + SE), width = 0.1, position = position_dodge(width = 0.1)) +
labs(title = "Writing development by condition (EMM, LME)", y = "Post_Total (EMM +/- SE)", x = NULL) +
theme_minimal(base_size = 12)
# --- 個人単位のPre->Post推移（スパゲッティプロット, 可視化） ---
condition_means <- df_long_writing %>%
group_by(condition, Time) %>%
summarise(Score = mean(Score), .groups = "drop")
ggplot(df_long_writing, aes(Time, Score, group = ID)) +
geom_line(alpha = 0.25, color = "grey50") +
geom_line(data = condition_means, aes(group = condition), color = "firebrick", linewidth = 1.2) +
geom_point(data = condition_means, aes(group = condition), color = "firebrick", size = 2.5) +
facet_wrap(~condition) +
labs(
title = "Individual writing trajectories (Pre -> Post) by condition",
subtitle = "Thin grey = individual students, thick red = condition mean",
y = "Score", x = NULL
) +
theme_minimal(base_size = 12)
# --- Class変量切片のキャタピラープロット（可視化） ---
ranef_dev <- broom.mixed::tidy(m_development, effects = "ran_vals") %>%
filter(group == "Class")
ggplot(ranef_dev, aes(x = estimate, y = fct_reorder(level, estimate))) +
geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
geom_pointrange(aes(xmin = estimate - 1.96 * std.error, xmax = estimate + 1.96 * std.error)) +
labs(title = "Class random intercepts (m_development)", x = "Random intercept (+/- 95% CI)", y = "Class") +
theme_minimal(base_size = 12)
# ============================================================
# 15. Analysis 2: 個別predictor（LME）
# ============================================================
# post ~ pre + condition + X + (1|Class)
# post ~ pre + condition * X + (1|Class)
# 学級のランダム切片を加えたLMEで、Emotion(5) / Engagement(4) /
# ReflectionTime(1) の計10predictorをそれぞれ検討する。
# ============================================================
all_predictors <- c(emotion_vars, engagement_vars, "ReflectionTime")
fit_main <- function(var) {
f <- as.formula(paste0("Post_Total ~ Pre_Total + condition + ", var, " + (1 | Class)"))
lmer(f, data = df_final)
}
fit_interaction <- function(var) {
f <- as.formula(paste0("Post_Total ~ Pre_Total + condition * ", var, " + (1 | Class)"))
lmer(f, data = df_final)
}
main_models <- map(all_predictors, fit_main) %>% set_names(all_predictors)
interaction_models <- map(all_predictors, fit_interaction) %>% set_names(all_predictors)
for (var in all_predictors) {
cat("\n\n==================== Main effect model:", var, "====================\n")
print(summary(main_models[[var]]))
}
##
##
## ==================== Main effect model: Enjoyment ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 445.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.03688 -0.44651 0.04601 0.59516 2.47995
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.264 1.124
## Residual 7.132 2.671
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.7694 1.0687 31.8750 9.141 2.02e-10 ***
## Pre_Total 0.4462 0.0646 86.9445 6.907 7.74e-10 ***
## conditioncontrol -1.0060 0.6854 83.0039 -1.468 0.146
## conditionmodel text 0.1358 0.6955 84.0823 0.195 0.846
## Enjoyment -0.1957 0.3088 84.5114 -0.634 0.528
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.754
## condtncntrl -0.302 -0.032
## cndtnmdltxt -0.264 -0.081 0.505
## Enjoyment 0.115 -0.123 0.009 -0.107
##
##
## ==================== Main effect model: Boredom ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 446.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.09805 -0.47009 0.03354 0.65669 2.48866
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.203 1.097
## Residual 7.178 2.679
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.84480 1.07349 33.11711 9.171 1.31e-10 ***
## Pre_Total 0.44172 0.06491 86.99003 6.805 1.23e-09 ***
## conditioncontrol -1.00943 0.70112 83.16276 -1.440 0.154
## conditionmodel text 0.08287 0.69439 83.99289 0.119 0.905
## Boredom -0.01290 0.30302 86.39995 -0.043 0.966
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.760
## condtncntrl -0.330 -0.002
## cndtnmdltxt -0.261 -0.088 0.508
## Boredom -0.169 0.142 0.196 0.045
##
##
## ==================== Main effect model: Pride ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 444.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.03869 -0.41806 0.07702 0.64242 2.46455
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.276 1.129
## Residual 7.063 2.658
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 10.07705 1.07870 32.41229 9.342 1.03e-10 ***
## Pre_Total 0.41690 0.06745 86.96689 6.181 2.00e-08 ***
## conditioncontrol -0.83168 0.69934 83.26258 -1.189 0.238
## conditionmodel text 0.17070 0.69210 83.95223 0.247 0.806
## Pride 0.33992 0.30979 84.45950 1.097 0.276
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.757
## condtncntrl -0.249 -0.101
## cndtnmdltxt -0.228 -0.124 0.517
## Pride 0.191 -0.324 0.221 0.106
##
##
## ==================== Main effect model: Anxiety ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 446
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.08998 -0.45960 0.03718 0.64604 2.46944
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.179 1.086
## Residual 7.173 2.678
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.76364 1.07392 34.09194 9.092 1.23e-10 ***
## Pre_Total 0.44695 0.06549 86.99766 6.825 1.12e-09 ***
## conditioncontrol -0.97846 0.69122 83.01038 -1.416 0.161
## conditionmodel text 0.09281 0.69401 83.91924 0.134 0.894
## Anxiety 0.10005 0.28622 82.93273 0.350 0.728
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.765
## condtncntrl -0.320 -0.010
## cndtnmdltxt -0.261 -0.085 0.510
## Anxiety -0.186 0.197 0.106 0.042
##
##
## ==================== Main effect model: TaskDifficulty ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 445.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.01909 -0.43180 0.05202 0.62020 2.33762
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.099 1.049
## Residual 7.111 2.667
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.86445 1.04427 34.05406 9.446 4.84e-11 ***
## Pre_Total 0.44020 0.06394 86.99529 6.884 8.57e-10 ***
## conditioncontrol -1.07194 0.68727 83.15352 -1.560 0.123
## conditionmodel text 0.12462 0.69180 83.91648 0.180 0.857
## TaskDifficulty -0.29326 0.28388 86.47595 -1.033 0.304
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.761
## condtncntrl -0.312 -0.026
## cndtnmdltxt -0.257 -0.097 0.500
## TaskDffclty -0.040 0.050 0.093 -0.066
##
##
## ==================== Main effect model: BehavioralCognitiveEngagement ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 446.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.09405 -0.47560 0.03208 0.65291 2.48553
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.201 1.096
## Residual 7.179 2.679
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.839549 1.097731 33.686020 8.964 1.93e-10
## Pre_Total 0.441952 0.067242 86.700806 6.573 3.55e-09
## conditioncontrol -1.003734 0.687651 83.035073 -1.460 0.148
## conditionmodel text 0.083267 0.698732 83.750931 0.119 0.905
## BehavioralCognitiveEngagement 0.002848 0.297653 86.119301 0.010 0.992
##
## (Intercept) ***
## Pre_Total ***
## conditioncontrol
## conditionmodel text
## BehavioralCognitiveEngagement
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.774
## condtncntrl -0.300 -0.026
## cndtnmdltxt -0.278 -0.055 0.507
## BhvrlCgntvE 0.267 -0.295 -0.015 -0.120
##
##
## ==================== Main effect model: SocialAgenticEngagement ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 443.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.72142 -0.42789 0.00498 0.59233 2.36909
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.231 1.109
## Residual 6.925 2.632
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.86568 1.04650 30.98820 9.427 1.29e-10 ***
## Pre_Total 0.44290 0.06318 86.99833 7.010 4.84e-10 ***
## conditioncontrol -1.08494 0.67705 83.04269 -1.602 0.1128
## conditionmodel text 0.06637 0.68158 83.88628 0.097 0.9227
## SocialAgenticEngagement -0.43439 0.25072 83.48555 -1.733 0.0869 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.750
## condtncntrl -0.305 -0.033
## cndtnmdltxt -0.255 -0.096 0.509
## SclAgntcEng -0.010 -0.016 0.071 0.019
##
##
## ==================== Main effect model: CognitiveEngagement ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 445.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.09633 -0.43888 0.04948 0.62021 2.43058
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.163 1.078
## Residual 7.161 2.676
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.77244 1.05820 33.24083 9.235 1.07e-10 ***
## Pre_Total 0.44768 0.06478 86.99990 6.910 7.62e-10 ***
## conditioncontrol -1.03308 0.68866 83.10243 -1.500 0.137
## conditionmodel text 0.09359 0.69314 83.94695 0.135 0.893
## CognitiveEngagement -0.16775 0.30399 85.15507 -0.552 0.583
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.760
## condtncntrl -0.298 -0.041
## cndtnmdltxt -0.260 -0.089 0.505
## CgntvEnggmn 0.100 -0.141 0.075 -0.031
##
##
## ==================== Main effect model: ReflectionTime ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 443
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.1000 -0.4568 0.0389 0.6116 2.4738
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.129 1.063
## Residual 7.203 2.684
## Number of obs: 91, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 10.01574 1.24010 49.98775 8.077 1.27e-10 ***
## Pre_Total 0.45103 0.06491 85.94586 6.949 6.69e-10 ***
## conditioncontrol -1.22047 0.84210 83.07223 -1.449 0.151
## conditionmodel text -0.02438 0.70341 83.21280 -0.035 0.972
## ReflectionTime -0.05523 0.12824 84.09986 -0.431 0.668
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.645
## condtncntrl -0.515 -0.031
## cndtnmdltxt -0.230 -0.113 0.440
## ReflectinTm -0.523 -0.008 0.575 0.048
for (var in all_predictors) {
cat("\n\n==================== Interaction model:", var, "x condition ====================\n")
print(summary(interaction_models[[var]]))
}
##
##
## ==================== Interaction model: Enjoyment x condition ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 440
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.2220 -0.3987 0.0974 0.6042 2.4930
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.439 1.200
## Residual 6.981 2.642
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.96997 1.08158 28.60743 9.218 4.60e-10 ***
## Pre_Total 0.42721 0.06472 84.82339 6.601 3.36e-09 ***
## conditioncontrol -0.89977 0.68078 80.93023 -1.322 0.190
## conditionmodel text 0.26456 0.69229 82.11325 0.382 0.703
## Enjoyment -0.65704 0.55489 81.28236 -1.184 0.240
## conditioncontrol:Enjoyment 1.19257 0.74678 80.85599 1.597 0.114
## conditionmodel text:Enjoyment 0.07329 0.75679 81.73548 0.097 0.923
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt Enjymn cndt:E
## Pre_Total -0.743
## condtncntrl -0.286 -0.045
## cndtnmdltxt -0.248 -0.092 0.506
## Enjoyment 0.022 0.019 -0.055 -0.060
## cndtncntr:E 0.075 -0.136 0.087 0.050 -0.741
## cndtnmtxt:E 0.005 -0.040 0.038 -0.050 -0.728 0.551
##
##
## ==================== Interaction model: Boredom x condition ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 443.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.02823 -0.43146 0.00395 0.62057 2.58863
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.153 1.074
## Residual 7.321 2.706
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.80332 1.07956 33.57590 9.081 1.46e-10 ***
## Pre_Total 0.44897 0.06613 84.91239 6.789 1.44e-09 ***
## conditioncontrol -0.98654 0.71700 81.21218 -1.376 0.173
## conditionmodel text 0.02034 0.70835 81.99802 0.029 0.977
## Boredom -0.24372 0.48323 83.33489 -0.504 0.615
## conditioncontrol:Boredom 0.50658 0.73443 81.58590 0.690 0.492
## conditionmodel text:Boredom 0.27830 0.70043 82.71068 0.397 0.692
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt Boredm cndt:B
## Pre_Total -0.763
## condtncntrl -0.338 0.010
## cndtnmdltxt -0.261 -0.097 0.503
## Boredom -0.103 0.012 0.142 0.137
## cndtncntr:B -0.048 0.138 0.071 -0.103 -0.626
## cndtnmtxt:B 0.030 0.043 -0.095 -0.134 -0.685 0.441
##
##
## ==================== Interaction model: Pride x condition ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 437.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.0835 -0.4568 0.0161 0.5904 2.4460
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.374 1.172
## Residual 6.761 2.600
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 10.38724 1.08872 31.53557 9.541 8.19e-11 ***
## Pre_Total 0.40544 0.06677 84.85195 6.073 3.43e-08 ***
## conditioncontrol -0.77847 0.69026 81.26347 -1.128 0.2627
## conditionmodel text 0.01997 0.68308 81.78800 0.029 0.9767
## Pride -0.44375 0.50431 81.12871 -0.880 0.3815
## conditioncontrol:Pride 1.63381 0.69807 81.18442 2.340 0.0217 *
## conditionmodel text:Pride 0.72984 0.70220 81.10834 1.039 0.3017
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt Pride cndt:P
## Pre_Total -0.753
## condtncntrl -0.253 -0.085
## cndtnmdltxt -0.241 -0.107 0.516
## Pride -0.026 -0.097 0.169 0.166
## cndtncntr:P 0.125 -0.071 0.018 -0.107 -0.701
## cndtnmtxt:P 0.177 -0.140 -0.101 -0.118 -0.693 0.522
##
##
## ==================== Interaction model: Anxiety x condition ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 441.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.15928 -0.41120 0.09423 0.62936 2.20365
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.316 1.147
## Residual 7.143 2.673
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.66033 1.09076 31.80310 8.857 4.28e-10 ***
## Pre_Total 0.44686 0.06553 84.97438 6.819 1.26e-09 ***
## conditioncontrol -0.88744 0.69279 80.99751 -1.281 0.204
## conditionmodel text 0.21258 0.69767 82.01939 0.305 0.761
## Anxiety 0.85133 0.61886 83.44830 1.376 0.173
## conditioncontrol:Anxiety -0.85484 0.76055 84.08535 -1.124 0.264
## conditionmodel text:Anxiety -1.09885 0.78402 83.25621 -1.402 0.165
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt Anxity cndt:A
## Pre_Total -0.756
## condtncntrl -0.319 -0.009
## cndtnmdltxt -0.265 -0.081 0.513
## Anxiety -0.165 0.116 0.118 0.124
## cndtncntr:A 0.094 -0.037 -0.053 -0.113 -0.824
## cndtnmtxt:A 0.069 -0.013 -0.092 -0.101 -0.788 0.655
##
##
## ==================== Interaction model: TaskDifficulty x condition ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 442.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.9238 -0.4309 0.0615 0.6640 2.3253
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.155 1.075
## Residual 7.241 2.691
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 9.85604 1.05982 33.21229 9.300
## Pre_Total 0.44072 0.06476 84.99998 6.805
## conditioncontrol -1.10677 0.69656 81.14182 -1.589
## conditionmodel text 0.08795 0.70317 81.87059 0.125
## TaskDifficulty -0.25808 0.55302 84.52378 -0.467
## conditioncontrol:TaskDifficulty -0.20960 0.70069 84.21629 -0.299
## conditionmodel text:TaskDifficulty 0.17673 0.73650 82.94400 0.240
## Pr(>|t|)
## (Intercept) 9.08e-11 ***
## Pre_Total 1.34e-09 ***
## conditioncontrol 0.116
## conditionmodel text 0.901
## TaskDifficulty 0.642
## conditioncontrol:TaskDifficulty 0.766
## conditionmodel text:TaskDifficulty 0.811
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt TskDff cnd:TD
## Pre_Total -0.760
## condtncntrl -0.305 -0.031
## cndtnmdltxt -0.256 -0.093 0.499
## TaskDffclty -0.076 0.092 0.010 0.019
## cndtncnt:TD 0.066 -0.078 0.073 -0.017 -0.786
## cndtxt:TskD 0.049 -0.058 -0.004 -0.106 -0.734 0.586
##
##
## ==================== Interaction model: BehavioralCognitiveEngagement x condition ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 443.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.04436 -0.39888 0.03581 0.62346 2.29297
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.206 1.098
## Residual 7.309 2.704
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df
## (Intercept) 9.84308 1.11119 33.63168
## Pre_Total 0.43944 0.06814 84.54331
## conditioncontrol -0.95514 0.69830 81.04833
## conditionmodel text 0.13331 0.71056 81.86289
## BehavioralCognitiveEngagement -0.20740 0.53086 82.94940
## conditioncontrol:BehavioralCognitiveEngagement 0.45652 0.69066 82.17724
## conditionmodel text:BehavioralCognitiveEngagement 0.11658 0.72440 81.74074
## t value Pr(>|t|)
## (Intercept) 8.858 2.60e-10 ***
## Pre_Total 6.450 6.65e-09 ***
## conditioncontrol -1.368 0.175
## conditionmodel text 0.188 0.852
## BehavioralCognitiveEngagement -0.391 0.697
## conditioncontrol:BehavioralCognitiveEngagement 0.661 0.510
## conditionmodel text:BehavioralCognitiveEngagement 0.161 0.873
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt BhvrCE cn:BCE
## Pre_Total -0.775
## condtncntrl -0.301 -0.027
## cndtnmdltxt -0.268 -0.065 0.507
## BhvrlCgntvE 0.204 -0.177 -0.095 -0.084
## cndtncn:BCE -0.022 -0.032 0.111 0.076 -0.727
## ctxt:BhvrCE -0.092 0.059 0.072 -0.044 -0.713 0.527
##
##
## ==================== Interaction model: SocialAgenticEngagement x condition ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 440.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.90891 -0.38125 -0.01121 0.60347 2.25841
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.174 1.083
## Residual 7.020 2.649
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df
## (Intercept) 9.83904 1.04682 31.72312
## Pre_Total 0.44737 0.06373 84.99057
## conditioncontrol -1.09425 0.68223 81.08221
## conditionmodel text 0.02633 0.68754 81.98536
## SocialAgenticEngagement -0.76819 0.42276 82.34622
## conditioncontrol:SocialAgenticEngagement 0.56054 0.56468 81.74136
## conditionmodel text:SocialAgenticEngagement 0.42795 0.72722 83.03407
## t value Pr(>|t|)
## (Intercept) 9.399 1.10e-10 ***
## Pre_Total 7.019 5.09e-10 ***
## conditioncontrol -1.604 0.1126
## conditionmodel text 0.038 0.9695
## SocialAgenticEngagement -1.817 0.0728 .
## conditioncontrol:SocialAgenticEngagement 0.993 0.3238
## conditionmodel text:SocialAgenticEngagement 0.588 0.5578
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt SclAgE cn:SAE
## Pre_Total -0.755
## condtncntrl -0.305 -0.035
## cndtnmdltxt -0.255 -0.100 0.510
## SclAgntcEng 0.011 -0.061 0.058 0.058
## cndtncn:SAE -0.008 0.044 -0.004 -0.043 -0.747
## ctxt:SclAgE -0.038 0.076 -0.039 -0.062 -0.593 0.443
##
##
## ==================== Interaction model: CognitiveEngagement x condition ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 437.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.07105 -0.45253 0.05245 0.52243 2.16196
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.077 1.038
## Residual 6.828 2.613
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 9.69889 1.03216 33.58524 9.397
## Pre_Total 0.45473 0.06343 84.99824 7.169
## conditioncontrol -0.94283 0.67374 81.09053 -1.399
## conditionmodel text 0.10469 0.67972 81.96276 0.154
## CognitiveEngagement -0.97181 0.50223 84.30773 -1.935
## conditioncontrol:CognitiveEngagement 1.63831 0.67025 82.48520 2.444
## conditionmodel text:CognitiveEngagement 0.49085 0.77267 83.15635 0.635
## Pr(>|t|)
## (Intercept) 6.32e-11 ***
## Pre_Total 2.58e-10 ***
## conditioncontrol 0.1655
## conditionmodel text 0.8780
## CognitiveEngagement 0.0563 .
## conditioncontrol:CognitiveEngagement 0.0166 *
## conditionmodel text:CognitiveEngagement 0.5270
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt CgntvE cnd:CE
## Pre_Total -0.763
## condtncntrl -0.301 -0.037
## cndtnmdltxt -0.265 -0.082 0.505
## CgntvEnggmn 0.046 -0.075 0.025 0.022
## cndtncnt:CE -0.011 0.023 0.045 -0.014 -0.736
## ctxt:CgntvE 0.051 -0.056 -0.016 -0.088 -0.641 0.475
##
##
## ==================== Interaction model: ReflectionTime x condition ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 442.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.1625 -0.4583 -0.0134 0.6067 2.4451
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.202 1.096
## Residual 7.249 2.692
## Number of obs: 91, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 9.795432 1.587042 67.520731 6.172
## Pre_Total 0.449135 0.065230 83.976420 6.885
## conditioncontrol -0.481490 1.421869 80.232683 -0.339
## conditionmodel text -0.050083 1.584136 80.566954 -0.032
## ReflectionTime -0.007765 0.227022 80.660638 -0.034
## conditioncontrol:ReflectionTime -0.416701 0.415700 81.168576 -1.002
## conditionmodel text:ReflectionTime 0.010368 0.285993 81.314031 0.036
## Pr(>|t|)
## (Intercept) 4.34e-08 ***
## Pre_Total 9.75e-10 ***
## conditioncontrol 0.736
## conditionmodel text 0.975
## ReflectionTime 0.973
## conditioncontrol:ReflectionTime 0.319
## conditionmodel text:ReflectionTime 0.971
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt RflctT cnd:RT
## Pre_Total -0.527
## condtncntrl -0.698 0.000
## cndtnmdltxt -0.618 -0.017 0.702
## ReflectinTm -0.740 0.023 0.810 0.728
## cndtncnt:RT 0.399 -0.007 -0.715 -0.409 -0.542
## ctxt:RflctT 0.598 -0.038 -0.648 -0.895 -0.797 0.445
main_coefs <- map_dfr(all_predictors, function(var) {
broom.mixed::tidy(main_models[[var]], effects = "fixed", conf.int = TRUE) %>%
filter(term == var) %>%
mutate(Predictor = var)
})
predictor_group <- tibble(
Predictor = all_predictors,
Group = c(
rep("Emotion", length(emotion_vars)),
rep("Engagement", length(engagement_vars)),
"Reflection time"
)
)
main_coefs <- main_coefs %>% left_join(predictor_group, by = "Predictor")
ggplot(main_coefs, aes(x = estimate, y = fct_reorder(Predictor, estimate), color = Group)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
geom_pointrange(aes(xmin = conf.low, xmax = conf.high), size = 0.5) +
labs(
title = "Analysis 2 (LME): Main effect of each predictor on Post_Total",
subtitle = "post ~ pre + condition + predictor + (1|Class), fit separately",
x = "Unstandardized coefficient (95% CI)", y = NULL
) +
theme_minimal(base_size = 12)
# --- 各predictor vs Post_Totalの散布図（可視化） ---
df_final %>%
select(ID, condition, Post_Total, all_of(all_predictors)) %>%
pivot_longer(all_of(all_predictors), names_to = "Predictor", values_to = "Score") %>%
mutate(Predictor = factor(Predictor, levels = all_predictors)) %>%
ggplot(aes(Score, Post_Total, color = condition)) +
geom_point(alpha = 0.6, size = 1.3) +
geom_smooth(method = "lm", se = FALSE, linewidth = 0.7) +
facet_wrap(~Predictor, scales = "free_x", ncol = 5) +
labs(title = "Post_Total vs each predictor (raw data, unconditional)", x = NULL, y = "Post_Total") +
theme_minimal(base_size = 10)
## `geom_smooth()` using formula = 'y ~ x'
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_smooth()`).
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_point()`).
interaction_summary <- map_dfr(all_predictors, function(var) {
broom.mixed::tidy(interaction_models[[var]], effects = "fixed") %>%
filter(str_detect(term, ":")) %>%
mutate(Predictor = var)
})
cat("Condition x Predictor 交互作用項（p<.10のみ表示）:\n")
## Condition x Predictor 交互作用項（p<.10のみ表示）:
interaction_summary %>%
filter(p.value < .10) %>%
select(Predictor, term, estimate, std.error, statistic, p.value) %>%
arrange(p.value) %>%
print(n = Inf)
## # A tibble: 2 × 6
## Predictor term estimate std.error statistic p.value
## <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 CognitiveEngagement conditioncontrol:Cog… 1.64 0.670 2.44 0.0166
## 2 Pride conditioncontrol:Pri… 1.63 0.698 2.34 0.0217
# --- 全交互作用項のforest plot（可視化、p<.10に限らずすべて表示） ---
interaction_summary %>%
mutate(
condition_level = str_extract(term, "(?<=condition)[a-z ]+(?=:)"),
sig = if_else(p.value < .05, "p<.05", "n.s.")
) %>%
ggplot(aes(x = estimate, y = fct_reorder(paste(Predictor, condition_level, sep = " x "), estimate), color = sig)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
geom_pointrange(aes(xmin = estimate - 1.96 * std.error, xmax = estimate + 1.96 * std.error)) +
scale_color_manual(values = c("p<.05" = "#b2182b", "n.s." = "grey50")) +
labs(
title = "All Condition x Predictor interaction terms",
x = "Interaction coefficient (+/- 95% CI)", y = NULL, color = NULL
) +
theme_minimal(base_size = 11)
# --- 有意な交互作用の予測値プロット（可視化） ---
plot_interaction_lme <- function(var) {
pred_grid <- expand_grid(
Pre_Total = mean(df_final$Pre_Total, na.rm = TRUE),
condition = levels(df_final$condition),
!!var := seq(min(df_final[[var]], na.rm = TRUE), max(df_final[[var]], na.rm = TRUE), length.out = 50)
)
pred_grid$Post_Total <- predict(interaction_models[[var]], newdata = pred_grid, re.form = NA)
ggplot(pred_grid, aes(x = .data[[var]], y = Post_Total, color = condition)) +
geom_line(linewidth = 1) +
labs(
title = paste0("Predicted Post_Total by ", var, " x condition"),
subtitle = "Class random effect set to 0 (population-level prediction)",
x = var, y = "Predicted Post_Total"
) +
theme_minimal(base_size = 12)
}
notable_interaction_vars <- interaction_summary %>%
filter(p.value < .10) %>%
distinct(Predictor) %>%
pull(Predictor)
for (var in notable_interaction_vars) {
print(plot_interaction_lme(var))
}
# ============================================================
# 16. Analysis 3: 組み合わせモデル（LME）
# ============================================================
m_emo_eng <- lmer(
as.formula(paste(
"Post_Total ~ Pre_Total + condition +",
paste(c(emotion_vars, engagement_vars), collapse = " + "), "+ (1 | Class)"
)),
data = df_final
)
cat("==== Emotion + Engagement ====\n")
## ==== Emotion + Engagement ====
summary(m_emo_eng)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## as.formula(paste("Post_Total ~ Pre_Total + condition +", paste(c(emotion_vars,
## engagement_vars), collapse = " + "), "+ (1 | Class)"))
## Data: df_final
##
## REML criterion at convergence: 438.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.13137 -0.54135 0.00914 0.69537 2.09067
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.246 1.116
## Residual 6.887 2.624
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.99620 1.13214 35.38198 8.829 1.80e-10 ***
## Pre_Total 0.41851 0.07076 79.99983 5.914 7.85e-08 ***
## conditioncontrol -0.91345 0.72941 76.19090 -1.252 0.2143
## conditionmodel text 0.42946 0.70127 76.86720 0.612 0.5421
## Enjoyment -0.42945 0.38024 77.82273 -1.129 0.2622
## Boredom -0.02028 0.35638 78.63250 -0.057 0.9548
## Pride 0.55842 0.35568 76.62287 1.570 0.1205
## Anxiety 0.49887 0.33645 76.94595 1.483 0.1422
## TaskDifficulty -0.79919 0.43550 77.35072 -1.835 0.0703 .
## BehavioralCognitiveEngagement 0.17322 0.45386 76.68277 0.382 0.7038
## SocialAgenticEngagement -0.54381 0.30296 77.16911 -1.795 0.0766 .
## CognitiveEngagement -0.06711 0.35170 77.98068 -0.191 0.8492
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt Enjymn Boredm Pride Anxity TskDff
## Pre_Total -0.782
## condtncntrl -0.287 -0.042
## cndtnmdltxt -0.255 -0.076 0.498
## Enjoyment -0.066 0.098 0.044 -0.127
## Boredom -0.052 -0.001 0.240 -0.021 0.358
## Pride 0.046 -0.176 0.271 0.186 -0.227 0.070
## Anxiety -0.100 0.078 0.087 0.079 0.017 0.105 0.122
## TaskDffclty -0.138 0.150 0.114 -0.025 0.183 -0.037 0.106 -0.489
## BhvrlCgntvE 0.265 -0.290 -0.053 -0.087 -0.137 0.243 -0.178 0.230 -0.633
## SclAgntcEng 0.071 -0.087 0.015 -0.019 -0.082 -0.034 -0.051 -0.008 -0.036
## CgntvEnggmn 0.039 -0.038 0.000 -0.040 -0.170 -0.021 -0.174 -0.164 0.098
## BhvrCE SclAgE
## Pre_Total
## condtncntrl
## cndtnmdltxt
## Enjoyment
## Boredom
## Pride
## Anxiety
## TaskDffclty
## BhvrlCgntvE
## SclAgntcEng 0.337
## CgntvEnggmn -0.119 -0.372
cat("\nVIF:\n")
##
## VIF:
print(car::vif(m_emo_eng))
## GVIF Df GVIF^(1/(2*Df))
## Pre_Total 1.272958 1 1.128254
## condition 1.280259 2 1.063713
## Enjoyment 1.626182 1 1.275218
## Boredom 1.533129 1 1.238196
## Pride 1.575717 1 1.255275
## Anxiety 1.515433 1 1.231029
## TaskDifficulty 2.488414 1 1.577471
## BehavioralCognitiveEngagement 2.715695 1 1.647936
## SocialAgenticEngagement 1.476437 1 1.215087
## CognitiveEngagement 1.437242 1 1.198850
# --- VIFの可視化 ---
vif_to_df <- function(vif_out, model_name) {
if (is.matrix(vif_out)) {
tibble(term = rownames(vif_out), VIF = vif_out[, "GVIF^(1/(2*Df))"]^2, Model = model_name)
} else {
tibble(term = names(vif_out), VIF = vif_out, Model = model_name)
}
}
vif_to_df(car::vif(m_emo_eng), "Emotion + Engagement") %>%
ggplot(aes(VIF, fct_reorder(term, VIF))) +
geom_col(fill = "#4472C4") +
geom_vline(xintercept = c(5, 10), linetype = "dashed", color = "grey50") +
labs(title = "VIF: Emotion + Engagement model", x = "VIF", y = NULL) +
theme_minimal(base_size = 12)
m_emo_refl <- lmer(
as.formula(paste(
"Post_Total ~ Pre_Total + condition +",
paste(emotion_vars, collapse = " + "), "+ ReflectionTime + (1 | Class)"
)),
data = df_final
)
cat("==== Emotion + Reflection time ====\n")
## ==== Emotion + Reflection time ====
summary(m_emo_refl)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## as.formula(paste("Post_Total ~ Pre_Total + condition +", paste(emotion_vars,
## collapse = " + "), "+ ReflectionTime + (1 | Class)"))
## Data: df_final
##
## REML criterion at convergence: 440.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.74838 -0.48722 0.07155 0.57474 2.30861
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.264 1.124
## Residual 7.195 2.682
## Number of obs: 91, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 10.09980 1.27291 47.10952 7.934 3.14e-10 ***
## Pre_Total 0.43378 0.07029 80.99880 6.171 2.54e-08 ***
## conditioncontrol -1.07611 0.88124 77.87742 -1.221 0.226
## conditionmodel text 0.34134 0.72384 78.29849 0.472 0.639
## Enjoyment -0.51863 0.37550 78.59478 -1.381 0.171
## Boredom -0.14470 0.35196 80.23197 -0.411 0.682
## Pride 0.49712 0.35112 78.11774 1.416 0.161
## Anxiety 0.38305 0.32998 78.18780 1.161 0.249
## TaskDifficulty -0.45884 0.33519 80.55511 -1.369 0.175
## ReflectionTime -0.06250 0.13002 79.21520 -0.481 0.632
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt Enjymn Boredm Pride Anxity TskDff
## Pre_Total -0.650
## condtncntrl -0.464 -0.081
## cndtnmdltxt -0.206 -0.139 0.437
## Enjoyment -0.017 0.043 0.038 -0.150
## Boredom -0.058 0.073 0.172 0.000 0.405
## Pride 0.100 -0.276 0.243 0.179 -0.315 0.115
## Anxiety -0.105 0.163 0.038 0.076 0.005 0.040 0.127
## TaskDffclty 0.008 -0.013 0.088 -0.126 0.169 0.192 0.004 -0.417
## ReflectinTm -0.476 -0.055 0.536 0.041 0.007 -0.100 0.022 -0.097 0.013
cat("\nVIF:\n")
##
## VIF:
print(car::vif(m_emo_refl))
## GVIF Df GVIF^(1/(2*Df))
## Pre_Total 1.185713 1 1.088905
## condition 1.916130 2 1.176539
## Enjoyment 1.509518 1 1.228625
## Boredom 1.428119 1 1.195039
## Pride 1.461635 1 1.208981
## Anxiety 1.361573 1 1.166865
## TaskDifficulty 1.358859 1 1.165701
## ReflectionTime 1.668091 1 1.291546
m_eng_refl <- lmer(
as.formula(paste(
"Post_Total ~ Pre_Total + condition +",
paste(engagement_vars, collapse = " + "), "+ ReflectionTime + (1 | Class)"
)),
data = df_final
)
cat("==== Engagement + Reflection time ====\n")
## ==== Engagement + Reflection time ====
summary(m_eng_refl)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## as.formula(paste("Post_Total ~ Pre_Total + condition +", paste(engagement_vars,
## collapse = " + "), "+ ReflectionTime + (1 | Class)"))
## Data: df_final
##
## REML criterion at convergence: 440.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.56502 -0.45959 0.01581 0.62723 2.17499
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.099 1.048
## Residual 7.142 2.672
## Number of obs: 91, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.83153 1.27286 50.07672 7.724 4.41e-10 ***
## Pre_Total 0.46765 0.06827 82.66165 6.850 1.21e-09 ***
## conditioncontrol -1.31590 0.84577 80.21651 -1.556 0.1237
## conditionmodel text -0.01654 0.70745 80.09594 -0.023 0.9814
## BehavioralCognitiveEngagement -0.21420 0.32995 82.47990 -0.649 0.5180
## SocialAgenticEngagement -0.55953 0.30718 80.17068 -1.821 0.0723 .
## CognitiveEngagement 0.05610 0.33863 81.82470 0.166 0.8688
## ReflectionTime -0.05621 0.12865 81.06326 -0.437 0.6633
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt BhvrCE SclAgE CgntvE
## Pre_Total -0.668
## condtncntrl -0.497 -0.041
## cndtnmdltxt -0.255 -0.065 0.434
## BhvrlCgntvE 0.245 -0.287 -0.020 -0.132
## SclAgntcEng 0.082 -0.097 0.013 -0.012 0.421
## CgntvEnggmn -0.008 -0.088 0.110 -0.007 -0.188 -0.426
## ReflectinTm -0.509 -0.014 0.581 0.049 -0.039 -0.039 0.119
cat("\nVIF:\n")
##
## VIF:
print(car::vif(m_eng_refl))
## GVIF Df GVIF^(1/(2*Df))
## Pre_Total 1.131968 1 1.063940
## condition 1.717463 2 1.144779
## BehavioralCognitiveEngagement 1.360669 1 1.166477
## SocialAgenticEngagement 1.442457 1 1.201023
## CognitiveEngagement 1.281846 1 1.132187
## ReflectionTime 1.646548 1 1.283179
# ============================================================
# 17. Analysis 4: 最終統合モデル（LME）
# ============================================================
# フル4-way交互作用は行わない（N=92, Class 5群に対してパラメータ過多）。
# Condition x 各predictorの交互作用はAnalysis 2で個別に確認済み。
# ============================================================
m_full <- lmer(
as.formula(paste(
"Post_Total ~ Pre_Total + condition +",
paste(c(emotion_vars, engagement_vars, "ReflectionTime"), collapse = " + "), "+ (1 | Class)"
)),
data = df_final
)
cat("==== Full model (Emotion + Engagement + Reflection time) ====\n")
## ==== Full model (Emotion + Engagement + Reflection time) ====
summary(m_full)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## as.formula(paste("Post_Total ~ Pre_Total + condition +", paste(c(emotion_vars,
## engagement_vars, "ReflectionTime"), collapse = " + "), "+ (1 | Class)"))
## Data: df_final
##
## REML criterion at convergence: 435.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.21308 -0.52685 -0.00705 0.66032 2.05724
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.179 1.086
## Residual 6.985 2.643
## Number of obs: 91, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 10.273402 1.303910 49.916857 7.879 2.59e-10
## Pre_Total 0.431350 0.072283 77.987813 5.968 6.69e-08
## conditioncontrol -1.233943 0.875676 74.939696 -1.409 0.1629
## conditionmodel text 0.304116 0.716982 75.189870 0.424 0.6727
## Enjoyment -0.426784 0.382799 75.879703 -1.115 0.2684
## Boredom 0.008323 0.361796 76.911073 0.023 0.9817
## Pride 0.528773 0.359358 74.696643 1.471 0.1454
## Anxiety 0.558915 0.343824 74.838326 1.626 0.1082
## TaskDifficulty -0.798725 0.441908 75.315121 -1.807 0.0747
## BehavioralCognitiveEngagement 0.216264 0.460400 74.766330 0.470 0.6399
## SocialAgenticEngagement -0.548396 0.305680 75.132211 -1.794 0.0768
## CognitiveEngagement -0.101747 0.356620 75.923546 -0.285 0.7762
## ReflectionTime -0.084037 0.129794 76.131645 -0.647 0.5193
##
## (Intercept) ***
## Pre_Total ***
## conditioncontrol
## conditionmodel text
## Enjoyment
## Boredom
## Pride
## Anxiety
## TaskDifficulty .
## BehavioralCognitiveEngagement
## SocialAgenticEngagement .
## CognitiveEngagement
## ReflectionTime
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation matrix not shown by default, as p = 13 > 12.
## Use print(x, correlation=TRUE) or
## vcov(x) if you need it
cat("\nVIF:\n")
##
## VIF:
print(car::vif(m_full))
## GVIF Df GVIF^(1/(2*Df))
## Pre_Total 1.293440 1 1.137295
## condition 1.965388 2 1.184028
## Enjoyment 1.616695 1 1.271493
## Boredom 1.555768 1 1.247304
## Pride 1.577739 1 1.256081
## Anxiety 1.522821 1 1.234026
## TaskDifficulty 2.435542 1 1.560622
## BehavioralCognitiveEngagement 2.705524 1 1.644848
## SocialAgenticEngagement 1.459991 1 1.208301
## CognitiveEngagement 1.451809 1 1.204910
## ReflectionTime 1.712759 1 1.308724
# --- VIFの可視化 ---
vif_to_df(car::vif(m_full), "Full model") %>%
ggplot(aes(VIF, fct_reorder(term, VIF))) +
geom_col(fill = "#4472C4") +
geom_vline(xintercept = c(5, 10), linetype = "dashed", color = "grey50") +
labs(title = "VIF: Full model", x = "VIF", y = NULL) +
theme_minimal(base_size = 12)
# --- Class変量切片のキャタピラープロット（可視化） ---
ranef_full <- broom.mixed::tidy(m_full, effects = "ran_vals") %>%
filter(group == "Class")
ggplot(ranef_full, aes(x = estimate, y = fct_reorder(level, estimate))) +
geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
geom_pointrange(aes(xmin = estimate - 1.96 * std.error, xmax = estimate + 1.96 * std.error)) +
labs(title = "Class random intercepts (m_full)", x = "Random intercept (+/- 95% CI)", y = "Class") +
theme_minimal(base_size = 12)
# --- モデル診断プロット（可視化） ---
diag_full <- broom.mixed::augment(m_full)
p_resid_fitted <- ggplot(diag_full, aes(.fitted, .resid)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_point(alpha = 0.6) +
geom_smooth(se = FALSE, linewidth = 0.6, color = "firebrick") +
labs(title = "Residuals vs Fitted", x = "Fitted", y = "Residual") +
theme_minimal(base_size = 11)
p_qq <- ggplot(diag_full, aes(sample = .resid)) +
stat_qq(alpha = 0.6) +
stat_qq_line(color = "firebrick") +
labs(title = "Normal Q-Q plot of residuals", x = "Theoretical quantiles", y = "Sample quantiles") +
theme_minimal(base_size = 11)
gridExtra::grid.arrange(p_resid_fitted, p_qq, ncol = 2)
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
# ------------------------------------------------------------
# 17b. 頑健性チェック：倹約モデル
# ------------------------------------------------------------
notable_predictors <- main_coefs %>% filter(p.value < .10) %>% pull(Predictor)
cat("倹約モデルに含めるpredictor(Analysis2でp<.10だったもの):\n")
## 倹約モデルに含めるpredictor(Analysis2でp<.10だったもの):
print(notable_predictors)
## [1] "SocialAgenticEngagement"
if (length(notable_predictors) > 0) {
m_parsimonious <- lmer(
as.formula(paste(
"Post_Total ~ Pre_Total + condition +",
paste(notable_predictors, collapse = " + "), "+ (1 | Class)"
)),
data = df_final
)
cat("\n==== Parsimonious model ====\n")
print(summary(m_parsimonious))
} else {
cat("\nAnalysis2でp<.10のpredictorがなかったため、倹約モデルは省略。\n")
}
##
## ==== Parsimonious model ====
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## as.formula(paste("Post_Total ~ Pre_Total + condition +", paste(notable_predictors,
## collapse = " + "), "+ (1 | Class)"))
## Data: df_final
##
## REML criterion at convergence: 443.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.72142 -0.42789 0.00498 0.59233 2.36909
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.231 1.109
## Residual 6.925 2.632
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.86568 1.04650 30.98820 9.427 1.29e-10 ***
## Pre_Total 0.44290 0.06318 86.99833 7.010 4.84e-10 ***
## conditioncontrol -1.08494 0.67705 83.04269 -1.602 0.1128
## conditionmodel text 0.06637 0.68158 83.88628 0.097 0.9227
## SocialAgenticEngagement -0.43439 0.25072 83.48555 -1.733 0.0869 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.750
## condtncntrl -0.305 -0.033
## cndtnmdltxt -0.255 -0.096 0.509
## SclAgntcEng -0.010 -0.016 0.071 0.019
full_coefs <- broom.mixed::tidy(m_full, effects = "fixed", conf.int = TRUE) %>%
filter(!term %in% c("(Intercept)", "Pre_Total")) %>%
filter(!str_detect(term, "^condition")) %>%
mutate(
Group = case_when(
term %in% emotion_vars ~ "Emotion",
term %in% engagement_vars ~ "Engagement",
term == "ReflectionTime" ~ "Reflection time",
TRUE ~ "Other"
)
)
ggplot(full_coefs, aes(x = estimate, y = fct_reorder(term, estimate), color = Group)) +
geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
geom_pointrange(aes(xmin = conf.low, xmax = conf.high), size = 0.5) +
labs(
title = "Analysis 4 (LME): Full model coefficients",
subtitle = "post ~ pre + condition + all emotion(EFA) + all engagement(EFA) + reflection time + (1|Class)",
x = "Unstandardized coefficient (95% CI)", y = NULL
) +
theme_minimal(base_size = 12)
