# ============================================================
# 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 = 5 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 = 5 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.01 0.71 0.60 0.48 0.37 0.27 0.19 0.11 0.03 -0.04 -0.11 -0.17
## [13] -0.25 -0.31 -0.37 -0.43 -0.51 -0.59
##
## 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.10 0.81 0.66 0.52 0.43 0.34 0.25 0.16 0.09 0.02 -0.05 -0.12
## [13] -0.17 -0.24 -0.29 -0.35 -0.42 -0.47 -0.55 -0.62
##
## 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
# ============================================================
# ★注意★ Parallel AnalysisはEmotionと異なり3因子を示唆しており、
# 理論どおりの4因子（Behavioral/Cognitive/Agentic/Social）とは
# 一致しない。4因子モデルでも項目のクロスローディングが多く、
# 弁別的妥当性はEmotion尺度ほど明確ではない。
# ここでは研究上の解釈可能性を優先し、理論に基づく4因子解を採用するが、
# 分析結果を解釈する際はこの点に注意が必要（Limitationとして明記）。
# ============================================================
efa_engagement <- fa(
R_engagement, nfactors = 4, 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:
## MR1 MR2 MR3 MR4
## Q36 0.508
## Q39 0.665
## Q41 1.018
## Q42 0.754
## Q43 0.536 0.312
## Q45 0.530 0.422 -0.304
## Q24 0.670 0.310
## Q25 0.576
## Q31 0.570 0.319
## Q32 0.768
## Q33 0.745
## Q21 0.569
## Q34 0.776
## Q37 0.347 0.518
## Q22 0.397
## Q23 0.423 0.314
## Q35 0.447
## Q38 0.403 0.305
## Q40 0.448
## Q44 0.321 0.453
##
## MR1 MR2 MR3 MR4
## SS loadings 3.536 2.932 1.851 1.185
## Proportion Var 0.177 0.147 0.093 0.059
## Cumulative Var 0.177 0.323 0.416 0.475
cat("\n因子間相関:\n")
##
## 因子間相関:
print(round(efa_engagement$Phi, 2))
## MR1 MR2 MR3 MR4
## MR1 1.00 -0.25 0.29 -0.10
## MR2 -0.25 1.00 0.08 0.28
## MR3 0.29 0.08 1.00 -0.02
## MR4 -0.10 0.28 -0.02 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 (4-factor solution)",
subtitle = "Items grouped by a priori construct — note the cross-loading",
x = NULL, y = NULL
) +
theme_minimal(base_size = 11)
# ============================================================
# 10. Engagement：因子の自動ラベリング・符号補正
# ============================================================
engagement_loadings <- unclass(efa_engagement$loadings)
rownames(engagement_loadings) <- engagement_items
engagement_assignment <- label_factors(engagement_loadings, engagement_item_map)
cat("Engagement: construct <-> factor 対応（平均負荷量, 符号）\n")
## Engagement: construct <-> factor 対応（平均負荷量, 符号）
for (cons in names(engagement_assignment)) {
a <- engagement_assignment[[cons]]
cat(sprintf(" %-24s <- %s (mean loading = %.2f, sign = %+d)\n", cons, a$factor, a$loading, a$sign))
}
## Social engagement <- MR1 (mean loading = 0.60, sign = +1)
## Cognitive engagement <- MR2 (mean loading = 0.46, sign = +1)
## Behavioral engagement <- MR4 (mean loading = 0.25, sign = +1)
## Agentic engagement <- MR3 (mean loading = 0.19, sign = +1)
# ============================================================
# 11. Engagement因子得点をデータフレームに追加
# ============================================================
engagement_factor_df <- as.data.frame(engagement_fscores)
names(engagement_factor_df) <- colnames(engagement_fscores)
engagement_name_map <- c(
"Behavioral engagement" = "BehavioralEngagement",
"Cognitive engagement" = "CognitiveEngagement",
"Agentic engagement" = "AgenticEngagement",
"Social engagement" = "SocialEngagement"
)
for (cons in names(engagement_assignment)) {
a <- engagement_assignment[[cons]]
clean_name <- engagement_name_map[[cons]]
df_raw[[clean_name]] <- a$sign * engagement_factor_df[[a$factor]]
}
df_raw %>% select(all_of(unname(engagement_name_map))) %>% psych::describe()
## vars n mean sd median trimmed mad min max range
## BehavioralEngagement 1 92 0 0.88 0.06 0.05 0.72 -3.02 2.09 5.11
## CognitiveEngagement 2 92 0 1.00 0.10 0.09 0.95 -2.48 1.65 4.13
## AgenticEngagement 3 92 0 0.97 -0.15 -0.05 1.18 -1.59 2.96 4.54
## SocialEngagement 4 92 0 1.11 -0.49 -0.17 0.71 -1.25 3.89 5.14
## skew kurtosis se
## BehavioralEngagement -0.65 0.85 0.09
## CognitiveEngagement -0.72 -0.02 0.10
## AgenticEngagement 0.45 -0.34 0.10
## SocialEngagement 1.21 0.84 0.12
# ============================================================
# 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 condition
## 0 0 0
## Pre_Total Post_Total Development
## 0 0 0
## Enjoyment Boredom Pride
## 0 0 0
## Anxiety TaskDifficulty BehavioralEngagement
## 0 0 0
## CognitiveEngagement AgenticEngagement SocialEngagement
## 0 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 × 16
## 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
## # ℹ 8 more variables: Pride <dbl>, Anxiety <dbl>, TaskDifficulty <dbl>,
## # BehavioralEngagement <dbl>, CognitiveEngagement <dbl>,
## # AgenticEngagement <dbl>, SocialEngagement <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 max range
## Pre_Total 1 92 12.83 4.67 13.50 13.03 5.19 4.00 21.00 17.00
## Post_Total 2 92 15.16 3.67 16.00 15.58 2.97 4.00 21.00 17.00
## Enjoyment 3 92 0.00 0.94 -0.04 -0.02 0.98 -1.81 2.40 4.22
## Boredom 4 92 0.00 1.00 0.08 -0.01 0.99 -1.90 2.37 4.27
## Pride 5 92 0.00 0.99 0.04 -0.08 1.01 -1.73 3.31 5.03
## Anxiety 6 92 0.00 1.01 0.24 0.10 1.03 -2.63 1.52 4.14
## TaskDifficulty 7 92 0.00 1.04 0.31 0.12 0.99 -2.79 1.18 3.97
## BehavioralEngagement 8 92 0.00 0.88 0.06 0.05 0.72 -3.02 2.09 5.11
## CognitiveEngagement 9 92 0.00 1.00 0.10 0.09 0.95 -2.48 1.65 4.13
## AgenticEngagement 10 92 0.00 0.97 -0.15 -0.05 1.18 -1.59 2.96 4.54
## SocialEngagement 11 92 0.00 1.11 -0.49 -0.17 0.71 -1.25 3.89 5.14
## ReflectionTime 12 91 3.73 2.84 3.38 3.46 3.01 0.05 10.00 9.95
## skew kurtosis se
## Pre_Total -0.34 -1.02 0.49
## Post_Total -1.14 1.20 0.38
## Enjoyment 0.21 -0.42 0.10
## Boredom 0.10 -0.61 0.10
## Pride 0.71 0.48 0.10
## Anxiety -0.73 -0.31 0.11
## TaskDifficulty -0.83 -0.36 0.11
## BehavioralEngagement -0.65 0.85 0.09
## CognitiveEngagement -0.72 -0.02 0.10
## AgenticEngagement 0.45 -0.34 0.10
## SocialEngagement 1.21 0.84 0.12
## ReflectionTime 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: BehavioralEngagement ====================
## 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.06682 -0.47662 0.02567 0.64214 2.46000
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.200 1.096
## Residual 7.174 2.678
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.79191 1.07403 32.93627 9.117 1.58e-10 ***
## Pre_Total 0.44450 0.06499 86.95758 6.840 1.05e-09 ***
## conditioncontrol -1.00009 0.68752 83.09882 -1.455 0.150
## conditionmodel text 0.11876 0.70863 84.13285 0.168 0.867
## BehavioralEngagement -0.08223 0.34522 86.44383 -0.238 0.812
## ---
## 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.306 -0.028
## cndtnmdltxt -0.284 -0.061 0.502
## BhvrlEnggmn 0.175 -0.152 -0.022 -0.206
##
##
## ==================== 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: 446.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.09389 -0.47910 0.03045 0.65631 2.47695
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.194 1.092
## Residual 7.180 2.680
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.82448 1.09975 33.96572 8.933 1.95e-10 ***
## Pre_Total 0.44304 0.06781 86.66314 6.533 4.24e-09 ***
## conditioncontrol -1.00352 0.68770 83.01431 -1.459 0.148
## conditionmodel text 0.08523 0.69539 83.77812 0.123 0.903
## CognitiveEngagement -0.01099 0.30334 85.85879 -0.036 0.971
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.776
## condtncntrl -0.299 -0.026
## cndtnmdltxt -0.266 -0.068 0.509
## CgntvEnggmn 0.276 -0.320 -0.013 -0.068
##
##
## ==================== Main effect model: AgenticEngagement ====================
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: f
## Data: df_final
##
## REML criterion at convergence: 445.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.09397 -0.44217 0.04798 0.61944 2.43118
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.162 1.078
## Residual 7.166 2.677
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.77289 1.05948 33.33698 9.224 1.07e-10 ***
## Pre_Total 0.44750 0.06489 86.99999 6.896 8.12e-10 ***
## conditioncontrol -1.03172 0.68912 83.10929 -1.497 0.138
## conditionmodel text 0.09688 0.69373 83.93940 0.140 0.889
## AgenticEngagement -0.15097 0.30337 85.17991 -0.498 0.620
## ---
## 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.297 -0.043
## cndtnmdltxt -0.262 -0.087 0.503
## AgntcEnggmn 0.110 -0.149 0.079 -0.045
##
##
## ==================== Main effect model: SocialEngagement ====================
## 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.72793 -0.42538 0.01359 0.60327 2.37012
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.221 1.105
## Residual 6.928 2.632
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.86174 1.04563 31.14375 9.431 1.22e-10 ***
## Pre_Total 0.44348 0.06319 86.99918 7.018 4.67e-10 ***
## conditioncontrol -1.08590 0.67724 83.04453 -1.603 0.1126
## conditionmodel text 0.05771 0.68183 83.89264 0.085 0.9328
## SocialEngagement -0.43220 0.25012 83.52186 -1.728 0.0877 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.751
## condtncntrl -0.305 -0.033
## cndtnmdltxt -0.255 -0.096 0.509
## SoclEnggmnt -0.008 -0.020 0.072 0.026
##
##
## ==================== 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: BehavioralEngagement 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.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.06064 -0.45369 0.03193 0.65104 2.42780
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.202 1.096
## Residual 7.298 2.701
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 9.77446 1.09389 33.16016 8.935
## Pre_Total 0.44599 0.06585 84.90933 6.772
## conditioncontrol -0.97805 0.70152 81.06991 -1.394
## conditionmodel text 0.25206 0.73661 82.35363 0.342
## BehavioralEngagement -0.10524 0.61873 84.21788 -0.170
## conditioncontrol:BehavioralEngagement 0.24008 0.76534 81.93269 0.314
## conditionmodel text:BehavioralEngagement -0.46274 0.99402 84.36147 -0.466
## Pr(>|t|)
## (Intercept) 2.40e-10 ***
## Pre_Total 1.55e-09 ***
## conditioncontrol 0.167
## conditionmodel text 0.733
## BehavioralEngagement 0.865
## conditioncontrol:BehavioralEngagement 0.755
## conditionmodel text:BehavioralEngagement 0.643
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt BhvrlE cnd:BE
## Pre_Total -0.765
## condtncntrl -0.322 -0.012
## cndtnmdltxt -0.277 -0.053 0.492
## BhvrlEnggmn 0.222 -0.166 -0.134 -0.123
## cndtncnt:BE -0.144 0.098 0.150 0.099 -0.771
## ctxt:BhvrlE -0.107 0.061 0.088 -0.151 -0.619 0.459
##
##
## ==================== 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: 443.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.04631 -0.37657 0.03805 0.61818 2.22642
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.222 1.105
## Residual 7.303 2.702
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 9.84578 1.11637 33.55804 8.819
## Pre_Total 0.43921 0.06901 84.46537 6.364
## conditioncontrol -0.96425 0.69575 81.02732 -1.386
## conditionmodel text 0.11851 0.70424 81.89272 0.168
## CognitiveEngagement -0.27852 0.53731 82.47179 -0.518
## conditioncontrol:CognitiveEngagement 0.51206 0.71095 82.37728 0.720
## conditionmodel text:CognitiveEngagement 0.25151 0.72280 81.30172 0.348
## Pr(>|t|)
## (Intercept) 2.94e-10 ***
## Pre_Total 9.71e-09 ***
## conditioncontrol 0.170
## conditionmodel text 0.867
## CognitiveEngagement 0.606
## conditioncontrol:CognitiveEngagement 0.473
## conditionmodel text:CognitiveEngagement 0.729
## ---
## 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.778
## condtncntrl -0.296 -0.029
## cndtnmdltxt -0.255 -0.079 0.509
## CgntvEnggmn 0.186 -0.178 -0.068 -0.055
## cndtncnt:CE 0.019 -0.068 0.079 0.061 -0.715
## ctxt:CgntvE -0.080 0.061 0.051 -0.025 -0.724 0.532
##
##
## ==================== Interaction model: AgenticEngagement 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.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.0673 -0.4472 0.0504 0.5263 2.1294
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.049 1.024
## Residual 6.806 2.609
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 9.66888 1.02916 34.06366 9.395
## Pre_Total 0.45658 0.06342 85.00000 7.199
## conditioncontrol -0.91883 0.67334 81.07286 -1.365
## conditionmodel text 0.11348 0.67985 81.95219 0.167
## AgenticEngagement -0.98372 0.49653 84.37096 -1.981
## conditioncontrol:AgenticEngagement 1.69901 0.66853 82.61316 2.541
## conditionmodel text:AgenticEngagement 0.54261 0.76086 82.97701 0.713
## Pr(>|t|)
## (Intercept) 5.52e-11 ***
## Pre_Total 2.25e-10 ***
## conditioncontrol 0.1762
## conditionmodel text 0.8678
## AgenticEngagement 0.0508 .
## conditioncontrol:AgenticEngagement 0.0129 *
## conditionmodel text:AgenticEngagement 0.4778
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt AgntcE cnd:AE
## Pre_Total -0.766
## condtncntrl -0.301 -0.037
## cndtnmdltxt -0.268 -0.078 0.503
## AgntcEnggmn 0.060 -0.087 0.019 0.017
## cndtncnt:AE -0.022 0.034 0.058 -0.011 -0.731
## ctxt:AgntcE 0.047 -0.054 -0.011 -0.098 -0.638 0.470
##
##
## ==================== Interaction model: SocialEngagement 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.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.92442 -0.36835 -0.00928 0.60845 2.24740
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.160 1.077
## Residual 7.007 2.647
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 9.83650 1.04444 31.90511 9.418
## Pre_Total 0.44827 0.06365 84.98986 7.043
## conditioncontrol -1.10101 0.68167 81.09395 -1.615
## conditionmodel text 0.01235 0.68686 81.98360 0.018
## SocialEngagement -0.80535 0.42575 82.30425 -1.892
## conditioncontrol:SocialEngagement 0.61006 0.56250 81.66462 1.085
## conditionmodel text:SocialEngagement 0.49076 0.73225 83.20540 0.670
## Pr(>|t|)
## (Intercept) 9.91e-11 ***
## Pre_Total 4.58e-10 ***
## conditioncontrol 0.1102
## conditionmodel text 0.9857
## SocialEngagement 0.0621 .
## conditioncontrol:SocialEngagement 0.2813
## conditionmodel text:SocialEngagement 0.5046
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt SclEng cnd:SE
## Pre_Total -0.755
## condtncntrl -0.305 -0.035
## cndtnmdltxt -0.256 -0.099 0.510
## SoclEnggmnt 0.009 -0.061 0.062 0.062
## cndtncnt:SE -0.005 0.043 -0.010 -0.046 -0.754
## cndtxt:SclE -0.034 0.073 -0.042 -0.057 -0.595 0.449
##
##
## ==================== 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", 5), rep("Engagement", 4), "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 AgenticEngagement conditioncontrol:Agent… 1.70 0.669 2.54 0.0129
## 2 Pride conditioncontrol:Pride 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.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.15871 -0.51714 0.00381 0.67185 2.08394
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.252 1.119
## Residual 6.968 2.640
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.990013 1.142822 35.748603 8.742 2.11e-10 ***
## Pre_Total 0.419852 0.071610 78.999353 5.863 1.00e-07 ***
## conditioncontrol -0.908500 0.733863 75.232527 -1.238 0.2196
## conditionmodel text 0.396434 0.712570 76.046021 0.556 0.5796
## Enjoyment -0.463611 0.391415 77.232787 -1.184 0.2399
## Boredom -0.036690 0.360049 78.172007 -0.102 0.9191
## Pride 0.580665 0.363714 76.110102 1.596 0.1145
## Anxiety 0.477378 0.339993 75.832138 1.404 0.1644
## TaskDifficulty -0.769862 0.435607 76.250808 -1.767 0.0812 .
## BehavioralEngagement 0.143258 0.397692 78.064016 0.360 0.7197
## CognitiveEngagement 0.040093 0.467657 76.515403 0.086 0.9319
## AgenticEngagement 0.009387 0.363990 76.918921 0.026 0.9795
## SocialEngagement -0.591230 0.306870 76.146100 -1.927 0.0578 .
## ---
## 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_emo_eng))
## GVIF Df GVIF^(1/(2*Df))
## Pre_Total 1.288873 1 1.135286
## condition 1.317540 2 1.071374
## Enjoyment 1.703266 1 1.305092
## Boredom 1.546948 1 1.243764
## Pride 1.628638 1 1.276181
## Anxiety 1.529558 1 1.236753
## TaskDifficulty 2.461070 1 1.568780
## BehavioralEngagement 1.480896 1 1.216921
## CognitiveEngagement 2.753990 1 1.659515
## AgenticEngagement 1.539393 1 1.240723
## SocialEngagement 1.505085 1 1.226819
# --- 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.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.52825 -0.45972 0.00818 0.64333 2.16174
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.089 1.044
## Residual 7.223 2.688
## Number of obs: 91, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.78026 1.28813 50.21298 7.593 6.95e-10 ***
## Pre_Total 0.46991 0.06920 81.57965 6.791 1.66e-09 ***
## conditioncontrol -1.29042 0.85322 79.39413 -1.512 0.1344
## conditionmodel text -0.03717 0.72360 79.62302 -0.051 0.9592
## BehavioralEngagement -0.06317 0.38878 81.55454 -0.162 0.8713
## CognitiveEngagement -0.21317 0.37341 81.12653 -0.571 0.5697
## AgenticEngagement 0.10452 0.35114 80.89185 0.298 0.7667
## SocialEngagement -0.57884 0.31303 79.22355 -1.849 0.0682 .
## ReflectionTime -0.05076 0.13067 80.47533 -0.388 0.6987
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt BhvrlE CgntvE AgntcE SclEng
## Pre_Total -0.674
## condtncntrl -0.501 -0.033
## cndtnmdltxt -0.235 -0.076 0.413
## BhvrlEnggmn -0.005 -0.009 0.053 -0.210
## CgntvEnggmn 0.251 -0.277 -0.070 0.030 -0.414
## AgntcEnggmn -0.029 -0.066 0.130 -0.061 0.131 -0.285
## SoclEnggmnt 0.098 -0.107 -0.011 0.042 -0.060 0.415 -0.469
## ReflectinTm -0.515 0.000 0.584 0.023 0.109 -0.126 0.153 -0.076
cat("\nVIF:\n")
##
## VIF:
print(car::vif(m_eng_refl))
## GVIF Df GVIF^(1/(2*Df))
## Pre_Total 1.150908 1 1.072804
## condition 1.827751 2 1.162731
## BehavioralEngagement 1.353790 1 1.163525
## CognitiveEngagement 1.669773 1 1.292197
## AgenticEngagement 1.380533 1 1.174961
## SocialEngagement 1.486647 1 1.219281
## ReflectionTime 1.679888 1 1.296105
# ============================================================
# 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.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.22539 -0.51226 -0.02252 0.65619 2.05281
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.186 1.089
## Residual 7.073 2.659
## Number of obs: 91, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 10.223062 1.323079 50.275944 7.727 4.26e-10 ***
## Pre_Total 0.432560 0.073174 76.995393 5.911 8.75e-08 ***
## conditioncontrol -1.197574 0.886450 74.179856 -1.351 0.1808
## conditionmodel text 0.274978 0.729145 74.427493 0.377 0.7072
## Enjoyment -0.457873 0.394535 75.361053 -1.161 0.2495
## Boredom -0.008954 0.366825 76.552197 -0.024 0.9806
## Pride 0.548129 0.367624 74.242402 1.491 0.1402
## Anxiety 0.536744 0.348384 73.757584 1.541 0.1277
## TaskDifficulty -0.767673 0.443235 74.255021 -1.732 0.0874 .
## BehavioralEngagement 0.142291 0.403348 76.448720 0.353 0.7252
## CognitiveEngagement 0.087004 0.481188 75.144125 0.181 0.8570
## AgenticEngagement -0.024615 0.371447 74.951151 -0.066 0.9473
## SocialEngagement -0.596265 0.310876 74.218770 -1.918 0.0590 .
## ReflectionTime -0.075218 0.132741 75.739547 -0.567 0.5726
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation matrix not shown by default, as p = 14 > 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.309336 1 1.144262
## condition 2.078498 2 1.200708
## Enjoyment 1.696101 1 1.302344
## Boredom 1.579640 1 1.256837
## Pride 1.630714 1 1.276994
## Anxiety 1.544042 1 1.242595
## TaskDifficulty 2.420151 1 1.555683
## BehavioralEngagement 1.484891 1 1.218561
## CognitiveEngagement 2.828456 1 1.681801
## AgenticEngagement 1.575251 1 1.255090
## SocialEngagement 1.496604 1 1.223358
## ReflectionTime 1.769174 1 1.330103
# --- 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] "SocialEngagement"
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.72793 -0.42538 0.01359 0.60327 2.37012
##
## Random effects:
## Groups Name Variance Std.Dev.
## Class (Intercept) 1.221 1.105
## Residual 6.928 2.632
## Number of obs: 92, groups: Class, 5
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.86174 1.04563 31.14375 9.431 1.22e-10 ***
## Pre_Total 0.44348 0.06319 86.99918 7.018 4.67e-10 ***
## conditioncontrol -1.08590 0.67724 83.04453 -1.603 0.1126
## conditionmodel text 0.05771 0.68183 83.89264 0.085 0.9328
## SocialEngagement -0.43220 0.25012 83.52186 -1.728 0.0877 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) Pr_Ttl cndtnc cndtnt
## Pre_Total -0.751
## condtncntrl -0.305 -0.033
## cndtnmdltxt -0.255 -0.096 0.509
## SoclEnggmnt -0.008 -0.020 0.072 0.026
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)
