Writing Development・Emotion・Engagement：RQ 別分析レポート
Control / Model text / AI-WCF の比較（改訂版）
2026-10-20
# パッケージの読み込み
# tidyverse = データ整形と図、readxl = Excel 読み込み、psych = 信頼性・因子分析
# lme4 / lmerTest = 線形混合モデル、emmeans = 事後比較、effectsize = 効果量
# car = Type II / III の分散分析、knitr / kableExtra = 表の整形
library(tidyverse)
library(readxl)
library(psych)
library(lme4)
library(lmerTest)
library(emmeans)
library(effectsize)
library(car)
library(knitr)
library(kableExtra)# ---- 配色（色覚多様性に配慮して検証済みの 3 色；条件の順序で固定） ----
cond_levels <- c("Control", "Model text", "AI-WCF")
cond_cols <- c("Control" = "#2a78d6", "Model text" = "#eb6834", "AI-WCF" = "#1baf7a")
cond_shapes <- c("Control" = 16, "Model text" = 17, "AI-WCF" = 15)
# 条件の 3 色は条件を表すときだけ使う。条件以外の図は濃いグレー
neutral_col <- "#3d3d3a"
# ヒートマップ（因子負荷量・因子間相関・感情 × 関与の相関）は 赤 = 正、青 = 負
div_low <- "#2166ac" # 負の値（青）
div_mid <- "#f0efec" # 0
div_high <- "#b2182b" # 正の値（赤）
fa_low <- div_low
fa_high <- div_high
# 全図で共通に使う見た目（テーマ）
theme_report <- theme_minimal(base_size = 13) +
theme(panel.grid.minor = element_blank(),
legend.position = "bottom",
strip.text = element_text(face = "bold"))
# ---- 書式 ----
# p 値を「.012」「< .001」の形に整える
fmt_p <- function(p) ifelse(p < .001, "< .001", sub("^0\\.", ".", sprintf("%.3f", p)))
fmt_p_eq <- function(p) ifelse(p < .001, "< .001", paste("=", fmt_p(p))) # "p = .012" / "p < .001"
# 推定値と 95% 信頼区間を「0.54 [0.02, 1.05]」の形に整える
fmt_ci <- function(est, lo, hi, digits = 2)
sprintf(paste0("%.", digits, "f [%.", digits, "f, %.", digits, "f]"), est, lo, hi)
# 相関係数を「.40」「-.38」の形（先頭の 0 を省く）に整える
fmt_r <- function(x) sub("^(-?)0\\.", "\\1.", sprintf("%.2f", x))
# ---- 効果量の解釈：Plonsky & Oswald (2014) ----
# 効果量の大きさを Plonsky & Oswald (2014) の基準で「< small / small / medium / large」に分類する
po_label <- function(x, type = c("between", "within", "r")) {
type <- match.arg(type)
b <- switch(type, between = c(.40, .70, 1.00), within = c(.60, 1.00, 1.40),
r = c(.25, .40, .60))
as.character(cut(abs(x), c(-Inf, b, Inf), right = FALSE,
labels = c("< small", "small", "medium", "large")))
}
# ---- 条件の 3 ペア（差 = 右 − 左） ----
pairs_list <- list(c("Control", "Model text"), c("Control", "AI-WCF"),
c("Model text", "AI-WCF"))
# 1 変数について 3 ペアの d [95% CI] と Holm 補正 p を返す
# 使い方：pairwise_d(dat, "Boredom") → Control vs Model text などの比較表
pairwise_d <- function(data, var) {
# 条件を説明変数にした回帰（= 一元配置分散分析）
m <- lm(as.formula(paste(var, "~ condition")), data = data)
# 3 ペアの平均差の検定（Holm 補正）
pw <- emmeans(m, revpairwise ~ condition, adjust = "holm")$contrasts %>%
as.data.frame() %>%
mutate(contrast = gsub("[()]", "", as.character(contrast)))
map_dfr(pairs_list, function(pr) {
x <- data[[var]][data$condition == pr[1]]
y <- data[[var]][data$condition == pr[2]]
# Cohen's d（右側の条件 − 左側の条件）と 95% CI
es <- effectsize::cohens_d(y, x)
lab <- paste(pr[2], "-", pr[1])
p <- pw$p.value[pw$contrast == lab]
tibble(Comparison = paste(pr[1], "vs", pr[2]),
Diff = mean(y) - mean(x),
d = es$Cohens_d, d_low = es$CI_low, d_high = es$CI_high,
p_holm = p)
})
}
# ---- 図表の書き出し先（Knit のたびに上書き） ----
out_dir <- "output"
fig_dir <- file.path(out_dir, "figures")
tab_dir <- file.path(out_dir, "tables")
# フォルダがなければ作る
dir.create(fig_dir, recursive = TRUE, showWarnings = FALSE)
dir.create(tab_dir, recursive = TRUE, showWarnings = FALSE)
tab_store <- list() # 全表をまとめて Excel / Word に書き出すために保持
# 図：チャンクオプション save_fig = "ファイル名" を付けると PNG (300 dpi) と PDF を保存
# チャンクの最後に描いた ggplot を、チャンクと同じ大きさで保存する仕組み
knitr::knit_hooks$set(save_fig = function(before, options) {
if (!before) {
p <- ggplot2::last_plot()
for (ext in c("png", "pdf")) {
ggsave(file.path(fig_dir, paste0(options$save_fig, ".", ext)), plot = p,
width = options$fig.width, height = options$fig.height,
dpi = 300, bg = "white", device = if (ext == "pdf") cairo_pdf else NULL)
}
}
})
# Word 用の表（APA 風：横罫のみ；欧文 Times New Roman、和文 游明朝）
word_font <- function(...) officer::fp_text_lite(font.family = "Times New Roman",
eastasia.family = "Yu Mincho", ...)
# データフレームを Word 用の表（flextable）に変換する
make_ft <- function(df) {
ft <- flextable::flextable(df) %>%
flextable::theme_booktabs() %>%
flextable::font(fontname = "Times New Roman", part = "all",
eastasia.family = "Yu Mincho") %>%
flextable::fontsize(size = 9, part = "all") %>%
flextable::bold(part = "header") %>%
flextable::align(j = -1, align = "center", part = "all") %>%
flextable::padding(padding.top = 2, padding.bottom = 2, part = "all") %>%
flextable::merge_v(j = 1) %>% # 1 列目の同じ値は結合
flextable::valign(valign = "top", part = "body") %>%
flextable::fix_border_issues() %>%
flextable::autofit()
flextable::fit_to_width(ft, max_width = 6.5) # A4 縦の本文幅に収める
}
# Word 文書にキャプション → 表 → 注 の順で追加する
add_ft <- function(doc, caption, df, note = NULL) {
doc <- doc %>%
officer::body_add_fpar(officer::fpar(officer::ftext(caption, word_font(bold = TRUE, font.size = 11)))) %>%
flextable::body_add_flextable(make_ft(df), align = "left")
if (!is.null(note)) {
doc <- officer::body_add_fpar(doc, officer::fpar(
officer::ftext("Note. ", word_font(italic = TRUE, font.size = 9)),
officer::ftext(note, word_font(font.size = 9))))
}
officer::body_add_par(doc, "", style = "Normal")
}
# 表の共通スタイル（file を指定すると Word に保存し、まとめ用リストにも登録）
# 使い方：ktab(表, "表 1 …", file = "Table01_…") → HTML に表示し、Word にも保存
ktab <- function(df, caption, file = NULL, note = NULL, ...) {
if (!is.null(file)) {
df_out <- df %>% mutate(across(everything(), ~ ifelse(is.na(.x), "", as.character(.x))))
officer::read_docx() %>% add_ft(caption, df_out, note) %>%
print(target = file.path(tab_dir, paste0(file, ".docx")))
tab_store[[file]] <<- list(caption = caption, data = df_out, note = note)
}
kable(df, caption = caption, align = c("l", rep("c", ncol(df) - 1)), ...) %>%
kable_styling(full_width = FALSE, bootstrap_options = c("condensed", "hover"))
}1 研究の全体像
1.1 中心となるメッセージ
学習者が AI-WCF をどう感じるかは、AI という情報源ではなく、外部テキストと自分の作文を比較するという活動によって左右された。比較活動は、短期的なライティングの伸びを上乗せしなかった一方で、退屈さをやや高めた。感じ方は関与（engagement）と結びついていたことから、AI-WCF の設計では学習成果だけでなく、学習者の感じ方を考慮する必要がある。
1.2 条件
| 条件 | 振り返り活動 | 位置づけ |
|---|---|---|
| Control | 自分の作文を見直すのみ | 外部テキストなし |
| Model text | model text と自分の作文を比較 | 従来型の比較活動 |
| AI-WCF | AI によるフィードバックと自分の作文を比較 | 新しい比較活動 |
Model text 条件は、「AI という情報源の影響」と「比較という活動の影響」を切り分ける役割を持つ。振り返りには全条件で 10 分の制限時間を設けた。
1.3 リサーチクエスチョンと分析の対応
| RQ | 問い | 主な分析 | 図表 |
|---|---|---|---|
| 測定 | 尺度は信頼できるか | 信頼性（α・ω）。探索的因子分析は付録 G に参考として | 表 2、図 R1（付録 G：図 M1–M7、表 M1–M7） |
| RQ1 | 比較活動はライティングの伸びを高めるか | 線形混合モデル（Time × Condition）、効果量 d_av / d | 図 1・1b・S1、表 4–5・S1 |
| RQ2 | 比較活動はタスク後の感情に影響するか | 一元配置分散分析、対比較の d | 図 2–3、表 6–7 |
| RQ3 | 感情はライティングの伸びと関連するか／条件の効果を調整するか | 相関、調整効果モデル | 図 5・S2、表 9–10・S2 |
| 補足 | 感情は関与（engagement）と結びついているか | 相関、条件差 | 図 6–8、表 11–13 |
| 構成 | 論文全体の流れと主張の根拠 | 概念図、主張と根拠の対応、Engagement のまとめ | 図 P1–P2、表 P1–P2 |
報告方針： 1 群約 30 名のため、p 値だけでなく効果量と 95% 信頼区間を中心に報告する。効果量の解釈は L2 研究の基準（Plonsky & Oswald, 2014）に従う：群間 d = 0.40 / 0.70 / 1.00、群内 d = 0.60 / 1.00 / 1.40、r = .25 / .40 / .60（small / medium / large）。多重比較は Holm 法で補正する。
2 データと測定
2.1 データの読み込みと得点化
# Rmd と同じフォルダ（~/Desktop/writing_emotion）に置く
# 1 行目は尺度名の見出しなので読み飛ばし（skip = 1）、2 行目を列名として読む
dat_raw <- read_excel("writing_summary_new.xlsx", sheet = "data", skip = 1,
.name_repair = "minimal")
# 先頭 3 列は列名が空欄なので名前を付ける
names(dat_raw)[1:3] <- c("ID", "Class", "condition")
# 型の変換と、条件名・クラス名の表記をそろえる
dat <- dat_raw %>%
mutate(
ID = factor(ID),
Class = factor(dplyr::recode(Class, "水曜4限" = "Wed4")),
condition = factor(dplyr::recode(condition, "control" = "Control",
"model text" = "Model text", "ai-wcf" = "AI-WCF"),
levels = cond_levels),
Q19r = 6 - Q19, Q20r = 6 - Q20 # Task difficulty の逆転項目
)
# 感情（Suzuki & Nakamura）
emo_items <- list(
Enjoyment = paste0("Q", 1:4),
Pride = paste0("Q", 5:8),
Anxiety = c("Q9", "Q11"), # Q10・Q12 はスピーキング関連のため除外
Boredom = paste0("Q", 13:16),
Difficulty = c("Q17", "Q18", "Q19r", "Q20r")
)
# Engagement（Zare, 2023）
eng_items <- list(
Behavioral = paste0("Q", 21:25),
Cognitive = paste0("Q", 31:35),
Agentic = paste0("Q", 36:40),
Social = paste0("Q", 41:45)
)
# 各尺度の得点 = 項目の平均（1–5）
for (s in names(emo_items)) dat[[s]] <- rowMeans(dat[, emo_items[[s]]])
for (s in names(eng_items)) dat[[s]] <- rowMeans(dat[, eng_items[[s]]])
# 参考用の合成得点（付録 G の感度分析と、Engagement のまとめ表で使う）
# Enjoy_Bored = Enjoyment と逆転した Boredom の平均、Task_eng = Behavioral と Cognitive（Q34 を除く）の平均
dat$Enjoy_Bored <- (rowMeans(dat[, emo_items$Enjoyment]) + (6 - rowMeans(dat[, emo_items$Boredom]))) / 2
dat$Task_eng <- rowMeans(dat[, c(paste0("Q", 21:25), "Q31", "Q32", "Q33", "Q35")])
# 以降の分析でくり返し使う名前の一覧
emotions <- names(emo_items)
emo_label <- c(Enjoyment = "Enjoyment", Pride = "Pride", Anxiety = "Anxiety",
Boredom = "Boredom", Difficulty = "Task difficulty")
eng_main <- c("Behavioral", "Cognitive")除外項目： Anxiety の Q10（“worrying if my partner will understand my English”）と Q12（“nervous when speaking English”）はスピーキングに関する項目であり、ライティング課題には該当しないため、すべての分析から除外した。Engagement の Agentic・Social は教師や他の学生とのやりとりを問う項目で、個人で行う本タスクには合わないため参考扱いとした。Emotional engagement（Q26–30）は回答データがない。
2.2 参加者
# クラス × 条件ごとの人数を数え、横長の表にして合計行を付ける
dat %>% count(Class, condition) %>%
pivot_wider(names_from = condition, values_from = n) %>%
mutate(Total = rowSums(across(all_of(cond_levels)))) %>%
bind_rows(summarise(., Class = "Total", across(where(is.numeric), sum))) %>%
ktab("表 1 クラス × 条件の人数", file = "Table01_participants")| Class | Control | Model text | AI-WCF | Total |
|---|---|---|---|---|
| Mon3 | 6 | 5 | 6 | 17 |
| Thu3 | 6 | 4 | 6 | 16 |
| Thu4 | 7 | 6 | 8 | 21 |
| Wed3 | 5 | 7 | 5 | 17 |
| Wed4 | 7 | 8 | 4 | 19 |
| Total | 31 | 30 | 29 | 90 |
2.3 尺度と信頼性（表 2・図 R1）
尺度の扱い： 感情と関与の測定には、先行研究で因子構造が確認された尺度（Suzuki & Nakamura; Zare, 2023）を用い、下位尺度の定義に従って項目平均を得点とした。ただし、ライティング課題に合わない項目（スピーキングに関する Anxiety の Q10・Q12、教師・仲間とのやりとりを問う Agentic・Social）は、分析前に内容にもとづいて除外した。本研究の標本サイズ（N = 90）は因子構造を安定して推定するには十分でないため、構造の再検証は行わず、内的一貫性（α・ω）を報告する。参考として行った探索的因子分析の結果は付録 G に示す。
# 1 つの尺度について α、ω（2 項目なら Spearman–Brown）、平均・SD を計算する
rel_row <- function(name, items, domain) {
x <- dat[, items]
k <- length(items)
a <- psych::alpha(x)$total$raw_alpha
if (k >= 3) {
om <- suppressMessages(psych::omega(x, nfactors = 1, plot = FALSE))$omega.tot
rel2 <- sprintf("ω = %.2f", om)
} else {
r <- cor(x[[1]], x[[2]])
rel2 <- sprintf("r = %.2f, SB = %.2f", r, 2 * r / (1 + r))
}
tibble(Domain = domain, Scale = name, Items = paste(items, collapse = ", "),
k = k, alpha = sprintf("%.2f", a), `Other index` = rel2,
`M (SD)` = sprintf("%.2f (%.2f)", mean(dat[[name]]), sd(dat[[name]])))
}
# 全尺度の信頼性を 1 つの表にまとめて表示・保存
bind_rows(
imap_dfr(emo_items, ~ rel_row(.y, .x, "Emotion")),
imap_dfr(eng_items, ~ rel_row(.y, .x, "Engagement"))
) %>%
mutate(Scale = dplyr::recode(Scale, Difficulty = "Task difficulty"),
Items = str_replace_all(Items, "r", " (R)")) %>%
ktab("表 2 尺度の項目と信頼性（(R) = 逆転項目；SB = Spearman–Brown）", file = "Table02_reliability",
note = "Agentic・Social engagement は本タスクに合わないため参考扱い。") %>%
collapse_rows(columns = 1, valign = "top") %>%
row_spec(8:9, color = "#8a8a8a") %>%
footnote(general = "Agentic・Social engagement（灰色）は本タスクに合わないため参考扱い。")| Domain | Scale | Items | k | alpha | Other index | M (SD) |
|---|---|---|---|---|---|---|
| Emotion | Enjoyment | Q1, Q2, Q3, Q4 | 4 | 0.83 | ω = 0.83 | 2.74 (0.91) |
| Pride | Q5, Q6, Q7, Q8 | 4 | 0.75 | ω = 0.78 | 2.17 (0.79) | |
| Anxiety | Q9, Q11 | 2 | 0.64 | r = 0.47, SB = 0.64 | 3.68 (1.15) | |
| Boredom | Q13, Q14, Q15, Q16 | 4 | 0.75 | ω = 0.77 | 2.71 (0.92) | |
| Task difficulty | Q17, Q18, Q19 (R), Q20 (R) | 4 | 0.81 | ω = 0.82 | 4.20 (0.87) | |
| Engagement | Behavioral | Q21, Q22, Q23, Q24, Q25 | 5 | 0.65 | ω = 0.68 | 3.78 (0.71) |
| Cognitive | Q31, Q32, Q33, Q34, Q35 | 5 | 0.55 | ω = 0.61 | 3.56 (0.73) | |
| Agentic | Q36, Q37, Q38, Q39, Q40 | 5 | 0.62 | ω = 0.62 | 1.85 (0.68) | |
| Social | Q41, Q42, Q43, Q44, Q45 | 5 | 0.66 | ω = 0.71 | 2.03 (0.74) | |
| Note: | ||||||
| Agentic・Social engagement（灰色）は本タスクに合わないため参考扱い。 |
# 図 R1：各尺度の信頼性（α と ω／Spearman–Brown）を点で示す
rel_plot <- imap_dfr(c(emo_items, eng_items), function(items, s) {
x <- dat[, items] # その尺度の項目だけを取り出す
a <- psych::alpha(x)$total$raw_alpha # Cronbach の α
o <- if (length(items) >= 3) { # 3 項目以上は ω
suppressMessages(psych::omega(x, nfactors = 1, plot = FALSE))$omega.tot
} else { # 2 項目は Spearman–Brown 係数
r <- cor(x[[1]], x[[2]]); 2 * r / (1 + r)
}
tibble(Scale = s, Domain = ifelse(s %in% names(emo_items), "Emotion", "Engagement"),
Index = c("Cronbach's alpha", "Omega / Spearman-Brown"), Value = c(a, o))
}) %>%
mutate(Scale = dplyr::recode(Scale, Difficulty = "Task difficulty"),
Scale = factor(Scale, levels = rev(unique(Scale))),
Used = ifelse(Scale %in% c("Agentic", "Social"), "Not used", "Used"))
ggplot(rel_plot, aes(Value, Scale, shape = Index, colour = Used)) +
geom_vline(xintercept = .70, linetype = 2, colour = "grey50") + # 目安の .70
geom_point(size = 3, position = position_dodge(width = 0.5)) +
facet_grid(Domain ~ ., scales = "free_y", space = "free_y") +
scale_colour_manual(values = c("Used" = neutral_col, "Not used" = "#a8a8a3")) +
scale_x_continuous(limits = c(.4, 1), breaks = seq(.4, 1, .1)) +
labs(x = "Reliability", y = NULL, shape = NULL, colour = NULL,
caption = "Dashed line = .70") +
theme_report
2.4 記述統計
# 記述統計に載せる変数と表示名
desc_vars <- c(Pre_Total = "Writing (Pre)", Post_Total = "Writing (Post)",
Development = "Development (Post − Pre)",
emo_label,
Behavioral = "Behavioral engagement", Cognitive = "Cognitive engagement")
# 条件別と全体の M (SD) を計算して横長の表にする
dat %>%
select(condition, all_of(names(desc_vars))) %>%
pivot_longer(-condition, names_to = "var") %>%
bind_rows(mutate(., condition = "Total")) %>%
group_by(var, condition) %>%
summarise(v = sprintf("%.2f (%.2f)", mean(value), sd(value)), .groups = "drop") %>%
pivot_wider(names_from = condition, values_from = v) %>%
mutate(Variable = desc_vars[var]) %>%
arrange(match(var, names(desc_vars))) %>%
select(Variable, all_of(cond_levels), Total) %>%
ktab("表 3 条件別の記述統計：M (SD)", file = "Table03_descriptives") %>%
pack_rows("Writing", 1, 3) %>%
pack_rows("Emotion (1–5)", 4, 8) %>%
pack_rows("Engagement (1–5)", 9, 10) %>%
add_header_above(c(" " = 1, "n = 31" = 1, "n = 30" = 1, "n = 29" = 1, "N = 90" = 1))| Variable | Control | Model text | AI-WCF | Total |
|---|---|---|---|---|
| Writing | ||||
| Writing (Pre) | 12.74 (4.51) | 13.37 (4.71) | 12.83 (4.72) | 12.98 (4.60) |
| Writing (Post) | 14.45 (4.15) | 15.57 (2.88) | 15.72 (3.71) | 15.23 (3.63) |
| Development (Post − Pre) | 1.71 (3.29) | 2.20 (3.41) | 2.90 (4.22) | 2.26 (3.64) |
| Emotion (1–5) | ||||
| Enjoyment | 2.72 (0.87) | 2.88 (1.04) | 2.63 (0.81) | 2.74 (0.91) |
| Pride | 2.02 (0.82) | 2.20 (0.77) | 2.31 (0.78) | 2.17 (0.79) |
| Anxiety | 3.60 (1.32) | 3.52 (1.21) | 3.93 (0.85) | 3.68 (1.15) |
| Boredom | 2.43 (0.73) | 2.81 (0.92) | 2.91 (1.04) | 2.71 (0.92) |
| Task difficulty | 4.01 (0.99) | 4.37 (0.84) | 4.23 (0.73) | 4.20 (0.87) |
| Engagement (1–5) | ||||
| Behavioral engagement | 3.77 (0.80) | 3.87 (0.71) | 3.70 (0.61) | 3.78 (0.71) |
| Cognitive engagement | 3.45 (0.76) | 3.68 (0.64) | 3.55 (0.80) | 3.56 (0.73) |
3 RQ1：Writing development
問い： 外部テキストとの比較（Model text / AI-WCF）は、自分の作文の見直し（Control）よりもライティングを伸ばすか。
# Pre / Post を縦長に並べ替える（1 人 2 行）
long_total <- dat %>%
select(ID, Class, condition, Pre = Pre_Total, Post = Post_Total) %>%
pivot_longer(c(Pre, Post), names_to = "Time", values_to = "Score") %>%
mutate(Time = factor(Time, levels = c("Pre", "Post")))
# 線形混合モデル：時間 × 条件、個人とクラスをランダム効果に
m1 <- lmer(Score ~ Time * condition + (1 | ID) + (1 | Class), data = long_total)
# クラスの分散が 0 で推定できない場合はクラスを外す
if (isSingular(m1)) m1 <- lmer(Score ~ Time * condition + (1 | ID), data = long_total)
# Type III の F 検定（Satterthwaite の自由度）
a1 <- anova(m1, type = 3)
# 条件内の Pre → Post
# 各条件内の Post − Pre の差と 95% CI
within_ct <- emmeans(m1, revpairwise ~ Time | condition)$contrasts %>%
summary(infer = TRUE) %>% as.data.frame()
# 各条件内の効果量 d_av（対応のある d）
within_d <- map_dfr(cond_levels, function(cnd) {
d <- filter(dat, condition == cnd)
r <- repeated_measures_d(d$Post_Total, d$Pre_Total, method = "av")
tibble(condition = cnd, d = r$d_av, low = r$CI_low, high = r$CI_high)
})
rq1_within <- within_ct %>%
transmute(condition = as.character(condition), Diff = estimate,
CI = sprintf("[%.2f, %.2f]", lower.CL, upper.CL), p = p.value) %>%
left_join(within_d, by = "condition")
# 条件間の伸び（Development）
# 伸び（Post − Pre）の条件間の差 d
rq1_between <- pairwise_d(dat, "Development")
# 本文用の値
F_time <- a1["Time", ]; F_int <- a1["Time:condition", ]3.1 図 1 条件別の Pre / Post 得点
# 図 1：条件 × 時点ごとの平均と 95% CI
fig1_dat <- long_total %>%
group_by(condition, Time) %>%
summarise(M = mean(Score), n = n(),
CI = qt(.975, n - 1) * sd(Score) / sqrt(n), .groups = "drop")
# 条件ごとに少し横にずらして重なりを防ぐ
pd <- position_dodge(width = 0.15)
ggplot(fig1_dat, aes(Time, M, colour = condition, group = condition, shape = condition)) +
geom_line(linewidth = 0.9, position = pd) +
geom_errorbar(aes(ymin = M - CI, ymax = M + CI), width = 0.08,
linewidth = 0.6, position = pd) +
geom_point(size = 3, position = pd) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
scale_x_discrete(expand = expansion(add = 0.3)) +
labs(x = NULL, y = "Writing total score (M, 95% CI)", colour = NULL, shape = NULL) + # 条件名は凡例のみで示す
theme_report
3.2 表 4 線形混合モデル
# 表 4：混合モデルの F 検定の結果
tibble(Effect = c("Time", "Condition", "Time × Condition"),
`F` = sprintf("%.2f", a1$`F value`),
df = sprintf("%d, %.1f", a1$NumDF, a1$DenDF),
p = fmt_p(a1$`Pr(>F)`)) %>%
ktab("表 4 Writing total score：Time × Condition の線形混合モデル（Type III, Satterthwaite）", file = "Table04_RQ1_mixed_model",
note = "Score ~ Time × Condition + (1 | ID) + (1 | Class)") %>%
footnote(general = "Score ~ Time × Condition + (1 | ID) + (1 | Class)")| Effect | F | df | p |
|---|---|---|---|
| Time | 34.72 | 1, 87.0 | < .001 |
| Condition | 0.91 | 2, 83.4 | .406 |
| Time × Condition | 0.80 | 2, 87.0 | .454 |
| Note: | |||
| Score ~ Time × Condition + (1 | ID) + (1 | Class) |
3.3 表 5・図 1b 効果量：条件内の伸びと条件間の差
# 表 5：条件内の伸び（d_av）と条件間の差（d）を 1 つの表に
bind_rows(
rq1_within %>%
transmute(Comparison = paste0(condition, ": Pre → Post"),
`Diff [95% CI]` = sprintf("%.2f %s", Diff, CI),
`Effect size [95% CI]` = paste("d_av =", fmt_ci(d, low, high)),
p = fmt_p(p), `P&O` = po_label(d, "within")),
rq1_between %>%
transmute(Comparison = paste0("Development: ", Comparison),
`Diff [95% CI]` = sprintf("%.2f", Diff),
`Effect size [95% CI]` = paste("d =", fmt_ci(d, d_low, d_high)),
p = fmt_p(p_holm), `P&O` = po_label(d, "between"))
) %>%
ktab("表 5 RQ1 の効果量（P&O = Plonsky & Oswald, 2014 による解釈）", file = "Table05_RQ1_effect_sizes") %>%
pack_rows("条件内の変化（群内 d_av）", 1, 3) %>%
pack_rows("条件間の伸びの差（群間 d；差 = 右 − 左、p は Holm 補正）", 4, 6)| Comparison | Diff [95% CI] | Effect size [95% CI] | p | P&O |
|---|---|---|---|---|
| 条件内の変化（群内 d_av） | ||||
| Control: Pre → Post | 1.71 [0.41, 3.01] | d_av = 0.38 [0.12, 0.64] | .011 | < small |
| Model text: Pre → Post | 2.20 [0.87, 3.53] | d_av = 0.55 [0.24, 0.85] | .001 | < small |
| AI-WCF: Pre → Post | 2.90 [1.55, 4.24] | d_av = 0.66 [0.31, 1.02] | < .001 | small |
| 条件間の伸びの差（群間 d；差 = 右 − 左、p は Holm 補正） | ||||
| Development: Control vs Model text | 0.49 | d = 0.15 [-0.36, 0.65] | .932 | < small |
| Development: Control vs AI-WCF | 1.19 | d = 0.32 [-0.20, 0.82] | .635 | < small |
| Development: Model text vs AI-WCF | 0.70 | d = 0.18 [-0.33, 0.69] | .932 | < small |
# 図 1b：表 5 の効果量を図示（左：条件内の伸び d_av、右：条件間の差 d）
bind_rows(
rq1_within %>% transmute(Panel = "Within condition: Pre → Post (d_av)",
Label = condition, d, low, high, small = .60), # 群内の small = 0.60
rq1_between %>% transmute(Panel = "Between conditions: Development (d)",
Label = Comparison, d, low = d_low, high = d_high, small = .40) # 群間の small = 0.40
) %>%
mutate(Panel = factor(Panel, levels = unique(Panel)),
Label = factor(Label, levels = rev(unique(Label)))) %>%
ggplot(aes(d, Label)) +
geom_rect(aes(xmin = -small, xmax = small, ymin = -Inf, ymax = Inf), # small 未満の帯
fill = "grey93", inherit.aes = FALSE,
data = function(df) distinct(df, Panel, small)) +
geom_vline(xintercept = 0, linetype = 2, colour = "grey45") +
geom_pointrange(aes(xmin = low, xmax = high), colour = neutral_col, size = 0.5) +
facet_wrap(~ Panel, scales = "free_y") +
labs(x = "Effect size (95% CI); grey band = below small (Plonsky & Oswald, 2014)", y = NULL) +
theme_report
3.4 頑健性の確認（表 S1・図 S1）
# 頑健性の確認 1：Pre を統制した ANCOVA
m1b <- lm(Post_Total ~ Pre_Total + Class + condition, data = dat)
a1b <- car::Anova(m1b, type = 3)
# 頑健性の確認 2：下位得点ごとに同じ混合モデルを当てはめる
sub_res <- map_dfr(c("TA", "CC", "LR", "GRA"), function(cmp) {
d <- dat %>%
select(ID, condition, Pre = paste0("Pre_", cmp), Post = paste0("Post_", cmp)) %>%
pivot_longer(c(Pre, Post), names_to = "Time", values_to = "Score") %>%
mutate(Time = factor(Time, levels = c("Pre", "Post")))
a <- anova(lmer(Score ~ Time * condition + (1 | ID), data = d), type = 3)
tibble(Component = cmp,
`Time F (p)` = sprintf("%.2f (%s)", a["Time", "F value"], fmt_p(a["Time", "Pr(>F)"])),
`Time × Condition F (p)` = sprintf("%.2f (%s)", a["Time:condition", "F value"],
fmt_p(a["Time:condition", "Pr(>F)"])))
})
bind_rows(
tibble(Component = "Total (ANCOVA: Post ~ Pre + Class + Condition)",
`Time F (p)` = "—",
`Time × Condition F (p)` = sprintf("Condition: %.2f (%s)",
a1b["condition", "F value"],
fmt_p(a1b["condition", "Pr(>F)"]))),
sub_res
) %>%
ktab("表 S1 頑健性の確認：ANCOVA と下位得点（TA, CC, LR, GRA）", file = "TableS1_RQ1_robustness")| Component | Time F (p) | Time × Condition F (p) |
|---|---|---|
| Total (ANCOVA: Post ~ Pre + Class + Condition) | — | Condition: 1.61 (.206) |
| TA | 27.57 (< .001) | 0.83 (.442) |
| CC | 24.46 (< .001) | 1.47 (.235) |
| LR | 39.32 (< .001) | 0.70 (.499) |
| GRA | 27.70 (< .001) | 0.43 (.655) |
# 図 S1：下位得点（TA, CC, LR, GRA）ごとの Pre / Post 平均と 95% CI
dat %>%
select(ID, condition, starts_with("Pre_"), starts_with("Post_"), -Pre_Total, -Post_Total,
-Pre_Test_Time, -Post_Test_Time, -Pre_Test_words, -Post_Test_words) %>%
pivot_longer(-c(ID, condition), names_to = c("Time", "Component"), names_sep = "_",
values_to = "Score") %>% # 縦長に変換（Time × Component）
mutate(Time = factor(Time, levels = c("Pre", "Post")),
Component = factor(Component, levels = c("TA", "CC", "LR", "GRA"))) %>%
group_by(Component, condition, Time) %>%
summarise(M = mean(Score), CI = qt(.975, n() - 1) * sd(Score) / sqrt(n()), .groups = "drop") %>%
ggplot(aes(Time, M, colour = condition, group = condition, shape = condition)) +
geom_line(linewidth = 0.8, position = position_dodge(0.2)) +
geom_errorbar(aes(ymin = M - CI, ymax = M + CI), width = 0.1, position = position_dodge(0.2)) +
geom_point(size = 2.6, position = position_dodge(0.2)) +
facet_wrap(~ Component, nrow = 1) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
labs(x = NULL, y = "Subscore (M, 95% CI)", colour = NULL, shape = NULL) +
theme_report
RQ1 の答え： 3 条件すべてでライティング得点が伸びた（Time: F = 34.72, p < .001）。伸びの大きさは AI-WCF（d_av = 0.66）＞ Model text（0.55）＞ Control（0.38）の順だったが、条件間の差は有意ではなく（Time × Condition: F = 0.80, p = .454）、効果量も small 未満（d = 0.15–0.32）であった。1 回の介入では、比較活動による上乗せは確認されなかった。
4 RQ2：Emotion
問い： 比較活動は、タスク後の感情に影響するか。
# 各感情の条件差：一元配置分散分析、η²、Kruskal–Wallis（5 尺度で Holm 補正）
rq2_omni <- map_dfr(emotions, function(e) {
m <- lm(as.formula(paste(e, "~ condition")), data = dat)
a <- anova(m)
tibble(var = e, F = a$`F value`[1], df1 = a$Df[1], df2 = a$Df[2],
p = a$`Pr(>F)`[1],
eta2 = eta_squared(m, verbose = FALSE)$Eta2[1],
KW_p = kruskal.test(as.formula(paste(e, "~ condition")), data = dat)$p.value)
}) %>% mutate(p_holm = p.adjust(p, "holm"))
# 各感情の 3 ペア比較（d と Holm 補正 p）
rq2_pairs <- map_dfr(emotions, ~ pairwise_d(dat, .x) %>% mutate(var = .x, .before = 1))
bor <- filter(rq2_pairs, var == "Boredom")4.1 図 2 条件別の感情得点
# 図 2：感情を縦長にし、条件ごとの平均と 95% CI を計算
emo_long <- dat %>%
select(ID, condition, all_of(emotions)) %>%
pivot_longer(all_of(emotions), names_to = "var", values_to = "Score") %>%
mutate(Emotion = factor(emo_label[var], levels = emo_label))
emo_sum <- emo_long %>%
group_by(Emotion, condition) %>%
summarise(M = mean(Score), CI = qt(.975, n() - 1) * sd(Score) / sqrt(n()),
.groups = "drop")
ggplot(emo_long, aes(condition, Score, colour = condition)) +
geom_jitter(width = 0.15, height = 0.06, alpha = 0.25, size = 1) +
geom_errorbar(data = emo_sum, aes(y = M, ymin = M - CI, ymax = M + CI),
width = 0.2, linewidth = 0.7) +
geom_point(data = emo_sum, aes(y = M, shape = condition), size = 3.2) +
facet_wrap(~ Emotion, nrow = 1) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
scale_y_continuous(limits = c(0.9, 5.1), breaks = 1:5) +
labs(x = NULL, y = "Scale mean (1–5): M, 95% CI", colour = NULL, shape = NULL) +
theme_report + theme(text = element_text(size = 15),
axis.text.x = element_text(angle = 35, hjust = 1, size = 12))
4.2 表 6 感情の条件差（全体検定）
# 表 6：全体検定の結果
rq2_omni %>%
transmute(Emotion = emo_label[var],
`F (2, 87)` = sprintf("%.2f", F), p = fmt_p(p),
`p (Holm)` = fmt_p(p_holm),
`η²` = sprintf("%.3f", eta2),
`Kruskal–Wallis p` = fmt_p(KW_p)) %>%
ktab("表 6 感情尺度の条件差：一元配置分散分析（Holm 補正は 5 尺度）", file = "Table06_RQ2_omnibus")| Emotion | F (2, 87) | p | p (Holm) | η² | Kruskal–Wallis p |
|---|---|---|---|---|---|
| Enjoyment | 0.59 | .557 | 1.000 | 0.013 | .696 |
| Pride | 1.07 | .348 | 1.000 | 0.024 | .277 |
| Anxiety | 1.07 | .347 | 1.000 | 0.024 | .507 |
| Boredom | 2.38 | .098 | .492 | 0.052 | .142 |
| Task difficulty | 1.35 | .265 | 1.000 | 0.030 | .203 |
4.3 表 7・図 3 条件間の対比較
# 表 7：対比較の結果（Boredom の Control との比較を太字）
rq2_pairs %>%
transmute(Emotion = emo_label[var], Comparison,
Diff = sprintf("%.2f", Diff),
`d [95% CI]` = fmt_ci(d, d_low, d_high),
`p (Holm)` = fmt_p(p_holm),
`P&O` = po_label(d, "between")) %>%
ktab("表 7 感情の条件間比較（差・d = 右 − 左；Holm 補正は尺度ごとに 3 比較）", file = "Table07_RQ2_pairwise") %>%
collapse_rows(columns = 1, valign = "top") %>%
row_spec(which(rq2_pairs$var == "Boredom" & rq2_pairs$Comparison != "Model text vs AI-WCF"),
bold = TRUE)| Emotion | Comparison | Diff | d [95% CI] | p (Holm) | P&O |
|---|---|---|---|---|---|
| Enjoyment | Control vs Model text | 0.17 | 0.17 [-0.33, 0.67] | .963 | < small |
| Control vs AI-WCF | -0.09 | -0.10 [-0.61, 0.40] | .963 | < small | |
| Model text vs AI-WCF | -0.25 | -0.27 [-0.78, 0.24] | .867 | < small | |
| Pride | Control vs Model text | 0.18 | 0.23 [-0.27, 0.73] | .732 | < small |
| Control vs AI-WCF | 0.29 | 0.37 [-0.14, 0.88] | .458 | < small | |
| Model text vs AI-WCF | 0.11 | 0.14 [-0.37, 0.65] | .732 | < small | |
| Anxiety | Control vs Model text | -0.08 | -0.06 [-0.56, 0.44] | .787 | < small |
| Control vs AI-WCF | 0.33 | 0.30 [-0.21, 0.81] | .528 | < small | |
| Model text vs AI-WCF | 0.41 | 0.39 [-0.12, 0.91] | .511 | < small | |
| Boredom | Control vs Model text | 0.38 | 0.46 [-0.05, 0.97] | .205 | small |
| Control vs AI-WCF | 0.48 | 0.54 [0.02, 1.05] | .130 | small | |
| Model text vs AI-WCF | 0.10 | 0.10 [-0.41, 0.61] | .681 | < small | |
| Task difficulty | Control vs Model text | 0.36 | 0.39 [-0.12, 0.90] | .325 | < small |
| Control vs AI-WCF | 0.22 | 0.26 [-0.25, 0.76] | .632 | < small | |
| Model text vs AI-WCF | -0.13 | -0.17 [-0.68, 0.34] | .632 | < small |
# 図 3：対比較の d と 95% CI（灰色の帯 = small 未満）
# 比較ペアは条件そのものではないので色を使わず、ペアごとにパネルを分ける
rq2_pairs %>%
mutate(Emotion = factor(emo_label[var], levels = rev(emo_label)),
Comparison = factor(Comparison, levels = map_chr(pairs_list, paste, collapse = " vs "))) %>%
ggplot(aes(d, Emotion)) +
annotate("rect", xmin = -0.40, xmax = 0.40, ymin = -Inf, ymax = Inf, fill = "grey92") +
geom_vline(xintercept = 0, linetype = 2, colour = "grey45") +
geom_pointrange(aes(xmin = d_low, xmax = d_high), colour = neutral_col, size = 0.45) +
facet_wrap(~ Comparison) +
labs(x = "Cohen's d (95% CI); + = right-hand condition higher\nGrey band = below small (|d| < 0.40; Plonsky & Oswald, 2014)",
y = NULL) +
theme_report
RQ2 の答え： 補正後に有意な条件差を示した感情はなかった。ただし Boredom は、Model text（d = 0.46）と AI-WCF（d = 0.54 [0.02, 1.05]）の両方で Control より高く（small）、2 つの比較群の間にはほとんど差がなかった（d = 0.10）。感じ方に影響したのは AI という情報源ではなく、比較という活動であった。
5 RQ3：Writing development × Emotion
問い： 感情はライティングの伸びと関連するか。また、感情によって条件の効果は変わるか（調整効果）。
# 感情と伸び（Post − Pre）の相関：全体（95% CI 付き）と条件内
rq3_cor <- map_dfr(emotions, function(e) {
ct <- cor.test(dat[[e]], dat$Development)
wc <- sapply(cond_levels, function(cnd) {
sel <- dat$condition == cnd
cor(dat[[e]][sel], dat$Development[sel])
})
tibble(var = e, r = unname(ct$estimate), low = ct$conf.int[1],
high = ct$conf.int[2], p = ct$p.value,
Control = wc["Control"], `Model text` = wc["Model text"], `AI-WCF` = wc["AI-WCF"])
})
# 交互作用を解釈しやすくするため、感情得点を平均で中心化（_c）
dat <- dat %>% mutate(across(all_of(emotions), ~ .x - mean(.x), .names = "{.col}_c"))
# 調整効果モデル：Post ~ Pre + Class + 条件 × 感情
rq3_mod <- map_dfr(emotions, function(e) {
# 主効果：交互作用なしのモデル／交互作用：交互作用ありのモデル
m0 <- lm(as.formula(paste0("Post_Total ~ Pre_Total + Class + condition + ", e, "_c")),
data = dat)
m <- lm(as.formula(paste0("Post_Total ~ Pre_Total + Class + condition * ", e, "_c")),
data = dat)
a0 <- car::Anova(m0, type = 2)
a <- car::Anova(m, type = 3)
tibble(var = e,
F_main = a0[paste0(e, "_c"), "F value"], p_main = a0[paste0(e, "_c"), "Pr(>F)"],
F_int = a[paste0("condition:", e, "_c"), "F value"],
p_int = a[paste0("condition:", e, "_c"), "Pr(>F)"],
df_res = a["Residuals", "Df"])
}) %>% mutate(p_main_holm = p.adjust(p_main, "holm"),
p_int_holm = p.adjust(p_int, "holm"))5.1 表 9 感情とライティングの伸びの相関
# 表 9：感情と伸びの相関
rq3_cor %>%
transmute(Emotion = emo_label[var],
`r [95% CI]` = paste(fmt_r(r), sprintf("[%s, %s]", fmt_r(low), fmt_r(high))),
p = fmt_p(p), `P&O` = po_label(r, "r"),
Control = fmt_r(Control), `Model text` = fmt_r(`Model text`),
`AI-WCF` = fmt_r(`AI-WCF`)) %>%
ktab("表 9 感情 × Development（Post − Pre）の相関", file = "Table09_RQ3_correlations") %>%
add_header_above(c(" " = 1, "Overall (N = 90)" = 3, "Within-condition r" = 3))| Emotion | r [95% CI] | p | P&O | Control | Model text | AI-WCF |
|---|---|---|---|---|---|---|
| Enjoyment | -.14 [-.34, .07] | .177 | < small | -.21 | -.18 | -.04 |
| Pride | -.15 [-.35, .06] | .155 | < small | .04 | -.38 | -.20 |
| Anxiety | .15 [-.06, .34] | .163 | < small | .06 | .25 | .12 |
| Boredom | .11 [-.10, .31] | .301 | < small | .22 | .14 | -.03 |
| Task difficulty | .01 [-.20, .21] | .956 | < small | -.13 | .14 | -.00 |
5.2 図 5 感情と伸びの散布図
# 図 5：感情と伸びの散布図（黒線 = 全体の回帰直線）
dat %>%
pivot_longer(all_of(emotions), names_to = "var", values_to = "Score") %>%
mutate(Emotion = factor(emo_label[var], levels = emo_label)) %>%
ggplot(aes(Score, Development)) +
geom_hline(yintercept = 0, colour = "grey70") +
geom_jitter(aes(colour = condition, shape = condition),
width = 0.06, height = 0.15, alpha = 0.6, size = 1.6) +
geom_smooth(method = "lm", colour = "grey20", fill = "grey80", linewidth = 0.8) +
facet_wrap(~ Emotion, nrow = 1) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
labs(x = "Emotion score (1–5)", y = "Development (Post − Pre)",
colour = NULL, shape = NULL) +
theme_report + theme(text = element_text(size = 15)) +
guides(colour = guide_legend(override.aes = list(size = 3, alpha = 1)))
5.3 表 10 調整効果モデル
# 表 10：感情の主効果と、条件 × 感情の交互作用
rq3_mod %>%
transmute(Emotion = emo_label[var],
`Emotion: F (p)` = sprintf("%.2f (%s)", F_main, fmt_p(p_main)),
`Emotion: p (Holm)` = fmt_p(p_main_holm),
`Condition × Emotion: F (p)` = sprintf("%.2f (%s)", F_int, fmt_p(p_int)),
`Condition × Emotion: p (Holm)` = fmt_p(p_int_holm)) %>%
ktab("表 10 Post ~ Pre + Class + Condition × Emotion（感情は中心化）", file = "Table10_RQ3_moderation",
note = "Emotion の主効果は交互作用を含まないモデル（df = 1）、Condition × Emotion は交互作用モデル（Type III, df = 2）で検定。Holm 補正は項ごとに 5 尺度。") %>%
footnote(general = "Emotion の主効果は交互作用を含まないモデル（df = 1）、Condition × Emotion は交互作用モデル（Type III, df = 2）で検定。Holm 補正は項ごとに 5 尺度。")| Emotion | Emotion: F (p) | Emotion: p (Holm) | Condition × Emotion: F (p) | Condition × Emotion: p (Holm) |
|---|---|---|---|---|
| Enjoyment | 0.02 (.891) | 1.000 | 0.50 (.610) | 1.000 |
| Pride | 0.44 (.509) | 1.000 | 2.43 (.095) | .474 |
| Anxiety | 0.05 (.821) | 1.000 | 0.30 (.741) | 1.000 |
| Boredom | 0.01 (.906) | 1.000 | 0.02 (.982) | 1.000 |
| Task difficulty | 0.57 (.454) | 1.000 | 0.67 (.512) | 1.000 |
| Note: | ||||
| Emotion の主効果は交互作用を含まないモデル（df = 1）、Condition × Emotion は交互作用モデル（Type III, df = 2）で検定。Holm 補正は項ごとに 5 尺度。 |
探索的な知見： Pride の交互作用は未補正で p = .095 だった（補正後 p = .474）。条件別の傾きは以下の通り。結論には用いず、Discussion で触れる程度にとどめる。
# 探索的：条件ごとの Pride → Post の傾き（simple slopes）
m_pride <- lm(Post_Total ~ Pre_Total + Class + condition * Pride_c, data = dat)
emtrends(m_pride, ~ condition, var = "Pride_c") %>%
summary(infer = TRUE) %>% as.data.frame() %>%
transmute(Condition = condition,
`Slope [95% CI]` = fmt_ci(Pride_c.trend, lower.CL, upper.CL),
p = fmt_p(p.value)) %>%
ktab("表 S2 条件別の Pride → Post の傾き（Pre・Class 統制）", file = "TableS2_RQ3_pride_slopes")| Condition | Slope [95% CI] | p |
|---|---|---|
| Control | 1.25 [0.04, 2.46] | .044 |
| Model text | 0.05 [-1.28, 1.39] | .937 |
| AI-WCF | -0.64 [-1.93, 0.65] | .324 |
# 図 S2：条件別に、Pride の高さに応じた Post 得点の予測値（Pre・Class は平均で固定）
pride_grid <- seq(min(dat$Pride_c), max(dat$Pride_c), length.out = 30) # Pride（中心化）の範囲
emmeans(m_pride, ~ Pride_c | condition, at = list(Pride_c = pride_grid)) %>%
as.data.frame() %>%
mutate(Pride = Pride_c + mean(dat$Pride)) %>% # 元の尺度に戻す
ggplot(aes(Pride, emmean, colour = condition, fill = condition)) +
geom_ribbon(aes(ymin = lower.CL, ymax = upper.CL), alpha = 0.12, colour = NA) +
geom_line(aes(linetype = condition), linewidth = 1) +
scale_colour_manual(values = cond_cols) +
scale_fill_manual(values = cond_cols) +
labs(x = "Pride (1–5)", y = "Predicted Post score (95% CI)",
colour = NULL, fill = NULL, linetype = NULL,
caption = "Adjusted for Pre score and class; exploratory") +
theme_report
RQ3 の答え： どの感情もライティングの伸びと関連しなかった（|r| ≤ 0.15、すべて small 未満）。感情によって条件の効果が変わることもなかった（補正後 p ≥ .474）。比較活動で高まった退屈さは、短期的な学習成果を損なっていなかった。
6 補足：Emotion と Engagement
問い： 感じ方は、どれだけ関与したか（engagement）と結びついているか。また、関与は条件や伸びと関連するか。RQ2・RQ3 の解釈を支える補足分析として位置づける。
# Engagement の条件差（一元配置分散分析と η²）
eng_omni <- map_dfr(eng_main, function(v) {
m <- lm(as.formula(paste(v, "~ condition")), data = dat)
a <- anova(m)
tibble(var = v, F = a$`F value`[1], p = a$`Pr(>F)`[1],
eta2 = eta_squared(m, verbose = FALSE)$Eta2[1])
})
# Engagement の 3 ペア比較（d）
eng_pairs <- map_dfr(eng_main, ~ pairwise_d(dat, .x) %>% mutate(var = .x, .before = 1))
# 感情 × engagement の相関（10 個、Holm 補正）
ee <- expand_grid(var = emotions, eng = eng_main) %>%
mutate(test = map2(var, eng, ~ cor.test(dat[[.x]], dat[[.y]])),
r = map_dbl(test, ~ unname(.x$estimate)),
low = map_dbl(test, ~ .x$conf.int[1]),
high = map_dbl(test, ~ .x$conf.int[2]),
p = map_dbl(test, "p.value")) %>%
select(-test) %>%
mutate(p_holm = p.adjust(p, "holm"))
# 同じ相関を条件ごとに計算し、最小〜最大を示す
ee_within <- expand_grid(var = emotions, eng = eng_main) %>%
mutate(rng = map2_chr(var, eng, function(e, g) {
rs <- sapply(cond_levels, function(cnd) {
sel <- dat$condition == cnd
cor(dat[[e]][sel], dat[[g]][sel])
})
sprintf("%s to %s", fmt_r(min(rs)), fmt_r(max(rs)))
}))
# Engagement と伸び：単純相関と、Pre・Class を統制したモデル
eng_dev <- map_dfr(eng_main, function(v) {
m0 <- lm(as.formula(paste0("Post_Total ~ Pre_Total + Class + condition + scale(", v, ")")),
data = dat)
m <- lm(as.formula(paste0("Post_Total ~ Pre_Total + Class + condition * scale(", v, ")")),
data = dat)
a0 <- car::Anova(m0, type = 2)
a <- car::Anova(m, type = 3)
tibble(var = v,
r_dev = cor(dat[[v]], dat$Development), p_dev = cor.test(dat[[v]], dat$Development)$p.value,
r_pre = cor(dat[[v]], dat$Pre_Total), p_pre = cor.test(dat[[v]], dat$Pre_Total)$p.value,
p_main = a0[paste0("scale(", v, ")"), "Pr(>F)"],
p_int = a[paste0("condition:scale(", v, ")"), "Pr(>F)"])
})6.1 表 11・図 7 Engagement の条件差
# 表 11：条件別の M (SD) と条件差
dat %>% group_by(condition) %>%
summarise(across(all_of(eng_main), ~ sprintf("%.2f (%.2f)", mean(.x), sd(.x)))) %>%
pivot_longer(-condition, names_to = "var") %>%
pivot_wider(names_from = condition, values_from = value) %>%
left_join(eng_omni, by = "var") %>%
left_join(eng_pairs %>% group_by(var) %>%
summarise(`d range` = sprintf("%.2f to %.2f", min(d), max(d))), by = "var") %>%
transmute(Engagement = var, !!!syms(cond_levels),
`F (2, 87)` = sprintf("%.2f", F), p = fmt_p(p),
`η²` = sprintf("%.3f", eta2), `Pairwise d` = `d range`) %>%
ktab("表 11 Engagement の条件別 M (SD) と条件差", file = "Table11_engagement_condition")| Engagement | Control | Model text | AI-WCF | F (2, 87) | p | η² | Pairwise d |
|---|---|---|---|---|---|---|---|
| Behavioral | 3.77 (0.80) | 3.87 (0.71) | 3.70 (0.61) | 0.46 | .633 | 0.010 | -0.27 to 0.13 |
| Cognitive | 3.45 (0.76) | 3.68 (0.64) | 3.55 (0.80) | 0.75 | .478 | 0.017 | -0.18 to 0.33 |
# 図 7：条件別の engagement（個人の値＋平均と 95% CI）
eng_long <- dat %>%
select(ID, condition, all_of(eng_main)) %>%
pivot_longer(all_of(eng_main), names_to = "Engagement", values_to = "Score")
eng_sum <- eng_long %>%
group_by(Engagement, condition) %>%
summarise(M = mean(Score), CI = qt(.975, n() - 1) * sd(Score) / sqrt(n()), .groups = "drop")
ggplot(eng_long, aes(condition, Score, colour = condition)) +
geom_jitter(width = 0.15, height = 0.05, alpha = 0.25, size = 1.2) + # 個人の値
geom_errorbar(data = eng_sum, aes(y = M, ymin = M - CI, ymax = M + CI), width = 0.2, linewidth = 0.7) +
geom_point(data = eng_sum, aes(y = M, shape = condition), size = 3.2) + # 平均
facet_wrap(~ Engagement) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
scale_y_continuous(limits = c(0.9, 5.1), breaks = 1:5) +
labs(x = NULL, y = "Scale mean (1–5): M, 95% CI", colour = NULL, shape = NULL) +
theme_report + theme(legend.position = "none")
6.2 図 6・表 12 感情と engagement の相関
# 図 6：感情 × engagement の相関のヒートマップ（* = Holm 補正後 p < .05）
ee %>%
mutate(Emotion = factor(emo_label[var], levels = rev(emo_label)),
lab = paste0(fmt_r(r), ifelse(p_holm < .05, "*", ""))) %>%
ggplot(aes(eng, Emotion, fill = r)) +
geom_tile(colour = "white", linewidth = 1.5) +
geom_text(aes(label = lab), size = 4.5, colour = "grey10") +
scale_fill_gradient2(low = div_low, mid = div_mid, high = div_high,
midpoint = 0, limits = c(-0.6, 0.6)) +
labs(x = NULL, y = NULL, fill = "r",
caption = "* p < .05 (Holm, 10 correlations)") +
theme_report + theme(panel.grid = element_blank(), legend.position = "right")
# 表 12：感情 × engagement の相関（全体と条件内の範囲）
ee %>% left_join(ee_within, by = c("var", "eng")) %>%
transmute(Emotion = emo_label[var], Engagement = eng,
`r [95% CI]` = paste(fmt_r(r), sprintf("[%s, %s]", fmt_r(low), fmt_r(high))),
`p (Holm)` = fmt_p(p_holm), `P&O` = po_label(r, "r"),
`Within-condition r` = rng) %>%
ktab("表 12 感情 × engagement の相関（全体 N = 90 と条件内の範囲）", file = "Table12_emotion_engagement") %>%
collapse_rows(columns = 1, valign = "top")| Emotion | Engagement | r [95% CI] | p (Holm) | P&O | Within-condition r |
|---|---|---|---|---|---|
| Enjoyment | Behavioral | .40 [.21, .56] | < .001 | medium | .31 to .52 |
| Cognitive | .44 [.26, .59] | < .001 | medium | .28 to .59 | |
| Pride | Behavioral | .47 [.29, .61] | < .001 | medium | .38 to .60 |
| Cognitive | .39 [.20, .56] | < .001 | small | .30 to .54 | |
| Anxiety | Behavioral | .06 [-.14, .27] | 1.000 | < small | -.14 to .30 |
| Cognitive | -.00 [-.21, .21] | 1.000 | < small | -.14 to .15 | |
| Boredom | Behavioral | -.38 [-.54, -.18] | .001 | small | -.48 to -.34 |
| Cognitive | -.36 [-.52, -.16] | .002 | small | -.56 to -.25 | |
| Task difficulty | Behavioral | .44 [.26, .59] | < .001 | medium | .34 to .55 |
| Cognitive | .30 [.10, .48] | .012 | small | .24 to .38 |
6.3 表 13・図 8 Engagement とライティングの伸び
# 表 13：engagement と伸び
eng_dev %>%
transmute(Engagement = var,
`r (Development)` = sprintf("%s (p %s)", fmt_r(r_dev), fmt_p_eq(p_dev)),
`r (Pre)` = sprintf("%s (p %s)", fmt_r(r_pre), fmt_p_eq(p_pre)),
`Engagement p` = fmt_p(p_main),
`Condition × Eng. p` = fmt_p(p_int)) %>%
ktab("表 13 Engagement と伸び：単純相関と Pre・Class 統制モデル", file = "Table13_engagement_development",
note = "Cognitive と伸びの負の単純相関は、Pre 得点の高い学習者ほど関与が高く伸びしろが小さいことによる見かけの関連と考えられる（Pre 統制後は有意でない）。") %>%
add_header_above(c(" " = 1, "単純相関" = 2, "Post ~ Pre + Class + Condition × Eng." = 2)) %>%
footnote(general = "Cognitive と伸びの負の単純相関は、Pre 得点の高い学習者ほど関与が高く伸びしろが小さいことによる見かけの関連と考えられる（Pre 統制後は有意でない）。")| Engagement | r (Development) | r (Pre) | Engagement p | Condition × Eng. p |
|---|---|---|---|---|
| Behavioral | -.12 (p = .251) | .18 (p = .089) | .558 | .977 |
| Cognitive | -.23 (p = .028) | .34 (p < .001) | .991 | .117 |
| Note: | ||||
| Cognitive と伸びの負の単純相関は、Pre 得点の高い学習者ほど関与が高く伸びしろが小さいことによる見かけの関連と考えられる（Pre 統制後は有意でない）。 |
# 図 8：engagement と伸び（Post − Pre）の散布図（黒線 = 全体の回帰直線）
dat %>%
pivot_longer(all_of(eng_main), names_to = "Engagement", values_to = "Score") %>%
ggplot(aes(Score, Development)) +
geom_hline(yintercept = 0, colour = "grey70") +
geom_jitter(aes(colour = condition, shape = condition),
width = 0.04, height = 0.15, alpha = 0.6, size = 1.8) +
geom_smooth(method = "lm", formula = y ~ x, colour = "grey20", fill = "grey80", linewidth = 0.8) +
facet_wrap(~ Engagement) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
labs(x = "Engagement score (1–5)", y = "Development (Post − Pre)", colour = NULL, shape = NULL) +
theme_report
補足分析の答え： Engagement に条件差はなかった（比較活動をしても、自己評価の関与は Control と同程度）。一方、感じ方は関与と明確に結びついていた：Enjoyment・Pride・Task difficulty が高いほど関与が高く（r = .30–.47）、Boredom が高いほど関与が低かった（Behavioral r = -.38、Cognitive r = -.36）。この関連は 3 条件それぞれの中でも見られた。関与は Pre を統制すると伸びと関連しなかった。
7 総合：RQ に沿ったストーリー
7.1 結果と解釈の対応
| RQ | 結果 | 解釈 |
|---|---|---|
| RQ1 | 3 条件とも伸びたが、条件差は small 未満 | 1 回の介入では、比較活動による上乗せはない |
| RQ2 | Boredom は比較群で高め（Control 比 d ≈ 0.5）。Model text と AI-WCF はほぼ同じ | 感じ方を左右したのは AI ではなく比較という活動。Control-value theory の観点では、比較活動の価値（value）が低く評価された可能性 |
| 補足 | 感じ方と関与が結びつく（Enjoyment・Pride・Difficulty ↑、Boredom ↓） | 退屈さは関与の低さと結びつく。手応え（difficulty）は不安ではなく関与につながっていた |
| RQ3 | 感情は伸びと関連せず、条件の効果も調整しない | 退屈さは短期の成果を損なっていない。ただし関与と結びつくため、繰り返し使う中では無視できない |
7.2 ストーリーの流れ
- 背景： WCF の効果は学習者がどう関わるかに左右される。そのうち「どう感じるか」は関与の継続を左右しうるが、AI-WCF ではほとんど検討されていない。
- RQ1： 比較活動（Model text・AI-WCF）は、自分の作文の見直し以上の伸びをもたらさなかった。
- RQ2： 感じ方は AI かどうかではなく活動で変わった。比較活動では、AI でも Model text でも退屈さがやや高まった。
- 補足： 感じ方は関与と結びついていた。
- RQ3： 1 回の介入では、感情も関与も伸びには表れなかった。
- 示唆： AI-WCF を導入するときは、学習者が比較活動に価値を感じられる設計（目的の明示、比較の観点の焦点化、所要時間の調整など）が必要である。
7.3 限界
- 評価（appraisal）を測定していない： Control-value theory のコントロール感・価値は直接測定しておらず、解釈の枠組みとして用いている。
- 活動と時間の交絡： 制限時間（10 分）は全条件で同じだったが、比較条件では実際に長い時間をかけていた（付録 F）。Boredom の原因が活動か時間かは区別できない。
- 練習効果： Control も伸びているため、Pre → Post の伸びには練習やテストへの慣れが含まれうる。
- 測定時点： 感情・関与はタスク後の 1 回のみで、因果の向きは特定できない。
- 信頼性： Anxiety（2 項目、SB = .64）、Cognitive engagement（α = .55）の信頼性が低い。
- 尺度の構造： 本研究のデータでは因子構造を確認していない（N = 90）。参考として行った探索的因子分析では Enjoyment と Boredom が 1 因子にまとまり、両者をまとめた得点では Boredom の条件差が弱まった（付録 G）。より大きな標本での確認的因子分析が今後の課題である。
- サンプルサイズ： 1 群約 30 名で、小さな差を検出する検出力は限られる。
8 論文の構成案と主要図表
論文全体を「条件 → 感じ方（emotion）→ 関与（engagement）→ ライティングの伸び」の流れで組み立てる。Engagement は RQ を増やさず、RQ2 と RQ3 の間に置く補足分析として扱う。
# 図 P1・表 P1 に埋め込む数値をまとめて計算する
rq1_rng <- range(rq1_between$d) # RQ1：伸びの条件差 d の範囲
eng_dmax <- max(abs(eng_pairs$d)) # 関与の条件差 |d| の最大
pos_rng <- range(ee$r[ee$var %in% c("Enjoyment", "Pride", "Difficulty")]) # 正の相関の範囲
bor_rng <- range(ee$r[ee$var == "Boredom"]) # Boredom と関与の相関
emo_dev <- max(abs(rq3_cor$r)) # 感情と伸びの相関 |r| の最大
eng_dev_p <- min(eng_dev$p_main) # 関与 → 伸び（Pre 統制）の p の最小8.1 図 P1 分析の全体像（概念図と結果）
# 図 P1：4 つのボックス（条件・感情・関与・伸び）と、それぞれの経路の結果を 1 枚にまとめる
# 実線 = 関連あり、点線 = 関連なし（small 未満または有意でない）
boxes <- tibble(
id = c("cond", "emo", "eng", "dev"),
x = c(0, 4, 4, 8),
y = c(2, 3.6, 0.4, 2),
label = c("Condition\nControl / Model text / AI-WCF",
"Emotion\n(enjoyment, pride, anxiety,\nboredom, task difficulty)",
"Engagement\n(behavioral, cognitive)",
"Writing development\n(Post − Pre)")
)
# 経路：始点・終点の座標、結果のラベル、関連の有無（ラベルの位置 lx, ly と寄せ方 hj）
paths <- tribble(
~x, ~y, ~xend, ~yend, ~supported, ~lab, ~lx, ~ly, ~hj,
0.9, 2.35, 2.9, 3.4, TRUE, sprintf("RQ2: boredom higher in both\ncomparison conditions (d = %.2f / %.2f);\nModel text vs AI-WCF d = %.2f", bor$d[1], bor$d[2], bor$d[3]), 1.35, 3.6, 0.5,
0.9, 1.65, 3.0, 0.6, FALSE, sprintf("No condition difference\n(|d| ≤ %.2f)", eng_dmax), 1.0, 0.55, 0.5,
5.1, 3.4, 7.15, 2.35, FALSE, sprintf("RQ3: |r| ≤ %.2f", emo_dev), 6.75, 3.25, 0.5,
5.0, 0.6, 7.15, 1.65, FALSE, sprintf("n.s. after controlling\nfor pretest (p ≥ %s)", fmt_p(eng_dev_p)), 6.8, 0.6, 0.5
)
# RQ1（条件 → 伸び）は、ほかの矢印と交差しないよう上を回り込む経路にする
rq1_path <- tibble(x = c(0, 0, 8, 8), y = c(2.32, 4.75, 4.75, 2.32))
rq1_lab <- sprintf("RQ1: all conditions improved, but no added gain (d = %.2f–%.2f, below small)",
rq1_rng[1], rq1_rng[2])
ggplot() +
# RQ1 の経路（関連なし：灰色の点線）
geom_path(data = rq1_path, aes(x, y), linetype = "22", colour = "#9a9a95", linewidth = 0.7,
arrow = arrow(length = unit(0.18, "cm"), type = "closed")) +
annotate("text", x = 4, y = 4.98, label = rq1_lab, size = 3.1, colour = "grey15") +
# その他の経路：関連ありは濃い実線、関連なしは灰色の点線
geom_segment(data = paths,
aes(x = x, y = y, xend = xend, yend = yend,
linetype = supported, colour = supported, linewidth = supported),
arrow = arrow(length = unit(0.18, "cm"), type = "closed", ends = "last")) +
# 感情 ↔ 関与は相関なので両方向の矢印
geom_segment(aes(x = 4, y = 0.85, xend = 4, yend = 3.15), colour = neutral_col, linewidth = 1.1,
arrow = arrow(length = unit(0.18, "cm"), type = "closed", ends = "both")) +
annotate("text", x = 4.2, y = 2, hjust = 0, size = 3.1, colour = "grey15", lineheight = 0.95,
label = sprintf("Linked: |r| = %s–%s\n(boredom r = %s / %s)",
fmt_r(pos_rng[1]), fmt_r(pos_rng[2]), fmt_r(bor_rng[1]), fmt_r(bor_rng[2]))) +
# 経路の結果ラベル
geom_text(data = paths, aes(x = lx, y = ly, label = lab, hjust = hj), size = 3.1,
colour = "grey15", lineheight = 0.95) +
# ボックス
geom_label(data = boxes, aes(x = x, y = y, label = label), size = 3.6, fontface = "bold",
label.padding = unit(0.45, "lines"), label.r = unit(0.15, "lines"),
fill = "#f5f5f3", colour = "grey10", lineheight = 0.95) +
scale_linetype_manual(values = c(`TRUE` = "solid", `FALSE` = "22"), guide = "none") +
scale_colour_manual(values = c(`TRUE` = neutral_col, `FALSE` = "#9a9a95"), guide = "none") +
scale_linewidth_manual(values = c(`TRUE` = 1.1, `FALSE` = 0.7), guide = "none") +
coord_cartesian(xlim = c(-1.3, 9.3), ylim = c(-0.2, 5.2), clip = "off") +
labs(caption = "Solid arrow = association found; dashed grey arrow = no association (below small or n.s.). Emotion–engagement links are correlational.") +
theme_void(base_size = 12) +
theme(plot.caption = element_text(size = 9, colour = "grey30", hjust = 0.5))
last_plot_P1 <- ggplot2::last_plot() # 発表用（付録 E）に再利用する8.2 表 P1 主張と根拠の対応
# 表 P1：論文で述べる主張ごとに、根拠となる数値・主張の強さ・書き方の目安をまとめる
tibble(
Claim = c("比較活動は 1 回では伸びを上乗せしない",
"感じ方を左右したのは AI ではなく活動",
"比較活動で退屈さがやや上がる",
"比較活動をしても関与は増えない",
"感じ方と関与は結びつく",
"感情・関与は短期の伸びと無関係",
"能動的に WCF に取り組む設計が必要"),
Evidence = c(sprintf("RQ1：伸びの条件差 d = %.2f–%.2f", rq1_rng[1], rq1_rng[2]),
sprintf("RQ2：Model text vs AI-WCF の Boredom d = %.2f", bor$d[3]),
sprintf("RQ2：Boredom d = %.2f / %.2f（Enjoyment とまとめると弱まる）", bor$d[1], bor$d[2]),
sprintf("補足：関与の条件差 |d| ≤ %.2f", eng_dmax),
sprintf("補足：|r| = %s–%s、Boredom r = %s / %s", fmt_r(pos_rng[1]), fmt_r(pos_rng[2]), fmt_r(bor_rng[1]), fmt_r(bor_rng[2])),
sprintf("RQ3：感情 |r| ≤ %.2f、関与は Pre 統制で n.s.", emo_dev),
"上記 1・4・5 から導く示唆"),
Strength = c("中", "中", "弱", "中", "強", "中", "示唆"),
Wording = c("「確認されなかった」（同等とは言わない）",
"比較群同士の差がほぼないことを示す",
"「小さな差が見られた」＋限界に明記",
"自己報告であることを明記",
"「関連していた」（同時点の測定）",
"「短期的には」と限定する",
"「結果から導かれる示唆」として Discussion で")
) %>%
ktab("表 P1 主張と根拠の対応（論文での書き方の目安）", file = "TableP1_claims_evidence")| Claim | Evidence | Strength | Wording |
|---|---|---|---|
| 比較活動は 1 回では伸びを上乗せしない | R | 1：伸びの条件差 d = 0.15–0.32 | 中 | 「確認されなかった」 | 同等とは言わない） |
8.3 表 P2 Engagement のまとめ（本文用）
本文では、先行研究の尺度の定義どおり Behavioral と Cognitive を分けて報告する。参考として、2 つを合わせた Task engagement（Q34 を除く 9 項目；付録 G の因子分析にもとづく）も表に並べる。
# 表 P2：Engagement の 3 つの得点について、信頼性・条件別 M (SD)・条件差・感情との相関・伸びとの関係を 1 表に
eng_scores <- c(Behavioral = "Behavioral", Cognitive = "Cognitive",
Task_eng = "Task engagement (B + C, without Q34)")
eng_item_sets <- list(Behavioral = eng_items$Behavioral, Cognitive = eng_items$Cognitive,
Task_eng = c(paste0("Q", 21:25), "Q31", "Q32", "Q33", "Q35"))
tabP2 <- imap_dfr(eng_scores, function(lab, v) {
m <- lm(as.formula(paste(v, "~ condition")), data = dat) # 条件差（一元配置）
an <- anova(m)
pw <- pairwise_d(dat, v) # 3 ペアの d
mpre <- lm(as.formula(paste0("Post_Total ~ Pre_Total + Class + condition + scale(", v, ")")), data = dat)
ppre <- car::Anova(mpre, type = 2)[paste0("scale(", v, ")"), "Pr(>F)"] # Pre 統制後の伸びとの関連
ms <- dat %>% group_by(condition) %>%
summarise(v = sprintf("%.2f (%.2f)", mean(.data[[v]]), sd(.data[[v]]))) %>% deframe()
rs <- map_chr(emotions, ~ fmt_r(cor(dat[[v]], dat[[.x]]))) # 感情との相関
tibble(Score = lab, k = length(eng_item_sets[[v]]),
alpha = sprintf("%.2f", psych::alpha(dat[, eng_item_sets[[v]]])$total$raw_alpha),
Control = ms[["Control"]], `Model text` = ms[["Model text"]], `AI-WCF` = ms[["AI-WCF"]],
`F (p)` = sprintf("%.2f (%s)", an$`F value`[1], fmt_p(an$`Pr(>F)`[1])),
`max |d|` = sprintf("%.2f", max(abs(pw$d)))) %>%
bind_cols(as_tibble(setNames(as.list(rs), unname(emo_label[emotions])))) %>%
mutate(`Development p (Pre ctrl)` = fmt_p(ppre))
})
tabP2 %>%
ktab("表 P2 Engagement のまとめ：信頼性、条件差、感情との相関、伸びとの関係", file = "TableP2_engagement_summary",
note = "条件別は M (SD)。max |d| は 3 ペアの対比較の最大。感情との相関は全体（N = 90）の Pearson の r。Development p は Post ~ Pre + Class + Condition + Engagement での engagement の p。") %>%
add_header_above(c(" " = 3, "Condition: M (SD)" = 3, "Condition difference" = 2,
"r with emotion" = 5, " " = 1))| Score | k | alpha | Control | Model text | AI-WCF | F (p) | max |d| | Enjoyment | Pride | Anxiety | Boredom | Task difficulty | Development p (Pre ctrl) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Behavioral | 5 | 0.65 | 3.77 (0.80) | 3.87 (0.71) | 3.70 (0.61) | 0.46 (.633) | 0.27 | .40 | .47 | .06 | -.38 | .44 | .558 |
| Cognitive | 5 | 0.55 | 3.45 (0.76) | 3.68 (0.64) | 3.55 (0.80) | 0.75 (.478) | 0.33 | .44 | .39 | -.00 | -.36 | .30 | .991 |
| Task engagement (B + C, without Q34) | 9 | 0.76 | 3.73 (0.72) | 3.88 (0.66) | 3.73 (0.63) | 0.52 (.599) | 0.23 | .43 | .47 | .03 | -.38 | .49 | .583 |
# 図 P2：Task engagement と各感情の相関（全体と条件内）。条件内の点は条件の色で示す
task_r <- map_dfr(emotions, function(e) {
overall <- cor.test(dat$Task_eng, dat[[e]])
within <- map_dfr(cond_levels, function(cnd) {
sel <- dat$condition == cnd
tibble(condition = cnd, r = cor(dat$Task_eng[sel], dat[[e]][sel]))
})
bind_rows(tibble(condition = "Overall", r = unname(overall$estimate),
low = overall$conf.int[1], high = overall$conf.int[2]), within) %>%
mutate(Emotion = emo_label[e])
}) %>%
mutate(Emotion = factor(Emotion, levels = rev(emo_label)),
condition = factor(condition, levels = c("Overall", cond_levels)))
ggplot(task_r, aes(r, Emotion)) +
annotate("rect", xmin = -0.25, xmax = 0.25, ymin = -Inf, ymax = Inf, fill = "grey93") + # r の small 未満
geom_vline(xintercept = 0, linetype = 2, colour = "grey45") +
geom_errorbarh(data = filter(task_r, condition == "Overall"),
aes(xmin = low, xmax = high), height = 0.2, colour = neutral_col) +
geom_point(data = filter(task_r, condition != "Overall"),
aes(colour = condition, shape = condition), size = 2.4, alpha = 0.85,
position = position_nudge(y = 0.22)) +
geom_point(data = filter(task_r, condition == "Overall"), size = 3.4, colour = neutral_col) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
scale_x_continuous(limits = c(-0.8, 0.8)) +
labs(x = "Correlation with task engagement (r); black = overall with 95% CI, coloured = within condition\nGrey band = below small (|r| < .25)",
y = NULL, colour = NULL, shape = NULL) +
theme_report
# 本文の英語文例に入れる値
te <- tabP2 %>% filter(str_detect(Score, "Task"))
te_r <- map_dbl(emotions, ~ cor(dat$Task_eng, dat[[.x]])) %>% setNames(emotions)Results の英語文例：
Additional analysis: Engagement. Neither behavioral nor cognitive engagement differed across conditions (behavioral: F(2, 87) = 0.46, p = .633; cognitive: F(2, 87) = 0.75, p = .478; all |d| ≤ 0.33). Both types of engagement were positively associated with enjoyment (r = .40 and .44), pride (r = .47 and .39), and perceived task difficulty (r = .44 and .30), and negatively associated with boredom (r = -.38 and -.36); these associations held within each condition. After controlling for pretest scores, neither type of engagement was associated with writing development (p ≥ .558).
9 付録
9.1 付録 G 探索的因子分析（参考）
本文では、先行研究で因子構造が確認された尺度の下位尺度をそのまま用いた。ここでは参考として、本研究のデータで探索的因子分析（EFA）を行った結果を示す。N = 90 は因子構造を安定して推定するには十分でないため、結果は参考値として扱う。感情（Emotion）と関与（Engagement）は別々に分析する。Emotion は、スピーキングに関する Q10・Q12 を除いた 18 項目（Anxiety は Q9・Q11）、Engagement は収集した 20 項目を対象とする。
手順
- 分析の前提： KMO（標本妥当性）と Bartlett の球面性検定で、因子分析に適したデータかを確認する。
- 因子数： 平行分析（parallel analysis；乱数データの固有値と比較）で決める。理論上の因子数（Emotion 5、Engagement 4）の解も付録に示す。
- 推定法： 最小残差法（minres）。N = 90 で最尤法は不安定になりやすいため。
- 回転： 直交回転のバリマックス回転（因子間の相関を 0 と仮定）と、斜交回転のプロマックス回転（因子間の相関を許す）の両方で因子負荷量を示す。感情や関与の下位尺度は互いに相関すると考えられるため、解釈はプロマックス回転を主とする。
- 基準： 因子負荷量 |λ| ≥ .40 を「その因子に属する」とみなす。表では |λ| < .30 を空欄にした。
library(GPArotation)
# 分析する項目（Task difficulty の Q19・Q20 は逆転済み）
# 因子分析に使う項目の一覧
fa_items <- list(
Emotion = c(paste0("Q", 1:9), "Q11", paste0("Q", 13:20)), # Q10・Q12（スピーキング関連）は含めない
Engagement = paste0("Q", c(21:25, 31:45))
)
# 各項目がもともと属する尺度（構成概念）の対応表
item_construct <- c(
setNames(rep("Enjoyment", 4), paste0("Q", 1:4)),
setNames(rep("Pride", 4), paste0("Q", 5:8)),
setNames(rep("Anxiety", 2), c("Q9", "Q11")),
setNames(rep("Boredom", 4), paste0("Q", 13:16)),
setNames(rep("Task difficulty", 4), paste0("Q", 17:20)),
setNames(rep("Behavioral", 5), paste0("Q", 21:25)),
setNames(rep("Cognitive", 5), paste0("Q", 31:35)),
setNames(rep("Agentic", 5), paste0("Q", 36:40)),
setNames(rep("Social", 5), paste0("Q", 41:45))
)
construct_order <- unique(item_construct)
excluded_items <- paste0("Q", 36:45) # 本分析の尺度得点で使っていない項目（Agentic・Social）
# 因子分析用のデータ（Q19・Q20 は逆転した値に置き換える）
fa_data <- map(fa_items, function(items) {
x <- dat[, items]
x$Q19 <- if ("Q19" %in% items) dat$Q19r else NULL
x$Q20 <- if ("Q20" %in% items) dat$Q20r else NULL
x[, items]
})
# 因子の向きをそろえ（最大負荷を正に）、主に負荷する構成概念で名前を付ける
# 因子分析の結果を整理する関数
# 1) 因子の向きをそろえる（最大の負荷が正になるように）
# 2) 各因子に主に負荷している尺度名で因子に名前を付ける
# 3) 尺度の順に因子を並べ替える
tidy_fa <- function(f, items) {
L <- unclass(f$loadings)
sgn <- apply(L, 2, function(v) sign(v[which.max(abs(v))]))
L <- sweep(L, 2, sgn, `*`)
Phi <- if (is.null(f$Phi)) diag(ncol(L)) else f$Phi * outer(sgn, sgn)
main <- apply(abs(L), 1, which.max)
lab <- map_chr(seq_len(ncol(L)), function(j) {
cons <- table(item_construct[items][main == j & apply(abs(L), 1, max) >= .30])
cons <- names(cons)[cons >= 2]
if (length(cons) == 0) "(minor)" else
paste(cons[order(match(cons, construct_order))], collapse = " + ")
})
ord <- order(match(sub(" \\+.*", "", lab), construct_order), na.last = TRUE)
L <- L[, ord, drop = FALSE]; Phi <- Phi[ord, ord, drop = FALSE]; lab <- lab[ord]
colnames(L) <- rownames(Phi) <- colnames(Phi) <- paste0("F", seq_along(lab))
list(L = L, Phi = Phi, labels = lab, h2 = f$communality[items],
ss = colSums(L^2), fit = f)
}
# 指定した因子数 k で、バリマックス回転とプロマックス回転の両方の因子分析を行う
run_efa <- function(domain, k) {
x <- fa_data[[domain]]
map(c(varimax = "varimax", promax = "promax"),
~ tidy_fa(fa(x, nfactors = k, rotate = .x, fm = "minres"), fa_items[[domain]]))
}
# 平行分析
# 平行分析：観測データの固有値が乱数データを上回る因子数を数える（乱数を使うので seed を固定）
set.seed(2026)
pa <- map(fa_data, function(x) {
res <- NULL
invisible(capture.output(res <- fa.parallel(x, fm = "minres", fa = "fa", n.iter = 100, plot = FALSE)))
res
})
# 平行分析が示した因子数と、理論上の因子数
k_pa <- map_int(pa, "nfact")
k_theory <- c(Emotion = 5L, Engagement = 4L)
# 平行分析の因子数（本文）と理論上の因子数（付録 D）で因子分析を実行
efa_main <- imap(k_pa, ~ run_efa(.y, .x))
efa_theory <- imap(k_theory, ~ run_efa(.y, .x))9.1.1 表 M1 因子分析の前提と因子数
# KMO（標本妥当性）と Bartlett の球面性検定、因子数を 1 つの表にまとめる
imap_dfr(fa_data, function(x, d) {
kmo <- KMO(x)
bt <- cortest.bartlett(cor(x), n = nrow(x))
tibble(Domain = d, Items = ncol(x), N = nrow(x),
KMO = sprintf("%.2f", kmo$MSA),
`Bartlett χ² (df)` = sprintf("%.1f (%d)", bt$chisq, bt$df),
p = fmt_p(bt$p.value),
`Factors: parallel analysis` = k_pa[[d]],
`Factors: theory` = k_theory[[d]],
`Eigenvalues 1–5` = paste(sprintf("%.2f", pa[[d]]$fa.values[1:5]), collapse = ", "))
}) %>%
ktab("表 M1 因子分析の前提（KMO・Bartlett）と因子数", file = "TableM1_EFA_suitability",
note = "KMO は .60 以上で因子分析が可能、.70 以上で中程度とされる。固有値は minres による因子の固有値。")| Domain | Items | N | KMO | Bartlett χ² (df) | p | Factors: parallel analysis | Factors: theory | Eigenvalues 1–5 |
|---|---|---|---|---|---|---|---|---|
| Emotion | 18 | 90 | 0.71 | 778.8 (153) | < .001 | 3 | 5 | 4.31, 2.11, 1.23, 0.58, 0.41 |
| Engagement | 20 | 90 | 0.66 | 600.7 (190) | < .001 | 2 | 4 | 3.43, 2.32, 0.71, 0.54, 0.44 |
9.1.2 図 M1 スクリープロットと平行分析
# 図 M1：観測データと乱数データの固有値を並べたスクリープロット
imap_dfr(pa, function(p, d) {
n <- min(10, length(p$fa.values))
bind_rows(tibble(Domain = d, Factor = 1:n, Eigen = p$fa.values[1:n], Type = "Observed"),
tibble(Domain = d, Factor = 1:n, Eigen = p$fa.sim[1:n], Type = "Simulated (random)"))
}) %>%
ggplot(aes(Factor, Eigen, linetype = Type, shape = Type)) +
geom_hline(yintercept = 0, colour = "grey70") +
geom_line(colour = neutral_col, linewidth = 0.8) +
geom_point(colour = neutral_col, size = 2.4) +
facet_wrap(~ Domain, scales = "free_y") +
scale_x_continuous(breaks = 1:10) +
scale_linetype_manual(values = c("solid", "dashed")) +
scale_shape_manual(values = c(16, 1)) +
labs(x = "Factor", y = "Eigenvalue", linetype = NULL, shape = NULL) +
theme_report
観測データの固有値（実線）が乱数データの固有値（破線）を上回る因子の数が、平行分析の示す因子数である（Emotion 3、Engagement 2）。
# バリマックスとプロマックスの因子負荷量を並べた表
# 因子負荷量の表を作る（左にバリマックス、右にプロマックス、最後に共通性 h2 と負荷量の二乗和）
loading_table <- function(res, domain) {
fmt_l <- function(v) ifelse(abs(v) < .30, "", sprintf("%.2f", v))
items <- fa_items[[domain]]
v <- res$varimax; p <- res$promax
tb <- tibble(Item = ifelse(items %in% c("Q19", "Q20"), paste0(items, " (R)"), items),
Scale = unname(item_construct[items]),
Used = ifelse(items %in% excluded_items, "no", "yes"))
for (j in seq_along(v$labels)) tb[[paste0("Varimax F", j)]] <- fmt_l(v$L[, j])
for (j in seq_along(p$labels)) tb[[paste0("Promax F", j)]] <- fmt_l(p$L[, j])
tb$h2 <- sprintf("%.2f", p$h2)
ss <- c("SS loadings", "", "", sprintf("%.2f", v$ss), sprintf("%.2f", p$ss), "")
tb <- bind_rows(tb, setNames(as.list(ss), names(tb)))
list(table = tb, labels = p$labels, k = length(p$labels))
}
# プロマックス回転の因子間相関の表を作る
phi_table <- function(res) {
P <- res$promax$Phi
out <- as_tibble(round(P, 2), .name_repair = "minimal") %>%
mutate(across(everything(), ~ sprintf("%.2f", .x)))
names(out) <- paste0("F", seq_len(ncol(P)))
bind_cols(tibble(Factor = paste0("F", seq_len(ncol(P)), ": ", res$promax$labels)), out)
}
# 因子負荷量のヒートマップ（左：バリマックス回転、右：プロマックス回転）
loading_heatmap <- function(res, domain) {
items <- fa_items[[domain]]
long <- imap_dfr(list(Varimax = res$varimax, Promax = res$promax), function(r, rot) {
as_tibble(r$L) %>%
mutate(Item = factor(items, levels = rev(items)), Scale = item_construct[items]) %>%
pivot_longer(starts_with("F"), names_to = "Factor", values_to = "Loading") %>%
mutate(Rotation = rot,
FactorLab = paste0(Factor, "\n", r$labels[match(Factor, colnames(r$L))]))
}) %>%
mutate(Rotation = factor(Rotation, levels = c("Varimax", "Promax")),
Scale = factor(Scale, levels = construct_order),
lab = ifelse(abs(Loading) >= .30, sprintf("%.2f", Loading), ""),
face = ifelse(abs(Loading) >= .40, "bold", "plain"))
ggplot(long, aes(FactorLab, Item, fill = Loading)) +
geom_tile(colour = "white", linewidth = 0.8) +
geom_text(aes(label = lab, fontface = face), size = 3, colour = "grey10") +
scale_fill_gradient2(low = fa_low, mid = div_mid, high = fa_high,
midpoint = 0, limits = c(-1, 1)) +
facet_grid(Scale ~ Rotation, scales = "free", space = "free", switch = "y") +
labs(x = NULL, y = NULL, fill = "Loading",
caption = "minres; numbers shown for |loading| ≥ .30, bold = |loading| ≥ .40") +
theme_report +
theme(panel.grid = element_blank(), legend.position = "right",
axis.text.x = element_text(size = 9),
strip.placement = "outside", strip.text.y.left = element_text(angle = 0, hjust = 1))
}
# プロマックス回転の因子間相関のヒートマップ
phi_heatmap <- function(res) {
P <- res$promax$Phi
labs_f <- paste0(colnames(P), "\n", gsub(" \\+ ", "\n+ ", res$promax$labels)) # 長い因子名は改行
as_tibble(P) %>%
mutate(Row = factor(labs_f, levels = rev(labs_f))) %>%
pivot_longer(-Row, names_to = "Col", values_to = "r") %>%
mutate(Col = factor(labs_f[match(Col, colnames(P))], levels = labs_f),
diag = as.character(Row) == as.character(Col), # 対角線（自分自身との相関 = 1）
fill_r = ifelse(diag, NA, r), # 対角線は色を付けない
lab = ifelse(diag, "—", fmt_r(r))) %>%
ggplot(aes(Col, Row, fill = fill_r)) +
geom_tile(colour = "white", linewidth = 1.2) +
geom_text(aes(label = lab), size = 4, colour = "grey10") +
scale_fill_gradient2(low = fa_low, mid = div_mid, high = fa_high,
midpoint = 0, limits = c(-1, 1), na.value = "white") +
labs(x = NULL, y = NULL, fill = "r", caption = "Promax rotation") +
theme_report + theme(panel.grid = element_blank(), legend.position = "right")
}9.1.3 Emotion：因子負荷量と因子間相関（平行分析の因子数；表 M2–M3、図 M2–M3）
# 表 M2：Emotion の因子負荷量
lt_emo <- loading_table(efa_main$Emotion, "Emotion")
lt_emo$table %>%
ktab(sprintf("表 M2 Emotion 18 項目の因子負荷量（%d 因子；バリマックス回転とプロマックス回転）", lt_emo$k),
file = "TableM2_EFA_emotion_loadings",
note = paste0("minres 法。|λ| < .30 は空欄。h2 = 共通性。Used = 本分析の尺度得点に使った項目。",
"プロマックス回転の因子：", paste0("F", 1:lt_emo$k, " = ", lt_emo$labels, collapse = "、"), "。")) %>%
add_header_above(c(" " = 3, "Varimax" = lt_emo$k, "Promax" = lt_emo$k, " " = 1)) %>%
row_spec(nrow(lt_emo$table), italic = TRUE)| Item | Scale | Used | Varimax F1 | Varimax F2 | Varimax F3 | Promax F1 | Promax F2 | Promax F3 | h2 |
|---|---|---|---|---|---|---|---|---|---|
| Q1 | Enjoyment | yes | 0.63 | 0.35 | -0.58 | 0.54 | |||
| Q2 | Enjoyment | yes | 0.65 | -0.66 | 0.49 | ||||
| Q3 | Enjoyment | yes | 0.76 | -0.76 | 0.62 | ||||
| Q4 | Enjoyment | yes | 0.57 | 0.45 | -0.50 | 0.37 | 0.53 | ||
| Q5 | Pride | yes | 0.53 | 0.55 | 0.29 | ||||
| Q6 | Pride | yes | 0.64 | 0.66 | 0.43 | ||||
| Q7 | Pride | yes | 0.60 | 0.61 | 0.44 | ||||
| Q8 | Pride | yes | 0.86 | 0.88 | 0.84 | ||||
| Q9 | Anxiety | yes | 0.50 | 0.48 | 0.32 | ||||
| Q11 | Anxiety | yes | 0.08 | ||||||
| Q13 | Boredom | yes | -0.72 | 0.76 | 0.52 | ||||
| Q14 | Boredom | yes | -0.69 | 0.67 | 0.57 | ||||
| Q15 | Boredom | yes | -0.70 | 0.74 | 0.52 | ||||
| Q16 | Boredom | yes | -0.42 | 0.44 | 0.18 | ||||
| Q17 | Task difficulty | yes | 0.77 | 0.31 | 0.80 | 0.66 | |||
| Q18 | Task difficulty | yes | 0.72 | 0.73 | 0.53 | ||||
| Q19 (R) | Task difficulty | yes | 0.85 | 0.87 | 0.73 | ||||
| Q20 (R) | Task difficulty | yes | 0.54 | 0.54 | 0.30 | ||||
| SS loadings | 3.52 | 2.44 | 2.63 | 3.45 | 2.36 | 2.67 |
# 表 M3：Emotion の因子間相関
phi_table(efa_main$Emotion) %>%
ktab("表 M3 Emotion：プロマックス回転の因子間相関", file = "TableM3_EFA_emotion_phi")| Factor | F1 | F2 | F3 |
|---|---|---|---|
| F1: Enjoyment + Boredom | 1.00 | -0.39 | -0.09 |
| F2: Pride | -0.39 | 1.00 | -0.08 |
| F3: Task difficulty | -0.09 | -0.08 | 1.00 |
# 図 M2：Emotion の因子負荷量（左：バリマックス、右：プロマックス）
loading_heatmap(efa_main$Emotion, "Emotion")
# 図 M3：Emotion の因子間相関
phi_heatmap(efa_main$Emotion)
9.1.4 Engagement：因子負荷量と因子間相関（平行分析の因子数；表 M4–M5、図 M4–M5）
# 表 M4：Engagement の因子負荷量
lt_eng <- loading_table(efa_main$Engagement, "Engagement")
lt_eng$table %>%
ktab(sprintf("表 M4 Engagement 20 項目の因子負荷量（%d 因子；バリマックス回転とプロマックス回転）", lt_eng$k),
file = "TableM4_EFA_engagement_loadings",
note = paste0("minres 法。|λ| < .30 は空欄。h2 = 共通性。Used = 本分析の尺度得点に使った項目。",
"プロマックス回転の因子：", paste0("F", 1:lt_eng$k, " = ", lt_eng$labels, collapse = "、"), "。")) %>%
add_header_above(c(" " = 3, "Varimax" = lt_eng$k, "Promax" = lt_eng$k, " " = 1)) %>%
row_spec(nrow(lt_eng$table), italic = TRUE)| Item | Scale | Used | Varimax F1 | Varimax F2 | Promax F1 | Promax F2 | h2 |
|---|---|---|---|---|---|---|---|
| Q21 | Behavioral | yes | 0.15 | ||||
| Q22 | Behavioral | yes | 0.36 | 0.37 | 0.15 | ||
| Q23 | Behavioral | yes | 0.44 | 0.43 | 0.21 | ||
| Q24 | Behavioral | yes | 0.76 | 0.76 | 0.58 | ||
| Q25 | Behavioral | yes | 0.64 | 0.64 | 0.43 | ||
| Q31 | Cognitive | yes | 0.63 | 0.63 | 0.39 | ||
| Q32 | Cognitive | yes | 0.67 | 0.67 | 0.48 | ||
| Q33 | Cognitive | yes | 0.44 | 0.45 | 0.20 | ||
| Q34 | Cognitive | yes | 0.39 | 0.39 | 0.16 | ||
| Q35 | Cognitive | yes | 0.44 | 0.44 | 0.19 | ||
| Q36 | Agentic | no | 0.36 | 0.36 | 0.14 | ||
| Q37 | Agentic | no | 0.58 | 0.58 | 0.35 | ||
| Q38 | Agentic | no | 0.44 | 0.44 | 0.19 | ||
| Q39 | Agentic | no | -0.43 | 0.50 | -0.42 | 0.49 | 0.43 |
| Q40 | Agentic | no | -0.35 | 0.31 | -0.34 | 0.31 | 0.22 |
| Q41 | Social | no | 0.66 | 0.66 | 0.49 | ||
| Q42 | Social | no | 0.55 | 0.55 | 0.30 | ||
| Q43 | Social | no | 0.51 | 0.51 | 0.33 | ||
| Q44 | Social | no | 0.34 | 0.35 | 0.35 | 0.36 | 0.24 |
| Q45 | Social | no | 0.63 | 0.63 | 0.41 | ||
| SS loadings | 3.19 | 2.85 | 3.18 | 2.83 |
# 表 M5：Engagement の因子間相関
phi_table(efa_main$Engagement) %>%
ktab("表 M5 Engagement：プロマックス回転の因子間相関", file = "TableM5_EFA_engagement_phi")| Factor | F1 | F2 |
|---|---|---|
| F1: Behavioral + Cognitive | 1.00 | -0.04 |
| F2: Agentic + Social | -0.04 | 1.00 |
# 図 M4：Engagement の因子負荷量（左：バリマックス、右：プロマックス）
loading_heatmap(efa_main$Engagement, "Engagement")
# 図 M5：Engagement の因子間相関
phi_heatmap(efa_main$Engagement)
9.1.5 適合度（表 M6、図 M6）
# 適合度（RMSEA とその 90% CI、TLI、BIC、説明率）を 1 行にまとめる
fit_row <- function(res, domain, basis) {
f <- res$promax$fit
tibble(Domain = domain, Basis = basis, Factors = f$factors,
RMSEA = sprintf("%.3f [%.3f, %.3f]", f$RMSEA[1], f$RMSEA[2], f$RMSEA[3]),
TLI = sprintf("%.2f", f$TLI), BIC = sprintf("%.1f", f$BIC),
`Variance explained` = sprintf("%.0f%%", 100 * sum(res$promax$ss) / length(fa_items[[domain]])))
}
fit_tab <- bind_rows(
fit_row(efa_main$Emotion, "Emotion", "Parallel analysis"),
fit_row(efa_theory$Emotion, "Emotion", "Theory"),
fit_row(efa_main$Engagement, "Engagement", "Parallel analysis"),
fit_row(efa_theory$Engagement, "Engagement", "Theory")
)
fit_tab %>%
ktab("表 M6 因子数ごとの適合度（プロマックス回転）", file = "TableM6_EFA_fit",
note = "RMSEA は .08 以下、TLI は .90 以上が目安。BIC は小さいほどよい。N = 90 と小さいため、適合度は参考値として扱う。") %>%
collapse_rows(columns = 1, valign = "top")| Domain | Basis | Factors | RMSEA | TLI | BIC | Variance explained |
|---|---|---|---|---|---|---|
| Emotion | Parallel analysis | 3 | 0.113 [0.093, 0.135] | 0.71 | -238.9 | 47% |
| Theory | 5 | 0.091 [0.065, 0.118] | 0.81 | -200.4 | 56% | |
| Engagement | Parallel analysis | 2 | 0.091 [0.074, 0.110] | 0.64 | -414.2 | 30% |
| Theory | 4 | 0.076 [0.054, 0.100] | 0.74 | -343.6 | 40% |
# 図 M6：因子数ごとの RMSEA と TLI（点線 = 目安）
fit_long <- map_dfr(list(list(efa_main, "Parallel analysis"), list(efa_theory, "Theory")), function(z) {
imap_dfr(z[[1]], function(res, d) {
f <- res$promax$fit
tibble(Domain = d, Basis = paste0(z[[2]], " (k = ", f$factors, ")"),
Index = c("RMSEA (90% CI)", "TLI"),
Value = c(f$RMSEA[1], f$TLI),
Low = c(f$RMSEA[2], NA), High = c(f$RMSEA[3], NA))
})
})
cut_lines <- tibble(Index = c("RMSEA (90% CI)", "TLI"), x = c(.08, .90))
ggplot(fit_long, aes(Value, Basis)) +
geom_vline(data = cut_lines, aes(xintercept = x), linetype = 2, colour = "grey50") +
geom_errorbarh(aes(xmin = Low, xmax = High), height = 0.15, colour = neutral_col, na.rm = TRUE) +
geom_point(size = 3, colour = neutral_col) +
facet_grid(Domain ~ Index, scales = "free") +
labs(x = NULL, y = NULL, caption = "Dashed line = conventional cut-off (RMSEA ≤ .08, TLI ≥ .90)") +
theme_report
9.1.6 因子分析の結果と尺度の扱い
# 本文に埋め込む因子名（プロマックス回転）
emo_lab <- efa_main$Emotion$promax$labels
eng_lab <- efa_main$Engagement$promax$labelsEmotion（3 因子）： プロマックス回転の因子は「Enjoyment + Boredom」「Pride」「Task difficulty」であった。
- Enjoyment と Boredom は 1 つの因子にまとまった。 両者は同じ因子の両端に負荷しており（楽しいほど退屈でない）、尺度得点の相関 r = -.66 とも一致する。理論上の 5 因子解でも、両者は分かれなかった（付録 D）。
- Pride・Task difficulty・Anxiety は、それぞれ独立した因子になった。
- 因子分析の対象から、スピーキングに関する Q10・Q12 は除いている。
Engagement（2 因子）： プロマックス回転の因子は「Behavioral + Cognitive」「Agentic + Social」であった。
- Behavioral と Cognitive は「課題への取り組み」として 1 つの因子にまとまった。
- Agentic と Social は「教師・仲間とのやりとり」として別の因子になった。 個人で行う本タスクに合わないという除外の判断を支持する。
- Cognitive の Q34（例を自分で作る）は課題への取り組みの因子に負荷せず、Q21（必要以上に取り組む）も負荷が弱かった。
尺度の扱い： 本分析では、先行研究との比較可能性を優先し、理論どおりの下位尺度（Enjoyment と Boredom を分ける、Behavioral と Cognitive を分ける）で得点化した。ただし因子構造を踏まえると、次の 2 点に注意が必要である。
- Enjoyment と Boredom は同じ次元の両端を測っている可能性が高い。RQ2 で Boredom に差が見られ、Enjoyment にほとんど差がなかった点は、この次元の中でも「退屈さ側」に差が表れたと解釈する。
- Behavioral と Cognitive は 1 つの「課題への取り組み」としても扱える。下の感度分析で、因子構造に沿った得点でも結論が変わらないことを確認する。
9.1.7 感度分析：因子構造に沿った得点（表 M7、図 M7）
# 因子構造に沿った得点を作る
# Enjoy_Bored = Enjoyment と逆転した Boredom の平均（高いほど楽しく退屈でない）
# Task_eng = Behavioral と Cognitive（Q34 を除く）の平均
dat <- dat %>%
mutate(Enjoy_Bored = (rowMeans(across(all_of(emo_items$Enjoyment))) +
(6 - rowMeans(across(all_of(emo_items$Boredom))))) / 2,
Task_eng = rowMeans(across(all_of(c(paste0("Q", 21:25), "Q31", "Q32", "Q33", "Q35")))))
alt <- list(
Enjoy_Bored = list(label = "Enjoyment–Boredom (Boredom reversed)",
items = c(emo_items$Enjoyment, emo_items$Boredom)),
Task_eng = list(label = "Task engagement (Behavioral + Cognitive, without Q34)",
items = c(paste0("Q", 21:25), "Q31", "Q32", "Q33", "Q35"))
)
# 感度分析：新しい得点で、信頼性・条件差・伸びとの相関を確認する
imap_dfr(alt, function(a, v) {
x <- dat[, a$items]
if (v == "Enjoy_Bored") x[, emo_items$Boredom] <- 6 - x[, emo_items$Boredom]
m <- lm(as.formula(paste(v, "~ condition")), data = dat)
an <- anova(m)
pw <- pairwise_d(dat, v)
tibble(Score = a$label, k = length(a$items),
alpha = sprintf("%.2f", psych::alpha(x)$total$raw_alpha),
`Condition F (p)` = sprintf("%.2f (%s)", an$`F value`[1], fmt_p(an$`Pr(>F)`[1])),
`d: Control vs MT / AI / MT vs AI` = paste(sprintf("%.2f", pw$d), collapse = " / "),
`r with Development` = fmt_r(cor(dat[[v]], dat$Development)),
`r with Task engagement / Enjoy–Bored` =
fmt_r(cor(dat[[v]], dat[[if (v == "Task_eng") "Enjoy_Bored" else "Task_eng"]])))
}) %>%
ktab("表 M7 感度分析：因子構造に沿った得点での主要な結果", file = "TableM7_EFA_sensitivity",
note = "d の符号は「右側 − 左側」。Enjoyment–Boredom は高いほど楽しく退屈でない。")| Score | k | alpha | Condition F (p) | d: Control vs MT / AI / MT vs AI | r with Development | r with Task engagement / Enjoy–Bored |
|---|---|---|---|---|---|---|
| Enjoyment–Boredom (Boredom reversed) | 8 | 0.86 | 0.88 (.420) | -0.13 / -0.35 / -0.20 | -.14 | .45 |
| Task engagement (Behavioral + Cognitive, without Q34) | 9 | 0.76 | 0.52 (.599) | 0.22 / 0.01 / -0.23 | -.17 | .45 |
# 図 M7：新しい得点での条件間の効果量 d
imap_dfr(alt, ~ pairwise_d(dat, .y) %>% mutate(Score = .x$label)) %>%
mutate(Comparison = factor(Comparison, levels = rev(map_chr(pairs_list, paste, collapse = " vs ")))) %>%
ggplot(aes(d, Comparison)) +
annotate("rect", xmin = -0.40, xmax = 0.40, ymin = -Inf, ymax = Inf, fill = "grey92") +
geom_vline(xintercept = 0, linetype = 2, colour = "grey45") +
geom_pointrange(aes(xmin = d_low, xmax = d_high), colour = neutral_col, size = 0.5) +
facet_wrap(~ Score, labeller = label_wrap_gen(width = 32)) + # 長いタイトルは折り返す
labs(x = "Cohen's d (95% CI); + = right-hand condition higher\nGrey band = below small (|d| < 0.40)",
y = NULL) +
theme_report
# 本文に埋め込む値：Enjoyment–Boredom 得点での Control との差
eb_d <- pairwise_d(dat, "Enjoy_Bored")因子構造に沿った得点では、次のようになった。
- 関与に条件差はない、感じ方と関与は結びつく（r = .45）、どちらも伸びとは関連しない、という結論は変わらない。
- 一方、Enjoyment–Boredom の得点では、比較群との差が小さくなった（Control vs Model text d = -0.13、Control vs AI-WCF d = -0.35、いずれも small 未満）。Boredom 単独で見た差（d ≈ 0.5）より弱い。比較活動の影響は、「楽しさが下がる」ことよりも「退屈さが上がる」ことに表れていたと解釈できる。RQ2 では Boredom 単独の結果を中心に報告し、この点を限界として明記する。
9.2 付録 D 理論上の因子数での因子負荷量
# 表 D1：Emotion の理論上の因子数（5 因子）での因子負荷量
lt_emo_t <- loading_table(efa_theory$Emotion, "Emotion")
lt_emo_t$table %>%
ktab(sprintf("表 D1 Emotion：理論上の %d 因子解（バリマックス回転とプロマックス回転）", lt_emo_t$k),
file = "TableD1_EFA_emotion_theory",
note = paste0("プロマックス回転の因子：", paste0("F", 1:lt_emo_t$k, " = ", lt_emo_t$labels, collapse = "、"), "。")) %>%
add_header_above(c(" " = 3, "Varimax" = lt_emo_t$k, "Promax" = lt_emo_t$k, " " = 1))| Item | Scale | Used | Varimax F1 | Varimax F2 | Varimax F3 | Varimax F4 | Varimax F5 | Promax F1 | Promax F2 | Promax F3 | Promax F4 | Promax F5 | h2 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Q1 | Enjoyment | yes | -0.62 | 0.33 | -0.36 | -0.58 | -0.36 | 0.64 | |||||
| Q2 | Enjoyment | yes | -0.60 | -0.57 | 0.53 | ||||||||
| Q3 | Enjoyment | yes | -0.73 | 0.32 | -0.69 | 0.74 | |||||||
| Q4 | Enjoyment | yes | -0.55 | 0.43 | -0.45 | -0.46 | -0.46 | 0.71 | |||||
| Q5 | Pride | yes | 0.53 | 0.54 | 0.32 | ||||||||
| Q6 | Pride | yes | 0.64 | 0.68 | 0.47 | ||||||||
| Q7 | Pride | yes | 0.66 | 0.71 | 0.53 | ||||||||
| Q8 | Pride | yes | 0.83 | 0.85 | 0.79 | ||||||||
| Q9 | Anxiety | yes | 0.76 | 0.32 | 0.77 | 0.76 | |||||||
| Q11 | Anxiety | yes | 0.53 | 0.53 | 0.30 | ||||||||
| Q13 | Boredom | yes | 0.70 | 0.75 | 0.52 | ||||||||
| Q14 | Boredom | yes | 0.69 | -0.37 | 0.65 | 0.69 | |||||||
| Q15 | Boredom | yes | 0.78 | 0.88 | 0.68 | ||||||||
| Q16 | Boredom | yes | 0.47 | 0.52 | 0.28 | ||||||||
| Q17 | Task difficulty | yes | 0.81 | 0.82 | 0.70 | ||||||||
| Q18 | Task difficulty | yes | 0.65 | 0.59 | 0.50 | ||||||||
| Q19 (R) | Task difficulty | yes | 0.89 | 0.89 | 0.81 | ||||||||
| Q20 (R) | Task difficulty | yes | 0.52 | 0.47 | 0.39 | 0.53 | 0.51 | ||||||
| SS loadings | 3.48 | 2.52 | 1.19 | 2.46 | 0.81 | 3.42 | 2.39 | 1.20 | 2.23 | 0.93 |
# 表 D2：Engagement の理論上の因子数（4 因子）での因子負荷量
lt_eng_t <- loading_table(efa_theory$Engagement, "Engagement")
lt_eng_t$table %>%
ktab(sprintf("表 D2 Engagement：理論上の %d 因子解（バリマックス回転とプロマックス回転）", lt_eng_t$k),
file = "TableD2_EFA_engagement_theory",
note = paste0("プロマックス回転の因子：", paste0("F", 1:lt_eng_t$k, " = ", lt_eng_t$labels, collapse = "、"), "。")) %>%
add_header_above(c(" " = 3, "Varimax" = lt_eng_t$k, "Promax" = lt_eng_t$k, " " = 1))| Item | Scale | Used | Varimax F1 | Varimax F2 | Varimax F3 | Varimax F4 | Promax F1 | Promax F2 | Promax F3 | Promax F4 | h2 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| Q21 | Behavioral | yes | 0.52 | 0.53 | 0.31 | ||||||
| Q22 | Behavioral | yes | 0.31 | 0.20 | |||||||
| Q23 | Behavioral | yes | 0.46 | 0.45 | 0.26 | ||||||
| Q24 | Behavioral | yes | 0.76 | 0.78 | 0.59 | ||||||
| Q25 | Behavioral | yes | 0.62 | 0.61 | 0.42 | ||||||
| Q31 | Cognitive | yes | 0.58 | 0.31 | 0.56 | 0.45 | |||||
| Q32 | Cognitive | yes | 0.74 | 0.80 | 0.56 | ||||||
| Q33 | Cognitive | yes | 0.51 | 0.61 | 0.34 | 0.31 | |||||
| Q34 | Cognitive | yes | 0.69 | 0.72 | 0.50 | ||||||
| Q35 | Cognitive | yes | 0.41 | 0.37 | 0.27 | ||||||
| Q36 | Agentic | no | 0.57 | 0.60 | 0.35 | ||||||
| Q37 | Agentic | no | 0.44 | 0.38 | 0.34 | 0.40 | 0.46 | ||||
| Q38 | Agentic | no | 0.38 | 0.37 | 0.22 | ||||||
| Q39 | Agentic | no | -0.45 | 0.40 | -0.39 | 0.32 | 0.42 | ||||
| Q40 | Agentic | no | -0.36 | -0.33 | 0.21 | ||||||
| Q41 | Social | no | 0.68 | 0.56 | 0.63 | 0.54 | -0.34 | 0.84 | |||
| Q42 | Social | no | 0.65 | 0.69 | 0.44 | ||||||
| Q43 | Social | no | 0.34 | 0.40 | 0.31 | 0.37 | 0.35 | ||||
| Q44 | Social | no | 0.33 | 0.43 | 0.41 | 0.35 | |||||
| Q45 | Social | no | 0.72 | 0.74 | 0.60 | ||||||
| SS loadings | 3.16 | 1.48 | 2.11 | 1.36 | 3.22 | 2.01 | 1.34 | 1.48 |
# 図 D1：Emotion 5 因子解の因子負荷量
loading_heatmap(efa_theory$Emotion, "Emotion")
# 図 D2：Emotion 5 因子解の因子間相関
phi_heatmap(efa_theory$Emotion)
# 図 D3：Engagement 4 因子解の因子負荷量
loading_heatmap(efa_theory$Engagement, "Engagement")
# 図 D4：Engagement 4 因子解の因子間相関
phi_heatmap(efa_theory$Engagement)
理論上の因子数でも、Emotion では Enjoyment と Boredom が分かれず、Engagement では Behavioral と Cognitive がはっきり分かれなかった。
9.3 付録 E 学会発表用の図
スクリーンに映したときに読みやすいよう、文字を大きくし、見てほしい部分を強調した版。output/figures/presentation/
に PNG（300 dpi）で保存する（16:9 のスライドに合わせた横長サイズ）。
# 発表用の保存先と、文字を大きくしたテーマ
pres_dir <- file.path(fig_dir, "presentation")
dir.create(pres_dir, recursive = TRUE, showWarnings = FALSE)
theme_pres <- theme_minimal(base_size = 20) +
theme(panel.grid.minor = element_blank(),
legend.position = "bottom",
strip.text = element_text(face = "bold", size = 18),
plot.title = element_text(face = "bold", size = 22))
save_pres <- function(p, name, w = 11, h = 6) {
# 発表用の図を PNG で保存し、レポートにも表示する
ggsave(file.path(pres_dir, paste0(name, ".png")), p, width = w, height = h, dpi = 300, bg = "white")
p
}# 発表図 1：RQ1 の Pre / Post（図 1 の発表版）
p_pres1 <- ggplot(fig1_dat, aes(Time, M, colour = condition, group = condition, shape = condition)) +
geom_line(linewidth = 1.6, position = position_dodge(0.15)) +
geom_errorbar(aes(ymin = M - CI, ymax = M + CI), width = 0.08, linewidth = 1,
position = position_dodge(0.15)) +
geom_point(size = 5, position = position_dodge(0.15)) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
scale_x_discrete(expand = expansion(add = 0.3)) +
labs(x = NULL, y = "Writing score (M, 95% CI)", colour = NULL, shape = NULL) +
theme_pres
save_pres(p_pres1, "Pres1_RQ1_pre_post")
# 発表図 2：RQ2 の効果量（図 3 の発表版）。Boredom を強調し、ほかの感情は薄く表示する
p_pres2 <- rq2_pairs %>%
mutate(Emotion = factor(emo_label[var], levels = rev(emo_label)),
Comparison = factor(Comparison, levels = map_chr(pairs_list, paste, collapse = " vs ")),
focus = ifelse(var == "Boredom", "Boredom", "Other")) %>%
ggplot(aes(d, Emotion, alpha = focus)) +
annotate("rect", xmin = -0.40, xmax = 0.40, ymin = -Inf, ymax = Inf, fill = "grey92") +
geom_vline(xintercept = 0, linetype = 2, colour = "grey45") +
geom_pointrange(aes(xmin = d_low, xmax = d_high), colour = neutral_col, size = 0.9, linewidth = 1.2) +
geom_text(data = function(df) filter(df, focus == "Boredom"),
aes(label = sprintf("d = %.2f", d)), vjust = -1.1, size = 6, fontface = "bold",
colour = "grey10", alpha = 1) +
scale_alpha_manual(values = c(Boredom = 1, Other = 0.3), guide = "none") +
facet_wrap(~ Comparison) +
scale_x_continuous(breaks = c(-0.5, 0, 0.5, 1)) +
labs(x = "Cohen's d (95% CI); grey band = below small (|d| < 0.40)", y = NULL) +
theme_pres
save_pres(p_pres2, "Pres2_RQ2_effect_sizes", w = 13)
# 発表図 3：engagement の条件別（図 7 の発表版）。「比較活動をしても関与は増えない」を示す
p_pres3 <- ggplot(eng_long, aes(condition, Score, colour = condition)) +
geom_jitter(width = 0.15, height = 0.05, alpha = 0.25, size = 2.2) +
geom_errorbar(data = eng_sum, aes(y = M, ymin = M - CI, ymax = M + CI), width = 0.2, linewidth = 1) +
geom_point(data = eng_sum, aes(y = M, shape = condition), size = 5.5) +
facet_wrap(~ Engagement) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
scale_y_continuous(limits = c(0.9, 5.1), breaks = 1:5) +
labs(x = NULL, y = "Mean (1–5), 95% CI") +
theme_pres + theme(legend.position = "none")
save_pres(p_pres3, "Pres3_engagement", w = 11)
# 発表図 4：感情 × 関与の相関（図 6 の発表版）
p_pres4 <- ee %>%
mutate(Emotion = factor(emo_label[var], levels = rev(emo_label)),
lab = paste0(fmt_r(r), ifelse(p_holm < .05, "*", ""))) %>%
ggplot(aes(eng, Emotion, fill = r)) +
geom_tile(colour = "white", linewidth = 2) +
geom_text(aes(label = lab), size = 8, colour = "grey10") +
scale_fill_gradient2(low = div_low, mid = div_mid, high = div_high,
midpoint = 0, limits = c(-0.6, 0.6)) +
labs(x = NULL, y = NULL, fill = "r", caption = "* p < .05 (Holm)") +
theme_pres + theme(panel.grid = element_blank(), legend.position = "right")
save_pres(p_pres4, "Pres4_emotion_engagement", w = 9)
# 発表図 5：まとめの概念図（図 P1 の発表版）。保存済みの図 P1 をそのまま大きいサイズで書き出す
p_pres5 <- last_plot_P1
ggsave(file.path(pres_dir, "Pres5_summary_model.png"), p_pres5, width = 10, height = 6.2, dpi = 300, bg = "white") # 図 P1 と同じ配置・大きさ
p_pres5
9.4 付録 F 振り返り時間（制限時間 10 分）
振り返りには全条件で 10 分（600 秒）の制限時間を設けた。与えた時間は同じだが、実際に使った時間は条件で異なった。本文の結果では扱わず、「退屈さは時間のせいでは？」という疑問に答えるための資料としてここに置く（Reflection の単位は秒）。
# 振り返り時間の条件差と、Boredom との相関（全体・条件内）
m_refl <- lm(Reflection ~ condition, data = dat)
a_refl <- anova(m_refl)
eta_refl <- eta_squared(m_refl, verbose = FALSE)$Eta2[1]
refl_pairs <- pairwise_d(dat, "Reflection")
ct_rb <- cor.test(dat$Reflection, dat$Boredom)
within_rb <- dat %>% group_by(condition) %>%
summarise(r = cor(Reflection, Boredom), p = cor.test(Reflection, Boredom)$p.value)
# 比較群の平均時間が Control の何倍か
n_cap <- table(dat$condition[dat$Reflection >= 600]) # 制限時間（600 秒）に達した人数
ratio_refl <- mean(dat$Reflection[dat$condition != "Control"]) /
mean(dat$Reflection[dat$condition == "Control"])# 図 F1：条件別の振り返り時間（箱ひげ図＋個人の値）。点線 = 制限時間 600 秒
ggplot(dat, aes(condition, Reflection, colour = condition)) +
geom_boxplot(width = 0.5, outlier.shape = NA, fill = NA, linewidth = 0.6) +
geom_jitter(aes(shape = condition), width = 0.12, alpha = 0.5, size = 1.6) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
geom_hline(yintercept = 600, linetype = 2, colour = "grey50") +
labs(x = NULL, y = "Reflection time (s)") +
theme_report + theme(legend.position = "none")
tab8_note <- c(
sprintf("条件差：F(2, 87) = %.2f, p %s, η² = %.2f。Control vs Model text d = %.2f、Control vs AI-WCF d = %.2f、Model text vs AI-WCF d = %.2f。",
a_refl$`F value`[1], fmt_p(a_refl$`Pr(>F)`[1]), eta_refl,
refl_pairs$d[1], refl_pairs$d[2], refl_pairs$d[3]),
sprintf("全体の Reflection × Boredom：r = %s [%s, %s], p = %s。条件内ではいずれも有意でない。",
fmt_r(ct_rb$estimate), fmt_r(ct_rb$conf.int[1]), fmt_r(ct_rb$conf.int[2]),
fmt_p(ct_rb$p.value)),
sprintf("制限時間（600 秒）に達した人：Control %d 名、Model text %d 名、AI-WCF %d 名。そのため比較群の平均はやや過小評価されている。",
n_cap[["Control"]], n_cap[["Model text"]], n_cap[["AI-WCF"]]))
dat %>% group_by(condition) %>%
summarise(`M (SD)` = sprintf("%.1f (%.1f)", mean(Reflection), sd(Reflection)),
Mdn = median(Reflection),
`r with Boredom` = fmt_r(cor(Reflection, Boredom))) %>%
rename(Condition = condition) %>%
ktab("表 F1 条件別の振り返り時間（秒）と Boredom との相関", file = "TableF1_reflection_time",
note = paste(tab8_note, collapse = " ")) %>%
footnote(general = tab8_note)| Condition | M (SD) | Mdn | r with Boredom |
|---|---|---|---|
| Control | 80.7 (85.9) | 60 | -.09 |
| Model text | 289.8 (176.8) | 266 | .19 |
| AI-WCF | 296.7 (125.9) | 282 | .14 |
| Note: | |||
| 条件差：F(2, 87) = 25.42, p < .001, η² = 0.37。Control vs Model text d = 1.51、Control vs AI-WCF d = 2.02、Model text vs AI-WCF d = 0.04。 | |||
| 全体の Reflection × Boredom：r = .23 [.02, .41], p = .032。条件内ではいずれも有意でない。 | |||
| 制限時間（600 秒）に達した人：Control 0 名、Model text 2 名、AI-WCF 1 名。そのため比較群の平均はやや過小評価されている。 |
# 発表用（予備スライド）：振り返り時間。点線 = 制限時間 600 秒
p_presF <- ggplot(dat, aes(condition, Reflection, colour = condition)) +
geom_hline(yintercept = 600, linetype = 2, colour = "grey50") +
geom_boxplot(width = 0.55, outlier.shape = NA, fill = NA, linewidth = 1) +
geom_jitter(aes(shape = condition), width = 0.12, alpha = 0.45, size = 2.6) +
scale_colour_manual(values = cond_cols) +
scale_shape_manual(values = cond_shapes) +
labs(x = NULL, y = "Reflection time (s)") +
theme_pres + theme(legend.position = "none")
save_pres(p_presF, "PresBackup_reflection_time", w = 10)
9.5 付録 B 図表ファイルの書き出し
本レポートの図表は output/ フォルダに保存される（Knit
のたびに上書き）。
output/figures/：各図の PNG（300 dpi）と PDFoutput/tables/：各表の Word ファイル（1 表 = 1 ファイル）output/tables/All_tables.docx：全表を 1 つにまとめた Word ファイル
# これまでに保存した全表を 1 つの Word ファイルにまとめる
doc <- officer::read_docx()
for (nm in names(tab_store)) {
doc <- add_ft(doc, tab_store[[nm]]$caption, tab_store[[nm]]$data, tab_store[[nm]]$note)
}
print(doc, target = file.path(tab_dir, "All_tables.docx"))
# 書き出したファイルの一覧を表示
tibble(Folder = c(rep("output/figures", length(list.files(fig_dir))),
rep("output/tables", length(list.files(tab_dir)))),
File = c(list.files(fig_dir), list.files(tab_dir))) %>%
ktab("書き出したファイル一覧")| Folder | File |
|---|---|
| output/figures | Figure1_RQ1_pre_post.pdf |
| output/figures | Figure1_RQ1_pre_post.png |
| output/figures | Figure1b_RQ1_effect_sizes.pdf |
| output/figures | Figure1b_RQ1_effect_sizes.png |
| output/figures | Figure2_RQ2_emotion_by_condition.pdf |
| output/figures | Figure2_RQ2_emotion_by_condition.png |
| output/figures | Figure3_RQ2_pairwise_d.pdf |
| output/figures | Figure3_RQ2_pairwise_d.png |
| output/figures | Figure5_RQ3_emotion_development.pdf |
| output/figures | Figure5_RQ3_emotion_development.png |
| output/figures | Figure6_emotion_engagement_heatmap.pdf |
| output/figures | Figure6_emotion_engagement_heatmap.png |
| output/figures | Figure7_engagement_by_condition.pdf |
| output/figures | Figure7_engagement_by_condition.png |
| output/figures | Figure8_engagement_development.pdf |
| output/figures | Figure8_engagement_development.png |
| output/figures | FigureD1_EFA_emotion_theory_loadings.pdf |
| output/figures | FigureD1_EFA_emotion_theory_loadings.png |
| output/figures | FigureD2_EFA_emotion_theory_factor_correlations.pdf |
| output/figures | FigureD2_EFA_emotion_theory_factor_correlations.png |
| output/figures | FigureD3_EFA_engagement_theory_loadings.pdf |
| output/figures | FigureD3_EFA_engagement_theory_loadings.png |
| output/figures | FigureD4_EFA_engagement_theory_factor_correlations.pdf |
| output/figures | FigureD4_EFA_engagement_theory_factor_correlations.png |
| output/figures | FigureF1_reflection_time.pdf |
| output/figures | FigureF1_reflection_time.png |
| output/figures | FigureM1_EFA_parallel_analysis.pdf |
| output/figures | FigureM1_EFA_parallel_analysis.png |
| output/figures | FigureM2_EFA_emotion_loadings.pdf |
| output/figures | FigureM2_EFA_emotion_loadings.png |
| output/figures | FigureM3_EFA_emotion_factor_correlations.pdf |
| output/figures | FigureM3_EFA_emotion_factor_correlations.png |
| output/figures | FigureM4_EFA_engagement_loadings.pdf |
| output/figures | FigureM4_EFA_engagement_loadings.png |
| output/figures | FigureM5_EFA_engagement_factor_correlations.pdf |
| output/figures | FigureM5_EFA_engagement_factor_correlations.png |
| output/figures | FigureM6_EFA_fit.pdf |
| output/figures | FigureM6_EFA_fit.png |
| output/figures | FigureM7_EFA_sensitivity.pdf |
| output/figures | FigureM7_EFA_sensitivity.png |
| output/figures | FigureP1_conceptual_model.pdf |
| output/figures | FigureP1_conceptual_model.png |
| output/figures | FigureP2_task_engagement_emotion.pdf |
| output/figures | FigureP2_task_engagement_emotion.png |
| output/figures | FigureR1_reliability.pdf |
| output/figures | FigureR1_reliability.png |
| output/figures | FigureS1_RQ1_subscores.pdf |
| output/figures | FigureS1_RQ1_subscores.png |
| output/figures | FigureS2_RQ3_pride_slopes.pdf |
| output/figures | FigureS2_RQ3_pride_slopes.png |
| output/figures | presentation |
| output/tables | ~$l_tables.docx |
| output/tables | All_tables.docx |
| output/tables | Table01_participants.docx |
| output/tables | Table02_reliability.docx |
| output/tables | Table03_descriptives.docx |
| output/tables | Table04_RQ1_mixed_model.docx |
| output/tables | Table05_RQ1_effect_sizes.docx |
| output/tables | Table06_RQ2_omnibus.docx |
| output/tables | Table07_RQ2_pairwise.docx |
| output/tables | Table09_RQ3_correlations.docx |
| output/tables | Table10_RQ3_moderation.docx |
| output/tables | Table11_engagement_condition.docx |
| output/tables | Table12_emotion_engagement.docx |
| output/tables | Table13_engagement_development.docx |
| output/tables | TableA1_anxiety_versions.docx |
| output/tables | TableD1_EFA_emotion_theory.docx |
| output/tables | TableD2_EFA_engagement_theory.docx |
| output/tables | TableF1_reflection_time.docx |
| output/tables | TableM1_EFA_suitability.docx |
| output/tables | TableM2_EFA_emotion_loadings.docx |
| output/tables | TableM3_EFA_emotion_phi.docx |
| output/tables | TableM4_EFA_engagement_loadings.docx |
| output/tables | TableM5_EFA_engagement_phi.docx |
| output/tables | TableM6_EFA_fit.docx |
| output/tables | TableM7_EFA_sensitivity.docx |
| output/tables | TableP1_claims_evidence.docx |
| output/tables | TableP2_engagement_summary.docx |
| output/tables | TableS1_RQ1_robustness.docx |
| output/tables | TableS2_RQ3_pride_slopes.docx |
9.6 付録 C Session info
# R と各パッケージのバージョン（再現性のため）
sessionInfo()## R version 4.3.2 (2023-10-31)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS 26.6.2
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.11.0
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## time zone: Asia/Tokyo
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] GPArotation_2024.3-1 kableExtra_1.4.0 knitr_1.43
## [4] car_3.1-2 carData_3.0-5 effectsize_1.0.1
## [7] emmeans_1.10.6 lmerTest_3.1-3 lme4_1.1-37
## [10] Matrix_1.6-5 psych_2.4.6.26 readxl_1.4.5
## [13] lubridate_1.9.2 forcats_1.0.0 stringr_1.5.1
## [16] dplyr_1.1.4 purrr_1.0.4 readr_2.1.5
## [19] tidyr_1.3.1 tibble_3.2.1 ggplot2_3.5.1
## [22] tidyverse_2.0.0
##
## loaded via a namespace (and not attached):
## [1] Rdpack_2.6.4 mnormt_2.1.1 sandwich_3.1-1
## [4] rlang_1.1.6 magrittr_2.0.3 multcomp_1.4-28
## [7] compiler_4.3.2 mgcv_1.9-0 systemfonts_1.2.3
## [10] vctrs_0.6.5 pkgconfig_2.0.3 fastmap_1.1.1
## [13] backports_1.4.1 labeling_0.4.2 utf8_1.2.3
## [16] rmarkdown_2.22 tzdb_0.4.0 nloptr_2.0.3
## [19] ragg_1.2.5 xfun_0.52 cachem_1.0.8
## [22] jsonlite_1.8.5 highr_0.10 uuid_1.1-0
## [25] broom_1.0.5 parallel_4.3.2 R6_2.5.1
## [28] bslib_0.5.0 stringi_1.7.12 boot_1.3-28.1
## [31] jquerylib_0.1.4 cellranger_1.1.0 numDeriv_2016.8-1.1
## [34] estimability_1.4.1 Rcpp_1.1.0 zoo_1.8-12
## [37] parameters_0.27.0 splines_4.3.2 timechange_0.2.0
## [40] tidyselect_1.2.1 rstudioapi_0.14 abind_1.4-5
## [43] yaml_2.3.7 codetools_0.2-19 lattice_0.21-9
## [46] withr_2.5.0 bayestestR_0.16.1 flextable_0.9.7
## [49] askpass_1.1 coda_0.19-4.1 evaluate_0.21
## [52] survival_3.5-7 zip_2.3.0 xml2_1.3.8
## [55] pillar_1.9.0 reformulas_0.4.1 insight_1.3.1
## [58] generics_0.1.3 hms_1.1.3 munsell_0.5.0
## [61] scales_1.3.0 minqa_1.2.5 xtable_1.8-4
## [64] glue_1.8.0 gdtools_0.4.2 tools_4.3.2
## [67] data.table_1.17.8 mvtnorm_1.2-4 grid_4.3.2
## [70] rbibutils_2.3 datawizard_1.1.0 colorspace_2.1-0
## [73] nlme_3.1-166 cli_3.6.5 textshaping_0.3.6
## [76] officer_0.6.8 fontBitstreamVera_0.1.1 fansi_1.0.4
## [79] viridisLite_0.4.2 svglite_2.2.1 gtable_0.3.3
## [82] sass_0.4.10 digest_0.6.31 fontquiver_0.2.1
## [85] pbkrtest_0.5.2 TH.data_1.1-3 farver_2.1.1
## [88] htmltools_0.5.8.1 lifecycle_1.0.4 fontLiberation_0.1.0
## [91] openssl_2.0.6 MASS_7.3-60