r_statistic
Group_4
2025-12-13
# 載入套件
library(readr)
library(dplyr)
library(tidyr)
library(lavaan)
library(car)
library(glue)
library(ggplot2)
#knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)以下程式碼嘗試以 BIG5 編碼讀取 CSV 檔案，如果失敗則改用 UTF-8。
file_name <- "5_6185824775458265986.csv"
df <- tryCatch(
read_csv(file_name, locale = locale(encoding = "BIG5")),
error = function(e) {
read_csv(file_name, locale = locale(encoding = "UTF-8"))
}
)資料前處理
這裡計算人格量表的平均分，並將操弄變項轉為 factor。
# 計算量表平均
df <- df %>%
mutate(
Immersion = rowMeans(select(., C1:C5), na.rm = TRUE),
Trust = rowMeans(select(., N1,N2,N3,N4,N52,N7,N92,N12), na.rm = TRUE),
abcon = as.factor(abcon),
wwo = as.factor(wwo)
)
# 指定變數
IV1 <- "abcon"
IV2 <- "wwo"
MED1 <- "Trust"
MED2 <- "Immersion"
DVs <- c("罪名2", "判決信心", "刑期2")
Manipulation1 <- "Column18"
Manipulation2 <- "Column21"
Control <- "Column40"操弄性檢定 (t-test)
確認操弄變項是否成功。 t-test 用於檢測不同組別的平均值差異。
# 定義 t-test 函數，回傳更清楚的表格
t_test_summary_table <- function(formula, data, label){
group_var <- all.vars(formula)[2] # 分組變數
measure_var <- all.vars(formula)[1] # 測量變數
res <- t.test(formula, data = data, var.equal = FALSE)
# 計算各組平均
means <- data %>%
group_by(!!sym(group_var)) %>%
summarise(mean_score = mean(!!sym(measure_var), na.rm = TRUE), .groups = "drop")
tab <- data.frame(
Test = label,
Measure = measure_var,
Group1 = as.character(means[[group_var]][1]),
Mean1 = round(means$mean_score[1], 3),
Group2 = as.character(means[[group_var]][2]),
Mean2 = round(means$mean_score[2], 3),
t = round(res$statistic, 3),
df = round(res$parameter, 3),
p = signif(res$p.value, 3)
)
return(tab)
}
# 設定 t-test
ttests <- list(
list(formula = Column18 ~ abcon, label = "Manipulation1: Column18 ~ abcon"),
list(formula = Column21 ~ wwo, label = "Manipulation2: Column21 ~ wwo"),
list(formula = as.formula(paste(Control, "~", IV2)), label = "Control ~ wwo")
)
# 執行 t-test 並整理結果
t_results <- do.call(rbind, lapply(ttests, function(x) t_test_summary_table(x$formula, df, x$label)))
# 顯示表格
knitr::kable(t_results, caption = "T-test Results for Manipulation Checks and Control Variables")| Test | Measure | Group1 | Mean1 | Group2 | Mean2 | t | df | p | |
|---|---|---|---|---|---|---|---|---|---|
| t | Manipulation1: Column18 ~ abcon | Column18 | 0 | 4.803 | 1 | 5.451 | -2.802 | 98.184 | 0.00612 |
| t1 | Manipulation2: Column21 ~ wwo | Column21 | 0 | 2.638 | 1 | 5.027 | -8.193 | 129.750 | 0.00000 |
| t2 | Control ~ wwo | Column40 | 0 | 5.448 | 1 | 5.595 | -0.414 | 127.811 | 0.68000 |
# 將數據整理成 long format
df_long <- df %>%
select(
Abcon = Column18,
WWO = Column21,
Control = Column40,
abcon,
wwo
) %>%
pivot_longer(cols = c(Abcon, WWO, Control),
names_to = "Measure",
values_to = "Score") %>%
mutate(Group = case_when(
Measure == "Abcon" ~ as.character(abcon),
Measure == "WWO" ~ as.character(wwo),
Measure == "Control" ~ as.character(wwo)
))
# 計算平均與標準誤
df_summary <- df_long %>%
group_by(Measure, Group) %>%
summarise(
mean_score = mean(Score, na.rm = TRUE),
se = sd(Score, na.rm = TRUE)/sqrt(n()),
.groups = "drop"
)
df_summary$Measure <- factor(df_summary$Measure, levels = c("Abcon", "WWO", "Control"))
# 繪圖
ggplot(df_summary, aes(x = Measure, y = mean_score, fill = Group)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.6), width = 0.5) +
geom_errorbar(aes(ymin = mean_score - se, ymax = mean_score + se),
position = position_dodge(width = 0.6), width = 0.2) +
labs(y = "Mean Score", x = "Measure", fill = "Group",
title = "Manipulation Check and Control Variable Scores") +
theme_classic(base_size = 14)
2×2 Factorial ANOVA
檢查 IV1 和 IV2 對每個 DV 的主效果與交互效果。 使用 Type III Sum of Squares，適合不平衡資料。
df[[IV1]] <- factor(df[[IV1]])
df[[IV2]] <- factor(df[[IV2]])
for (DV in DVs) {
cat("===========================\n")
cat(DV, "的 2×2 Factorial ANOVA \n")
cat("===========================\n")
formula <- as.formula(paste(DV, "~", IV1, "*", IV2))
fit <- lm(formula, data = df)
print(Anova(fit, type = 3))
cat("\n\n")
}## ===========================
## 罪名2 的 2×2 Factorial ANOVA
## ===========================
## Anova Table (Type III tests)
##
## Response: 罪名2
## Sum Sq Df F value Pr(>F)
## (Intercept) 0.9259 1 4.1961 0.04256 *
## abcon 0.5883 1 2.6662 0.10496
## wwo 0.2880 1 1.3053 0.25538
## abcon:wwo 0.1830 1 0.8291 0.36425
## Residuals 28.2451 128
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## ===========================
## 判決信心 的 2×2 Factorial ANOVA
## ===========================
## Anova Table (Type III tests)
##
## Response: 判決信心
## Sum Sq Df F value Pr(>F)
## (Intercept) 273.93 1 103.8670 < 2e-16 ***
## abcon 3.97 1 1.5053 0.22211
## wwo 12.27 1 4.6535 0.03286 *
## abcon:wwo 4.40 1 1.6682 0.19883
## Residuals 337.57 128
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## ===========================
## 刑期2 的 2×2 Factorial ANOVA
## ===========================
## Anova Table (Type III tests)
##
## Response: 刑期2
## Sum Sq Df F value Pr(>F)
## (Intercept) 50.704 1 156.3268 <2e-16 ***
## abcon 0.033 1 0.1016 0.7504
## wwo 0.381 1 1.1736 0.2807
## abcon:wwo 0.000 1 0.0011 0.9737
## Residuals 41.516 128
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Bootstrap 中介分析
檢查人格特質是否在操弄變項與結果變項之間發揮中介作用。 使用 lavaan 執行 SEM，並透過 Bootstrap 估計間接效果與 95% CI。
run_bootstrap_mediation <- function(data, mediation_paths, DVs, n_boot = 50) {
all_results <- data.frame() # 存所有路徑結果
for (dv in DVs) {
for (path in mediation_paths) {
IV <- path$IV
MED <- path$MED
# 建立 lavaan 模型
model <- glue('
# a path
{MED} ~ a*{IV}
# b path
{dv} ~ b*{MED}
# direct effect
{dv} ~ c_prime*{IV}
# indirect effect
indirect := a*b
# total effect
total := c_prime + (a*b)
')
# 執行 SEM
fit <- sem(as.character(model), data = data,
se = "bootstrap", bootstrap = n_boot,
optim.method = "BFGS")
# 取得間接效果的 bootstrap CI
ci <- parameterEstimates(fit, boot.ci.type = "perc") %>%
filter(label == "indirect") %>%
select(est, ci.lower, ci.upper)
# 加入 IV、MED、DV
ci <- ci %>%
mutate(IV = IV,
MED = MED,
DV = dv,
sig = ifelse(ci.lower * ci.upper > 0, "顯著", "不顯著"))
# 累積結果
all_results <- bind_rows(all_results, ci)
# 列印每條路徑
cat("\n間接效果分析：", IV, "->", MED, "->", dv, "\n")
cat(sprintf(" 間接效果估計值: %.4f\n", ci$est))
cat(sprintf(" Bootstrapped 95%% CI: [%.4f, %.4f]\n", ci$ci.lower, ci$ci.upper))
cat(" 結論:", ci$sig, "\n")
}
}
# 畫圖
plot <- ggplot(all_results, aes(x = DV, y = est, ymin = ci.lower, ymax = ci.upper, color = MED)) +
geom_pointrange(position = position_dodge(width = 0.5), size = 0.8) +
geom_hline(yintercept = 0, linetype = "dashed") +
scale_color_manual(
values = c("Trust" = "#E69F00", "Immersion" = "#56B4E9"),
labels = c("Trust" = "Trust", "Immersion" = "Immersion")
) +
labs(
y = "Estimated Indirect Effect",
x = "Dependent Variable",
color = "Mediator",
title = "Bootstrap Mediation Analysis"
) +
theme_classic()
return(list(results = all_results, plot = plot))
}
# 使用範例
mediation_paths <- list(
list(IV = IV1, MED = MED1),
list(IV = IV1, MED = MED2),
list(IV = IV2, MED = MED2)
)
boot_res <- run_bootstrap_mediation(df, mediation_paths, DVs, n_boot = 1000)##
## 間接效果分析： abcon -> Trust -> 罪名2
## 間接效果估計值: 0.0557
## Bootstrapped 95% CI: [-0.0016, 0.1213]
## 結論: 不顯著
##
## 間接效果分析： abcon -> Immersion -> 罪名2
## 間接效果估計值: 0.0071
## Bootstrapped 95% CI: [-0.0764, 0.0963]
## 結論: 不顯著
##
## 間接效果分析： wwo -> Immersion -> 罪名2
## 間接效果估計值: 0.0630
## Bootstrapped 95% CI: [-0.0139, 0.1529]
## 結論: 不顯著
##
## 間接效果分析： abcon -> Trust -> 判決信心
## 間接效果估計值: 0.1532
## Bootstrapped 95% CI: [-0.1111, 0.3750]
## 結論: 不顯著
##
## 間接效果分析： abcon -> Immersion -> 判決信心
## 間接效果估計值: 0.0158
## Bootstrapped 95% CI: [-0.1685, 0.1919]
## 結論: 不顯著
##
## 間接效果分析： wwo -> Immersion -> 判決信心
## 間接效果估計值: 0.1339
## Bootstrapped 95% CI: [-0.0424, 0.3738]
## 結論: 不顯著
##
## 間接效果分析： abcon -> Trust -> 刑期2
## 間接效果估計值: 0.0917
## Bootstrapped 95% CI: [0.0098, 0.1885]
## 結論: 顯著
##
## 間接效果分析： abcon -> Immersion -> 刑期2
## 間接效果估計值: 0.0027
## Bootstrapped 95% CI: [-0.0360, 0.0410]
## 結論: 不顯著
##
## 間接效果分析： wwo -> Immersion -> 刑期2
## 間接效果估計值: 0.0216
## Bootstrapped 95% CI: [-0.0093, 0.0764]
## 結論: 不顯著# 查看結果表
knitr::kable(boot_res$results, caption = "Bootstrap Indirect Effects")| est | ci.lower | ci.upper | IV | MED | DV | sig |
|---|---|---|---|---|---|---|
| 0.0557481 | -0.0016086 | 0.1212754 | abcon | Trust | 罪名2 | 不顯著 |
| 0.0070578 | -0.0764241 | 0.0963066 | abcon | Immersion | 罪名2 | 不顯著 |
| 0.0630338 | -0.0138712 | 0.1528846 | wwo | Immersion | 罪名2 | 不顯著 |
| 0.1532491 | -0.1111291 | 0.3750085 | abcon | Trust | 判決信心 | 不顯著 |
| 0.0157984 | -0.1684645 | 0.1918888 | abcon | Immersion | 判決信心 | 不顯著 |
| 0.1339398 | -0.0423653 | 0.3738302 | wwo | Immersion | 判決信心 | 不顯著 |
| 0.0916963 | 0.0098384 | 0.1884801 | abcon | Trust | 刑期2 | 顯著 |
| 0.0027081 | -0.0360299 | 0.0409508 | abcon | Immersion | 刑期2 | 不顯著 |
| 0.0215767 | -0.0093164 | 0.0764232 | wwo | Immersion | 刑期2 | 不顯著 |
# 畫圖
boot_res$plot