この文書は、論文で報告したランダム化比較試験（RCT）の分析を再現するための R Markdownです。査読対応として追加した以下の頑健性確認も含めています。
mediation::medsensを用いた媒介感度分析。Simplification x Document Type交互作用による文書タイプ別の異質性確認。このR
Markdownファイルと同じディレクトリにrawdata.csvが置かれていることを
前提としています。
すべての分析はR v.4.5.1での実行を想定しています。乱数を用いる手続きでは、 下記の固定シードを用いています。
knitr::kable(
tibble::tibble(
item = c("対象Rバージョン", "実行時Rバージョン", "乱数シード"),
value = c(
paste0("R v.", target_r_version),
paste0("R v.", runtime_r_version),
seed_value
)
)
)| item | value |
|---|---|
| 対象Rバージョン | R v.4.5.1 |
| 実行時Rバージョン | R v.4.5.1 |
| 乱数シード | 123 |
rawdata <- readr::read_csv("rawdata.csv", show_col_types = FALSE)
education_levels <- c(
"Junior High School",
"High School (In progress)",
"High School Graduate",
"Vocational School (In progress)",
"Vocational School Graduate",
"Junior College (In progress)",
"Junior College Graduate",
"University (In progress)",
"University Graduate",
"Graduate School (Master's - In progress)",
"Graduate School (Master's - Completed)",
"Graduate School (Ph.D. - In progress)",
"Graduate School (Ph.D. - Completed)",
"Other",
"Prefer not to say"
)
occupation_levels <- c(
"Student",
"Homemaker",
"Self-employed",
"Public Official",
"Teaching Staff",
"Medical/Healthcare",
"Business Owner",
"Corporate Executive",
"Employee",
"Part-time/Temporary",
"Unemployed",
"Agriculture/Forestry/Fisheries",
"Professional (Lawyer/Tax Accountant, etc.)",
"Other"
)
prefecture_levels <- c(
"Hokkaido", "Aomori", "Iwate", "Miyagi", "Akita", "Yamagata",
"Fukushima", "Ibaraki", "Tochigi", "Gunma", "Saitama", "Chiba",
"Tokyo", "Kanagawa", "Niigata", "Toyama", "Ishikawa", "Fukui",
"Yamanashi", "Nagano", "Gifu", "Shizuoka", "Aichi", "Mie",
"Shiga", "Kyoto", "Osaka", "Hyogo", "Nara", "Wakayama",
"Tottori", "Shimane", "Okayama", "Hiroshima", "Yamaguchi",
"Tokushima", "Kagawa", "Ehime", "Kochi", "Fukuoka", "Saga",
"Nagasaki", "Kumamoto", "Oita", "Miyazaki", "Kagoshima",
"Okinawa"
)
analysis_data <- rawdata |>
dplyr::transmute(
respondent_id = respid,
document_id = Quota1,
group = dplyr::case_when(
Quota1 == 1 ~ "A1 (統制群)",
Quota1 == 2 ~ "A2 (介入群)",
Quota1 == 3 ~ "B1 (統制群)",
Quota1 == 4 ~ "B2 (介入群)",
TRUE ~ NA_character_
),
document_type = factor(
dplyr::if_else(Quota1 %in% c(3, 4), "B", "A"),
levels = c("A", "B")
),
simplification = ifelse(Quota1 %in% c(2, 4), 1, 0),
simplification_factor = factor(
ifelse(Quota1 %in% c(2, 4), "Simplified", "Original"),
levels = c("Original", "Simplified")
),
comprehension = Q2,
acceptance = Q3,
acceptance_ord = ordered(Q3, levels = 1:5),
age = SC2_1,
gender = factor(SC1, levels = c(1, 2), labels = c("Male", "Female")),
education = factor(Q1, levels = seq_along(education_levels), labels = education_levels),
occupation = factor(SC5, levels = seq_along(occupation_levels), labels = occupation_levels),
prefecture = factor(SC3, levels = seq_along(prefecture_levels), labels = prefecture_levels)
) |>
dplyr::mutate(
group = factor(
group,
levels = c("A1 (統制群)", "B1 (統制群)", "A2 (介入群)", "B2 (介入群)")
)
) |>
tidyr::drop_na() |>
droplevels()
knitr::kable(
tibble::tibble(
n = nrow(analysis_data),
mean_age = mean(analysis_data$age),
sd_age = sd(analysis_data$age),
male_n = sum(analysis_data$gender == "Male"),
female_n = sum(analysis_data$gender == "Female")
),
digits = 3
)| n | mean_age | sd_age | male_n | female_n |
|---|---|---|---|---|
| 2197 | 53.33 | 13.759 | 1472 | 725 |
group_counts <- analysis_data |>
dplyr::count(group, name = "n")
knitr::kable(group_counts)| group | n |
|---|---|
| A1 (統制群) | 544 |
| B1 (統制群) | 552 |
| A2 (介入群) | 547 |
| B2 (介入群) | 554 |
format_count_pct <- function(x, denominator) {
paste0(x, " (", round(100 * x / denominator, 1), "%)")
}
likert_table <- function(data, variable, label) {
counts <- table(data$group, data[[variable]])
out <- as.data.frame.matrix(t(counts))
out$level <- rownames(out)
out$variable <- label
out <- tibble::as_tibble(out)
out |>
dplyr::relocate(variable, level) |>
dplyr::mutate(
dplyr::across(
dplyr::all_of(levels(data$group)),
~ format_count_pct(.x, sum(.x))
)
)
}
acceptance_table <- likert_table(analysis_data, "acceptance", "納得度")
comprehension_table <- likert_table(analysis_data, "comprehension", "理解度")
knitr::kable(
dplyr::bind_rows(acceptance_table, comprehension_table),
caption = "実験条件別の度数と割合。"
)| variable | level | A1 (統制群) | B1 (統制群) | A2 (介入群) | B2 (介入群) |
|---|---|---|---|---|---|
| 納得度 | 1 | 46 (8.5%) | 42 (7.6%) | 23 (4.2%) | 40 (7.2%) |
| 納得度 | 2 | 122 (22.4%) | 135 (24.5%) | 112 (20.5%) | 121 (21.8%) |
| 納得度 | 3 | 295 (54.2%) | 305 (55.3%) | 289 (52.8%) | 279 (50.4%) |
| 納得度 | 4 | 68 (12.5%) | 65 (11.8%) | 113 (20.7%) | 100 (18.1%) |
| 納得度 | 5 | 13 (2.4%) | 5 (0.9%) | 10 (1.8%) | 14 (2.5%) |
| 理解度 | 1 | 62 (11.4%) | 69 (12.5%) | 45 (8.2%) | 59 (10.6%) |
| 理解度 | 2 | 172 (31.6%) | 197 (35.7%) | 148 (27.1%) | 167 (30.1%) |
| 理解度 | 3 | 206 (37.9%) | 193 (35%) | 202 (36.9%) | 204 (36.8%) |
| 理解度 | 4 | 88 (16.2%) | 82 (14.9%) | 140 (25.6%) | 105 (19%) |
| 理解度 | 5 | 16 (2.9%) | 11 (2%) | 12 (2.2%) | 19 (3.4%) |
set.seed(seed_value)
randomization_checks <- tibble::tibble(
variable = c("年齢", "性別", "学歴", "職業", "居住都道府県"),
test = c(
"Kruskal-Wallis検定",
"Fisher正確検定（シミュレーションp値）",
"Fisher正確検定（シミュレーションp値）",
"Fisher正確検定（シミュレーションp値）",
"Fisher正確検定（シミュレーションp値）"
),
p_value = c(
kruskal.test(age ~ group, data = analysis_data)$p.value,
fisher.test(table(analysis_data$gender, analysis_data$group), simulate.p.value = TRUE, B = 100000)$p.value,
fisher.test(table(analysis_data$education, analysis_data$group), simulate.p.value = TRUE, B = 100000)$p.value,
fisher.test(table(analysis_data$occupation, analysis_data$group), simulate.p.value = TRUE, B = 100000)$p.value,
fisher.test(table(analysis_data$prefecture, analysis_data$group), simulate.p.value = TRUE, B = 100000)$p.value
)
)
knitr::kable(randomization_checks, digits = 3)| variable | test | p_value |
|---|---|---|
| 年齢 | Kruskal-Wallis検定 | 0.387 |
| 性別 | Fisher正確検定（シミュレーションp値） | 0.869 |
| 学歴 | Fisher正確検定（シミュレーションp値） | 0.386 |
| 職業 | Fisher正確検定（シミュレーションp値） | 0.389 |
| 居住都道府県 | Fisher正確検定（シミュレーションp値） | 0.012 |
シミュレーションによるFisher正確検定のp値は乱数に依存します。正確に再現するには、 上記の乱数種とシミュレーション回数を用います。
distributional_tests <- tibble::tibble(
outcome = c("納得度", "理解度"),
test = "Kruskal-Wallis検定",
p_value = c(
kruskal.test(acceptance ~ group, data = analysis_data)$p.value,
kruskal.test(comprehension ~ group, data = analysis_data)$p.value
)
)
knitr::kable(distributional_tests, digits = 6)| outcome | test | p_value |
|---|---|---|
| 納得度 | Kruskal-Wallis検定 | 8.1e-05 |
| 理解度 | Kruskal-Wallis検定 | 8.0e-06 |
したがって、理解度の分布差はp < .001として報告します。
論文で報告したANCOVAは、元のR
Markdown分析と同じく、aov()による逐次平方和 （Type
I）に基づいています。
ancova_model <- aov(
acceptance ~ document_type + simplification_factor + age + gender +
occupation + education + prefecture,
data = analysis_data
)
summary(ancova_model)## Df Sum Sq Mean Sq F value Pr(>F)
## document_type 1 2.2 2.200 3.157 0.0757 .
## simplification_factor 1 12.7 12.662 18.167 2.11e-05 ***
## age 1 0.5 0.463 0.664 0.4151
## gender 1 1.5 1.450 2.081 0.1493
## occupation 13 10.7 0.823 1.180 0.2874
## education 13 15.4 1.187 1.703 0.0541 .
## prefecture 46 27.8 0.605 0.868 0.7212
## Residuals 2120 1477.6 0.697
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1effectsize::eta_squared(ancova_model, partial = TRUE)## # Effect Size for ANOVA (Type I)
##
## Parameter | Eta2 (partial) | 95% CI
## -----------------------------------------------------
## document_type | 1.49e-03 | [0.00, 1.00]
## simplification_factor | 8.50e-03 | [0.00, 1.00]
## age | 3.13e-04 | [0.00, 1.00]
## gender | 9.80e-04 | [0.00, 1.00]
## occupation | 7.18e-03 | [0.00, 1.00]
## education | 0.01 | [0.00, 1.00]
## prefecture | 0.02 | [0.00, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].shapiro_acceptance <- shapiro.test(analysis_data$acceptance)
levene_acceptance <- car::leveneTest(acceptance ~ group, data = analysis_data)
shapiro_acceptance##
## Shapiro-Wilk normality test
##
## data: analysis_data$acceptance
## W = 0.86656, p-value < 2.2e-16levene_acceptance## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 3 1.1576 0.3246
## 2193emmeans_simplification <- emmeans::emmeans(
ancova_model,
specs = ~ simplification_factor,
rg.limit = 75000
)
emmeans_simplification## simplification_factor emmean SE df lower.CL upper.CL
## Original 2.82 0.101 2120 2.62 3.02
## Simplified 2.97 0.102 2120 2.77 3.17
##
## Results are averaged over the levels of: document_type, gender, occupation, education, prefecture
## Confidence level used: 0.95regression_without_comprehension <- lm(
acceptance ~ document_type + simplification_factor + age + gender +
occupation + education + prefecture,
data = analysis_data
)
summary(regression_without_comprehension)##
## Call:
## lm(formula = acceptance ~ document_type + simplification_factor +
## age + gender + occupation + education + prefecture, data = analysis_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.3133 -0.6486 0.1264 0.3393 2.5447
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 2.9515992 0.3462685
## document_typeB -0.0598968 0.0363785
## simplification_factorSimplified 0.1459749 0.0363814
## age -0.0018074 0.0015061
## genderFemale -0.0234298 0.0501785
## occupationHomemaker -0.0940725 0.3219914
## occupationSelf-employed -0.0577827 0.3238503
## occupationPublic Official -0.0334171 0.3353482
## occupationTeaching Staff -0.0496684 0.3504997
## occupationMedical/Healthcare 0.0383540 0.3476054
## occupationBusiness Owner 0.4220693 0.3531783
## occupationCorporate Executive -0.0198627 0.3869974
## occupationEmployee -0.1133250 0.3163957
## occupationPart-time/Temporary -0.0864810 0.3223535
## occupationUnemployed -0.1215570 0.3203573
## occupationAgriculture/Forestry/Fisheries 0.1924773 0.3941935
## occupationProfessional (Lawyer/Tax Accountant, etc.) -0.3827277 0.5259900
## occupationOther -0.0649014 0.3251607
## educationHigh School (In progress) -0.3317927 0.4303337
## educationHigh School Graduate 0.1063706 0.1247968
## educationVocational School (In progress) 0.5681456 0.5436695
## educationVocational School Graduate 0.1313781 0.1325115
## educationJunior College (In progress) 0.6460192 0.5003511
## educationJunior College Graduate 0.1115605 0.1396062
## educationUniversity (In progress) 0.2979606 0.3545646
## educationUniversity Graduate 0.2151854 0.1235805
## educationGraduate School (Master's - In progress) 0.1621467 0.6255008
## educationGraduate School (Master's - Completed) 0.3893498 0.1507275
## educationGraduate School (Ph.D. - Completed) 0.3748349 0.2335931
## educationOther -0.0777756 0.3434599
## educationPrefer not to say 0.1474345 0.1831503
## prefectureAomori -0.2988125 0.2410244
## prefectureIwate -0.3212496 0.2069105
## prefectureMiyagi -0.0363956 0.1650523
## prefectureAkita -0.3413392 0.2480743
## prefectureYamagata -0.2197023 0.2328652
## prefectureFukushima 0.0833673 0.1922162
## prefectureIbaraki -0.2381912 0.1531113
## prefectureTochigi -0.0943096 0.1687073
## prefectureGunma -0.1831240 0.1742329
## prefectureSaitama -0.1772522 0.1107744
## prefectureChiba -0.0997300 0.1115232
## prefectureTokyo -0.0676494 0.0982727
## prefectureKanagawa -0.2130784 0.1040990
## prefectureNiigata -0.2821768 0.1788224
## prefectureToyama 0.0180778 0.2175228
## prefectureIshikawa -0.2421704 0.2574610
## prefectureFukui -0.1083734 0.3526397
## prefectureYamanashi -0.1566871 0.3298051
## prefectureNagano -0.4018662 0.1742216
## prefectureGifu -0.2267138 0.1836589
## prefectureShizuoka -0.2598093 0.1534707
## prefectureAichi -0.2244168 0.1131260
## prefectureMie -0.1049758 0.2074623
## prefectureShiga 0.2719464 0.2114328
## prefectureKyoto 0.0547523 0.1525236
## prefectureOsaka -0.1174643 0.1097121
## prefectureHyogo -0.1045190 0.1198235
## prefectureNara -0.1962465 0.1922787
## prefectureWakayama -0.7301007 0.2928499
## prefectureTottori -0.5040405 0.3323458
## prefectureShimane -0.2420145 0.2973822
## prefectureOkayama -0.3152063 0.1813711
## prefectureHiroshima -0.2478157 0.1492611
## prefectureYamaguchi -0.1844887 0.2586572
## prefectureTokushima 0.0218535 0.5982697
## prefectureKagawa -0.1970838 0.3092759
## prefectureEhime -0.2252224 0.1926845
## prefectureKochi -0.1705359 0.4311486
## prefectureFukuoka 0.0004873 0.1330766
## prefectureSaga -0.1747255 0.2682002
## prefectureNagasaki -0.1090330 0.2681133
## prefectureKumamoto -0.1856245 0.2276272
## prefectureOita -0.0334481 0.2740098
## prefectureMiyazaki -0.1647472 0.2923469
## prefectureKagoshima 0.3130359 0.3535879
## prefectureOkinawa -0.2046333 0.3295384
## t value Pr(>|t|)
## (Intercept) 8.524 < 2e-16 ***
## document_typeB -1.646 0.09981 .
## simplification_factorSimplified 4.012 6.22e-05 ***
## age -1.200 0.23025
## genderFemale -0.467 0.64060
## occupationHomemaker -0.292 0.77019
## occupationSelf-employed -0.178 0.85841
## occupationPublic Official -0.100 0.92063
## occupationTeaching Staff -0.142 0.88732
## occupationMedical/Healthcare 0.110 0.91215
## occupationBusiness Owner 1.195 0.23220
## occupationCorporate Executive -0.051 0.95907
## occupationEmployee -0.358 0.72025
## occupationPart-time/Temporary -0.268 0.78851
## occupationUnemployed -0.379 0.70440
## occupationAgriculture/Forestry/Fisheries 0.488 0.62540
## occupationProfessional (Lawyer/Tax Accountant, etc.) -0.728 0.46692
## occupationOther -0.200 0.84181
## educationHigh School (In progress) -0.771 0.44079
## educationHigh School Graduate 0.852 0.39412
## educationVocational School (In progress) 1.045 0.29613
## educationVocational School Graduate 0.991 0.32158
## educationJunior College (In progress) 1.291 0.19680
## educationJunior College Graduate 0.799 0.42432
## educationUniversity (In progress) 0.840 0.40080
## educationUniversity Graduate 1.741 0.08178 .
## educationGraduate School (Master's - In progress) 0.259 0.79549
## educationGraduate School (Master's - Completed) 2.583 0.00986 **
## educationGraduate School (Ph.D. - Completed) 1.605 0.10872
## educationOther -0.226 0.82088
## educationPrefer not to say 0.805 0.42091
## prefectureAomori -1.240 0.21520
## prefectureIwate -1.553 0.12067
## prefectureMiyagi -0.221 0.82550
## prefectureAkita -1.376 0.16898
## prefectureYamagata -0.943 0.34555
## prefectureFukushima 0.434 0.66454
## prefectureIbaraki -1.556 0.11994
## prefectureTochigi -0.559 0.57621
## prefectureGunma -1.051 0.29336
## prefectureSaitama -1.600 0.10972
## prefectureChiba -0.894 0.37129
## prefectureTokyo -0.688 0.49129
## prefectureKanagawa -2.047 0.04079 *
## prefectureNiigata -1.578 0.11472
## prefectureToyama 0.083 0.93377
## prefectureIshikawa -0.941 0.34701
## prefectureFukui -0.307 0.75863
## prefectureYamanashi -0.475 0.63477
## prefectureNagano -2.307 0.02117 *
## prefectureGifu -1.234 0.21718
## prefectureShizuoka -1.693 0.09062 .
## prefectureAichi -1.984 0.04741 *
## prefectureMie -0.506 0.61291
## prefectureShiga 1.286 0.19851
## prefectureKyoto 0.359 0.71965
## prefectureOsaka -1.071 0.28444
## prefectureHyogo -0.872 0.38316
## prefectureNara -1.021 0.30754
## prefectureWakayama -2.493 0.01274 *
## prefectureTottori -1.517 0.12951
## prefectureShimane -0.814 0.41584
## prefectureOkayama -1.738 0.08237 .
## prefectureHiroshima -1.660 0.09701 .
## prefectureYamaguchi -0.713 0.47577
## prefectureTokushima 0.037 0.97086
## prefectureKagawa -0.637 0.52404
## prefectureEhime -1.169 0.24259
## prefectureKochi -0.396 0.69249
## prefectureFukuoka 0.004 0.99708
## prefectureSaga -0.651 0.51481
## prefectureNagasaki -0.407 0.68429
## prefectureKumamoto -0.815 0.41489
## prefectureOita -0.122 0.90286
## prefectureMiyazaki -0.564 0.57313
## prefectureKagoshima 0.885 0.37609
## prefectureOkinawa -0.621 0.53469
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8349 on 2120 degrees of freedom
## Multiple R-squared: 0.04569, Adjusted R-squared: 0.01148
## F-statistic: 1.336 on 76 and 2120 DF, p-value: 0.0298confint(regression_without_comprehension)["simplification_factorSimplified", ]## 2.5 % 97.5 %
## 0.0746280 0.2173218car::vif(regression_without_comprehension)## GVIF Df GVIF^(1/(2*Df))
## document_type 1.042832 1 1.021192
## simplification_factor 1.043042 1 1.021294
## age 1.353054 1 1.163208
## gender 1.754801 1 1.324689
## occupation 8.121108 13 1.083890
## education 5.429541 13 1.067235
## prefecture 2.098961 46 1.008092調整済みGVIFの最大値は以下のとおりです。
vif_without_comprehension <- car::vif(regression_without_comprehension)
max_adjusted_gvif <- max(vif_without_comprehension[, "GVIF^(1/(2*Df))"])
max_adjusted_gvif## [1] 1.324689この結果は、多重共線性が低いことを示しています。調整済みGVIFの最大値は約1.33です。
regression_with_comprehension <- lm(
acceptance ~ document_type + comprehension + simplification_factor + age +
gender + occupation + education + prefecture,
data = analysis_data
)
summary(regression_with_comprehension)##
## Call:
## lm(formula = acceptance ~ document_type + comprehension + simplification_factor +
## age + gender + occupation + education + prefecture, data = analysis_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.94760 -0.43430 0.02361 0.47789 3.02280
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 1.845006 0.279307
## document_typeB -0.001532 0.029198
## comprehension 0.522624 0.015194
## simplification_factorSimplified 0.053888 0.029273
## age -0.005674 0.001212
## genderFemale 0.009231 0.040217
## occupationHomemaker -0.137856 0.257999
## occupationSelf-employed -0.129847 0.259494
## occupationPublic Official -0.096830 0.268705
## occupationTeaching Staff -0.135804 0.280850
## occupationMedical/Healthcare -0.134188 0.278565
## occupationBusiness Owner 0.246993 0.283031
## occupationCorporate Executive -0.227419 0.310141
## occupationEmployee -0.174345 0.253519
## occupationPart-time/Temporary -0.077112 0.258286
## occupationUnemployed -0.109983 0.256687
## occupationAgriculture/Forestry/Fisheries 0.019148 0.315888
## occupationProfessional (Lawyer/Tax Accountant, etc.) -0.609371 0.421502
## occupationOther -0.121697 0.260541
## educationHigh School (In progress) -0.405347 0.344812
## educationHigh School Graduate 0.050238 0.100007
## educationVocational School (In progress) 0.247162 0.435716
## educationVocational School Graduate 0.029210 0.106217
## educationJunior College (In progress) 0.089370 0.401234
## educationJunior College Graduate 0.022352 0.111890
## educationUniversity (In progress) -0.292772 0.284614
## educationUniversity Graduate 0.060336 0.099121
## educationGraduate School (Master's - In progress) -0.437401 0.501487
## educationGraduate School (Master's - Completed) 0.092321 0.121079
## educationGraduate School (Ph.D. - Completed) 0.010351 0.187467
## educationOther -0.030557 0.275201
## educationPrefer not to say -0.097251 0.146922
## prefectureAomori -0.260468 0.193124
## prefectureIwate -0.194651 0.165828
## prefectureMiyagi 0.079951 0.132292
## prefectureAkita -0.150284 0.198848
## prefectureYamagata 0.012214 0.186705
## prefectureFukushima 0.058372 0.154015
## prefectureIbaraki -0.141195 0.122713
## prefectureTochigi 0.033474 0.135228
## prefectureGunma -0.316059 0.139658
## prefectureSaitama -0.081612 0.088802
## prefectureChiba -0.001146 0.089404
## prefectureTokyo -0.005670 0.078762
## prefectureKanagawa -0.089465 0.083487
## prefectureNiigata -0.354755 0.143297
## prefectureToyama 0.032482 0.174291
## prefectureIshikawa -0.051827 0.206365
## prefectureFukui 0.166651 0.282666
## prefectureYamanashi -0.284641 0.264283
## prefectureNagano -0.166736 0.139763
## prefectureGifu -0.052341 0.147244
## prefectureShizuoka -0.181183 0.122990
## prefectureAichi -0.103316 0.090711
## prefectureMie -0.262729 0.166293
## prefectureShiga 0.064300 0.169518
## prefectureKyoto 0.049786 0.122210
## prefectureOsaka -0.053970 0.087926
## prefectureHyogo -0.068830 0.096014
## prefectureNara -0.124582 0.154078
## prefectureWakayama -0.441345 0.234797
## prefectureTottori -0.364855 0.266323
## prefectureShimane 0.051442 0.238431
## prefectureOkayama -0.210689 0.145356
## prefectureHiroshima -0.144141 0.119634
## prefectureYamaguchi -0.222055 0.207252
## prefectureTokushima 0.234360 0.479404
## prefectureKagawa -0.221838 0.247809
## prefectureEhime -0.132629 0.154412
## prefectureKochi -0.046336 0.345477
## prefectureFukuoka -0.037633 0.106634
## prefectureSaga -0.069472 0.214918
## prefectureNagasaki -0.303327 0.214900
## prefectureKumamoto -0.222236 0.182390
## prefectureOita 0.197220 0.219653
## prefectureMiyazaki -0.135760 0.234245
## prefectureKagoshima 0.246464 0.283320
## prefectureOkinawa -0.161583 0.264046
## t value Pr(>|t|)
## (Intercept) 6.606 4.99e-11 ***
## document_typeB -0.052 0.9582
## comprehension 34.397 < 2e-16 ***
## simplification_factorSimplified 1.841 0.0658 .
## age -4.681 3.03e-06 ***
## genderFemale 0.230 0.8185
## occupationHomemaker -0.534 0.5932
## occupationSelf-employed -0.500 0.6169
## occupationPublic Official -0.360 0.7186
## occupationTeaching Staff -0.484 0.6288
## occupationMedical/Healthcare -0.482 0.6301
## occupationBusiness Owner 0.873 0.3829
## occupationCorporate Executive -0.733 0.4635
## occupationEmployee -0.688 0.4917
## occupationPart-time/Temporary -0.299 0.7653
## occupationUnemployed -0.428 0.6684
## occupationAgriculture/Forestry/Fisheries 0.061 0.9517
## occupationProfessional (Lawyer/Tax Accountant, etc.) -1.446 0.1484
## occupationOther -0.467 0.6405
## educationHigh School (In progress) -1.176 0.2399
## educationHigh School Graduate 0.502 0.6155
## educationVocational School (In progress) 0.567 0.5706
## educationVocational School Graduate 0.275 0.7833
## educationJunior College (In progress) 0.223 0.8238
## educationJunior College Graduate 0.200 0.8417
## educationUniversity (In progress) -1.029 0.3038
## educationUniversity Graduate 0.609 0.5428
## educationGraduate School (Master's - In progress) -0.872 0.3832
## educationGraduate School (Master's - Completed) 0.762 0.4459
## educationGraduate School (Ph.D. - Completed) 0.055 0.9560
## educationOther -0.111 0.9116
## educationPrefer not to say -0.662 0.5081
## prefectureAomori -1.349 0.1776
## prefectureIwate -1.174 0.2406
## prefectureMiyagi 0.604 0.5457
## prefectureAkita -0.756 0.4499
## prefectureYamagata 0.065 0.9478
## prefectureFukushima 0.379 0.7047
## prefectureIbaraki -1.151 0.2500
## prefectureTochigi 0.248 0.8045
## prefectureGunma -2.263 0.0237 *
## prefectureSaitama -0.919 0.3582
## prefectureChiba -0.013 0.9898
## prefectureTokyo -0.072 0.9426
## prefectureKanagawa -1.072 0.2840
## prefectureNiigata -2.476 0.0134 *
## prefectureToyama 0.186 0.8522
## prefectureIshikawa -0.251 0.8017
## prefectureFukui 0.590 0.5555
## prefectureYamanashi -1.077 0.2816
## prefectureNagano -1.193 0.2330
## prefectureGifu -0.355 0.7223
## prefectureShizuoka -1.473 0.1409
## prefectureAichi -1.139 0.2549
## prefectureMie -1.580 0.1143
## prefectureShiga 0.379 0.7045
## prefectureKyoto 0.407 0.6838
## prefectureOsaka -0.614 0.5394
## prefectureHyogo -0.717 0.4735
## prefectureNara -0.809 0.4189
## prefectureWakayama -1.880 0.0603 .
## prefectureTottori -1.370 0.1708
## prefectureShimane 0.216 0.8292
## prefectureOkayama -1.449 0.1474
## prefectureHiroshima -1.205 0.2284
## prefectureYamaguchi -1.071 0.2841
## prefectureTokushima 0.489 0.6250
## prefectureKagawa -0.895 0.3708
## prefectureEhime -0.859 0.3905
## prefectureKochi -0.134 0.8933
## prefectureFukuoka -0.353 0.7242
## prefectureSaga -0.323 0.7465
## prefectureNagasaki -1.411 0.1583
## prefectureKumamoto -1.218 0.2232
## prefectureOita 0.898 0.3694
## prefectureMiyazaki -0.580 0.5623
## prefectureKagoshima 0.870 0.3844
## prefectureOkinawa -0.612 0.5406
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6689 on 2119 degrees of freedom
## Multiple R-squared: 0.3876, Adjusted R-squared: 0.3654
## F-statistic: 17.42 on 77 and 2119 DF, p-value: < 2.2e-16confint(regression_with_comprehension)[
c("comprehension", "simplification_factorSimplified", "age"),
]## 2.5 % 97.5 %
## comprehension 0.49282757 0.552420433
## simplification_factorSimplified -0.00351908 0.111295762
## age -0.00805035 -0.003296729effectsize::standardize_parameters(regression_with_comprehension)## # Standardization method: refit
##
## Parameter | Std. Coef. | 95% CI
## -------------------------------------------------------------------------------------
## (Intercept) | 0.15 | [-0.50, 0.80]
## document type [B] | -1.82e-03 | [-0.07, 0.07]
## comprehension | 0.61 | [ 0.57, 0.64]
## simplification factor [Simplified] | 0.06 | [ 0.00, 0.13]
## age | -0.09 | [-0.13, -0.05]
## gender [Female] | 0.01 | [-0.08, 0.10]
## occupation [Homemaker] | -0.16 | [-0.77, 0.44]
## occupation [Self-employed] | -0.15 | [-0.76, 0.45]
## occupation [Public Official] | -0.12 | [-0.74, 0.51]
## occupation [Teaching Staff] | -0.16 | [-0.82, 0.49]
## occupation [Medical/Healthcare] | -0.16 | [-0.81, 0.49]
## occupation [Business Owner] | 0.29 | [-0.37, 0.96]
## occupation [Corporate Executive] | -0.27 | [-1.00, 0.45]
## occupation [Employee] | -0.21 | [-0.80, 0.38]
## occupation [Part-time/Temporary] | -0.09 | [-0.70, 0.51]
## occupation [Unemployed] | -0.13 | [-0.73, 0.47]
## occupation [Agriculture/Forestry/Fisheries] | 0.02 | [-0.71, 0.76]
## occupation [Professional (Lawyer/Tax Accountant, etc.)] | -0.73 | [-1.71, 0.26]
## occupation [Other] | -0.14 | [-0.75, 0.46]
## education [High School (In progress)] | -0.48 | [-1.29, 0.32]
## education [High School Graduate] | 0.06 | [-0.17, 0.29]
## education [Vocational School (In progress)] | 0.29 | [-0.72, 1.31]
## education [Vocational School Graduate] | 0.03 | [-0.21, 0.28]
## education [Junior College (In progress)] | 0.11 | [-0.83, 1.04]
## education [Junior College Graduate] | 0.03 | [-0.23, 0.29]
## education [University (In progress)] | -0.35 | [-1.01, 0.32]
## education [University Graduate] | 0.07 | [-0.16, 0.30]
## education [Graduate School (Master's - In progress)] | -0.52 | [-1.69, 0.65]
## education [Graduate School (Master's - Completed)] | 0.11 | [-0.17, 0.39]
## education [Graduate School (Ph.D. - Completed)] | 0.01 | [-0.43, 0.45]
## education [Other] | -0.04 | [-0.68, 0.61]
## education [Prefer not to say] | -0.12 | [-0.46, 0.23]
## prefecture [Aomori] | -0.31 | [-0.76, 0.14]
## prefecture [Iwate] | -0.23 | [-0.62, 0.16]
## prefecture [Miyagi] | 0.10 | [-0.21, 0.40]
## prefecture [Akita] | -0.18 | [-0.64, 0.29]
## prefecture [Yamagata] | 0.01 | [-0.42, 0.45]
## prefecture [Fukushima] | 0.07 | [-0.29, 0.43]
## prefecture [Ibaraki] | -0.17 | [-0.45, 0.12]
## prefecture [Tochigi] | 0.04 | [-0.28, 0.36]
## prefecture [Gunma] | -0.38 | [-0.70, -0.05]
## prefecture [Saitama] | -0.10 | [-0.30, 0.11]
## prefecture [Chiba] | -1.36e-03 | [-0.21, 0.21]
## prefecture [Tokyo] | -6.75e-03 | [-0.19, 0.18]
## prefecture [Kanagawa] | -0.11 | [-0.30, 0.09]
## prefecture [Niigata] | -0.42 | [-0.76, -0.09]
## prefecture [Toyama] | 0.04 | [-0.37, 0.45]
## prefecture [Ishikawa] | -0.06 | [-0.54, 0.42]
## prefecture [Fukui] | 0.20 | [-0.46, 0.86]
## prefecture [Yamanashi] | -0.34 | [-0.96, 0.28]
## prefecture [Nagano] | -0.20 | [-0.52, 0.13]
## prefecture [Gifu] | -0.06 | [-0.41, 0.28]
## prefecture [Shizuoka] | -0.22 | [-0.50, 0.07]
## prefecture [Aichi] | -0.12 | [-0.33, 0.09]
## prefecture [Mie] | -0.31 | [-0.70, 0.08]
## prefecture [Shiga] | 0.08 | [-0.32, 0.47]
## prefecture [Kyoto] | 0.06 | [-0.23, 0.34]
## prefecture [Osaka] | -0.06 | [-0.27, 0.14]
## prefecture [Hyogo] | -0.08 | [-0.31, 0.14]
## prefecture [Nara] | -0.15 | [-0.51, 0.21]
## prefecture [Wakayama] | -0.53 | [-1.07, 0.02]
## prefecture [Tottori] | -0.43 | [-1.06, 0.19]
## prefecture [Shimane] | 0.06 | [-0.50, 0.62]
## prefecture [Okayama] | -0.25 | [-0.59, 0.09]
## prefecture [Hiroshima] | -0.17 | [-0.45, 0.11]
## prefecture [Yamaguchi] | -0.26 | [-0.75, 0.22]
## prefecture [Tokushima] | 0.28 | [-0.84, 1.40]
## prefecture [Kagawa] | -0.26 | [-0.84, 0.31]
## prefecture [Ehime] | -0.16 | [-0.52, 0.20]
## prefecture [Kochi] | -0.06 | [-0.86, 0.75]
## prefecture [Fukuoka] | -0.04 | [-0.29, 0.20]
## prefecture [Saga] | -0.08 | [-0.58, 0.42]
## prefecture [Nagasaki] | -0.36 | [-0.86, 0.14]
## prefecture [Kumamoto] | -0.26 | [-0.69, 0.16]
## prefecture [Oita] | 0.23 | [-0.28, 0.75]
## prefecture [Miyazaki] | -0.16 | [-0.71, 0.39]
## prefecture [Kagoshima] | 0.29 | [-0.37, 0.96]
## prefecture [Okinawa] | -0.19 | [-0.81, 0.42]stepwise_model <- step(
regression_with_comprehension,
direction = "both",
trace = 0
)
formula(stepwise_model)## acceptance ~ comprehension + simplification_factor + ageAIC(stepwise_model)## [1] 4466.319parsimonious_model <- lm(
acceptance ~ comprehension + simplification_factor + age,
data = analysis_data
)
parsimonious_summary <- summary(parsimonious_model)
parsimonious_confint <- confint(parsimonious_model)
standardized_beta <- {
x <- model.matrix(parsimonious_model)[, -1]
b <- coef(parsimonious_model)[-1]
sy <- sd(parsimonious_model$model[[1]])
sx <- apply(x, 2, sd)
b * sx / sy
}
table2 <- broom::tidy(parsimonious_model, conf.int = TRUE) |>
dplyr::filter(term != "(Intercept)") |>
dplyr::mutate(
standardized_beta = standardized_beta[term],
p_value = p.value
) |>
dplyr::select(term, estimate, standardized_beta, conf.low, conf.high, p_value)
knitr::kable(table2, digits = 3)| term | estimate | standardized_beta | conf.low | conf.high | p_value |
|---|---|---|---|---|---|
| comprehension | 0.520 | 0.605 | 0.491 | 0.549 | 0.00 |
| simplification_factorSimplified | 0.062 | 0.037 | 0.006 | 0.118 | 0.03 |
| age | -0.004 | -0.072 | -0.006 | -0.002 | 0.00 |
tibble::tibble(
statistic = c("Adjusted R-squared", "F", "df1", "df2", "p", "N"),
value = c(
parsimonious_summary$adj.r.squared,
unname(parsimonious_summary$fstatistic[1]),
unname(parsimonious_summary$fstatistic[2]),
unname(parsimonious_summary$fstatistic[3]),
pf(
parsimonious_summary$fstatistic[1],
parsimonious_summary$fstatistic[2],
parsimonious_summary$fstatistic[3],
lower.tail = FALSE
),
nobs(parsimonious_model)
)
) |>
knitr::kable(digits = 3)| statistic | value |
|---|---|
| Adjusted R-squared | 0.368 |
| F | 426.507 |
| df1 | 3.000 |
| df2 | 2193.000 |
| p | 0.000 |
| N | 2197.000 |
媒介モデルでは、年齢、性別、学歴、職業、居住都道府県を共変量として投入します。
mediate()のbootstrapでまれな因子水準がリサンプルから落ちることによるエラーを
避けるため、因子共変量は明示的にダミー変数化しています。これは、同じ因子を
lm()に直接投入することと代数的に等価です。
covariate_matrix <- model.matrix(
~ age + gender + education + occupation + prefecture,
data = analysis_data
)[, -1]
covariate_matrix <- covariate_matrix[
,
apply(covariate_matrix, 2, sd) > 0,
drop = FALSE
]
colnames(covariate_matrix) <- make.names(colnames(covariate_matrix), unique = TRUE)
mediation_data <- data.frame(
acceptance = analysis_data$acceptance,
comprehension = analysis_data$comprehension,
simplification = analysis_data$simplification,
covariate_matrix,
check.names = FALSE
)
rhs_covariates <- paste(colnames(covariate_matrix), collapse = " + ")
mediator_model <- lm(
as.formula(paste("comprehension ~ simplification +", rhs_covariates)),
data = mediation_data
)
outcome_model <- lm(
as.formula(paste("acceptance ~ simplification + comprehension +", rhs_covariates)),
data = mediation_data
)
coef(summary(mediator_model))["simplification", , drop = FALSE]## Estimate Std. Error t value Pr(>|t|)
## simplification 0.1752619 0.04172813 4.20009 2.778474e-05coef(summary(outcome_model))[c("comprehension", "simplification"), , drop = FALSE]## Estimate Std. Error t value Pr(>|t|)
## comprehension 0.52267034 0.01516461 34.466455 4.427431e-207
## simplification 0.05386735 0.02926369 1.840757 6.579682e-02set.seed(seed_value)
mediation_fit <- mediation::mediate(
model.m = mediator_model,
model.y = outcome_model,
treat = "simplification",
mediator = "comprehension",
control.value = 0,
treat.value = 1,
boot = TRUE,
sims = 2000
)
summary(mediation_fit)##
## Causal Mediation Analysis
##
## Nonparametric Bootstrap Confidence Intervals with the Percentile Method
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME 0.0916042 0.0462079 0.1362789 <2e-16 ***
## ADE 0.0538673 -0.0037122 0.1115242 0.073 .
## Total Effect 0.1454715 0.0746356 0.2170588 <2e-16 ***
## Prop. Mediated 0.6297053 0.3864092 1.0378665 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 2197
##
##
## Simulations: 2000mediation_report <- tibble::tibble(
effect = c("ACME", "ADE", "総合効果", "媒介割合"),
estimate = c(
mediation_fit$d0,
mediation_fit$z0,
mediation_fit$tau.coef,
mediation_fit$n0
),
ci_low = c(
mediation_fit$d0.ci[1],
mediation_fit$z0.ci[1],
mediation_fit$tau.ci[1],
mediation_fit$n0.ci[1]
),
ci_high = c(
mediation_fit$d0.ci[2],
mediation_fit$z0.ci[2],
mediation_fit$tau.ci[2],
mediation_fit$n0.ci[2]
),
p_value = c(
mediation_fit$d0.p,
mediation_fit$z0.p,
mediation_fit$tau.p,
mediation_fit$n0.p
)
)
knitr::kable(mediation_report, digits = 4)| effect | estimate | ci_low | ci_high | p_value |
|---|---|---|---|---|
| ACME | 0.0916 | 0.0462 | 0.1363 | 0.000 |
| ADE | 0.0539 | -0.0037 | 0.1115 | 0.073 |
| 総合効果 | 0.1455 | 0.0746 | 0.2171 | 0.000 |
| 媒介割合 | 0.6297 | 0.3864 | 1.0379 | 0.000 |
上記の乱数種に基づく再実行でも、ADEは統計的に有意ではありません。
sensitivity_fit <- mediation::medsens(
mediation_fit,
rho.by = 0.01,
effect.type = "indirect"
)
summary(sensitivity_fit)##
## Mediation Sensitivity Analysis for Average Causal Mediation Effect
##
## Sensitivity Region
##
## Rho ACME 95% CI Lower 95% CI Upper R^2_M*R^2_Y* R^2_M~R^2_Y~
## [1,] 0.58 0.0045 -0.0010 0.0100 0.3364 0.1913
## [2,] 0.59 0.0022 -0.0030 0.0074 0.3481 0.1980
## [3,] 0.60 -0.0002 -0.0053 0.0049 0.3600 0.2047
## [4,] 0.61 -0.0026 -0.0079 0.0027 0.3721 0.2116
## [5,] 0.62 -0.0051 -0.0107 0.0005 0.3844 0.2186
##
## Rho at which ACME = 0: 0.6
## R^2_M*R^2_Y* at which ACME = 0: 0.36
## R^2_M~R^2_Y~ at which ACME = 0: 0.2047sensitivity_values <- tibble::tibble(
rho_at_acme_zero = sensitivity_fit$err.cr.d,
R2star_product = sensitivity_fit$R2star.d.thresh,
R2tilde_product = sensitivity_fit$R2tilde.d.thresh,
r2_mediator_model = sensitivity_fit$r.square.m,
r2_outcome_model = sensitivity_fit$r.square.y
)
knitr::kable(sensitivity_values, digits = 3)| rho_at_acme_zero | R2star_product | R2tilde_product | r2_mediator_model | r2_outcome_model |
|---|---|---|---|---|
| 0.6 | 0.36 | 0.205 | 0.071 | 0.388 |
補遺用の任意プロット:
plot(
sensitivity_fit,
sens.par = "rho",
main = "媒介感度分析"
)x_lasso <- model.matrix(
acceptance ~ simplification + comprehension + age + gender +
education + occupation + prefecture,
data = analysis_data
)[, -1]
y_lasso <- analysis_data$acceptance
set.seed(seed_value)
cv_lasso <- glmnet::cv.glmnet(
x = x_lasso,
y = y_lasso,
alpha = 1,
nfolds = 10,
standardize = TRUE
)
nonzero_coefs <- function(cvfit, s) {
b <- as.matrix(coef(cvfit, s = s))
out <- tibble::tibble(
term = rownames(b),
coefficient = as.numeric(b[, 1])
)
dplyr::filter(out, term != "(Intercept)", coefficient != 0)
}
lasso_lambda_min <- nonzero_coefs(cv_lasso, "lambda.min")
lasso_lambda_1se <- nonzero_coefs(cv_lasso, "lambda.1se")
cv_lasso$lambda.min## [1] 0.02135956knitr::kable(lasso_lambda_min, digits = 4)| term | coefficient |
|---|---|
| simplification | 0.0211 |
| comprehension | 0.4976 |
| age | -0.0028 |
| occupationBusiness Owner | 0.1744 |
| prefectureGunma | -0.0586 |
| prefectureTokyo | 0.0185 |
| prefectureNiigata | -0.0877 |
| prefectureWakayama | -0.0708 |
| prefectureOita | 0.0266 |
cv_lasso$lambda.1se## [1] 0.1139896knitr::kable(lasso_lambda_1se, digits = 4)| term | coefficient |
|---|---|
| comprehension | 0.4005 |
stepwise_terms <- c("comprehension", "simplification", "age")
tibble::tibble(
term = stepwise_terms,
retained_at_lambda_min = stepwise_terms %in% lasso_lambda_min$term,
retained_at_lambda_1se = stepwise_terms %in% lasso_lambda_1se$term
) |>
knitr::kable()| term | retained_at_lambda_min | retained_at_lambda_1se |
|---|---|---|
| comprehension | TRUE | TRUE |
| simplification | TRUE | FALSE |
| age | TRUE | FALSE |
lambda.minでは、stepwise-AICによる節約モデルに含まれる3つの予測変数が
すべて保持されます。一方、より保守的なlambda.1seでは理解度のみが保持されます。
これは、平易化と年齢の係数の大きさが相対的に小さいことと整合的です。
ordered_logit_model <- MASS::polr(
acceptance_ord ~ comprehension + simplification + age,
data = analysis_data,
method = "logistic",
Hess = TRUE
)
ordered_logit_table <- coef(summary(ordered_logit_model))
ordered_logit_p <- 2 * pnorm(
abs(ordered_logit_table[, "t value"]),
lower.tail = FALSE
)
ordered_logit_results <- tibble::tibble(
term = rownames(ordered_logit_table),
estimate = ordered_logit_table[, "Value"],
std_error = ordered_logit_table[, "Std. Error"],
t_value = ordered_logit_table[, "t value"],
p_value = ordered_logit_p,
odds_ratio = c(exp(coef(ordered_logit_model)), rep(NA_real_, 4))
)
knitr::kable(ordered_logit_results, digits = 4)| term | estimate | std_error | t_value | p_value | odds_ratio |
|---|---|---|---|---|---|
| comprehension | 1.7270 | 0.0604 | 28.6145 | 0.0000 | 5.6239 |
| simplification | 0.1952 | 0.0857 | 2.2788 | 0.0227 | 1.2156 |
| age | -0.0140 | 0.0031 | -4.4615 | 0.0000 | 0.9861 |
| 1|2 | 0.5340 | 0.2156 | 2.4768 | 0.0133 | NA |
| 2|3 | 2.7215 | 0.2165 | 12.5697 | 0.0000 | NA |
| 3|4 | 6.2032 | 0.2551 | 24.3127 | 0.0000 | NA |
| 4|5 | 9.2018 | 0.3143 | 29.2814 | 0.0000 | NA |
interaction_model <- lm(
acceptance ~ simplification * document_type + age + gender +
occupation + education + prefecture,
data = analysis_data
)
main_effect_model <- lm(
acceptance ~ simplification + document_type + age + gender +
occupation + education + prefecture,
data = analysis_data
)
interaction_model_with_comprehension <- lm(
acceptance ~ comprehension + simplification * document_type + age +
gender + occupation + education + prefecture,
data = analysis_data
)
main_effect_model_with_comprehension <- lm(
acceptance ~ comprehension + simplification + document_type + age +
gender + occupation + education + prefecture,
data = analysis_data
)
interaction_terms <- grep(
"simplification.*:document_type|document_type.*:simplification",
rownames(coef(summary(interaction_model)))
)
interaction_terms_with_comprehension <- grep(
"simplification.*:document_type|document_type.*:simplification",
rownames(coef(summary(interaction_model_with_comprehension)))
)
coef(summary(interaction_model))[interaction_terms, , drop = FALSE]## Estimate Std. Error t value Pr(>|t|)
## simplification:document_typeB -0.06205391 0.07256336 -0.8551686 0.3925545anova(main_effect_model, interaction_model)## Analysis of Variance Table
##
## Model 1: acceptance ~ simplification + document_type + age + gender +
## occupation + education + prefecture
## Model 2: acceptance ~ simplification * document_type + age + gender +
## occupation + education + prefecture
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 2120 1477.6
## 2 2119 1477.1 1 0.50978 0.7313 0.3926coef(summary(interaction_model_with_comprehension))[
interaction_terms_with_comprehension,
,
drop = FALSE
]## Estimate Std. Error t value Pr(>|t|)
## simplification:document_typeB -0.05121195 0.05814177 -0.8808117 0.3785197anova(main_effect_model_with_comprehension, interaction_model_with_comprehension)## Analysis of Variance Table
##
## Model 1: acceptance ~ comprehension + simplification + document_type +
## age + gender + occupation + education + prefecture
## Model 2: acceptance ~ comprehension + simplification * document_type +
## age + gender + occupation + education + prefecture
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 2119 948.18
## 2 2118 947.84 1 0.3472 0.7758 0.3785追加確認の結果は、主要な解釈を支持しています。
p < .001で統計的に有意です。lambda.minで節約モデルの3変数がすべて保持されます。一方、
より保守的なlambda.1seでは理解度のみが保持されます。以下は、このR Markdownをknitした時点の実行環境です。公開用分析の対象環境は R v.4.5.1です。
sessionInfo()## R version 4.5.1 (2025-06-13)
## Platform: aarch64-apple-darwin20
## Running under: macOS Tahoe 26.5.1
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.1
##
## locale:
## [1] C.UTF-8/C.UTF-8/C.UTF-8/C/C.UTF-8/C.UTF-8
##
## time zone: Asia/Tokyo
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] knitr_1.50 glmnet_5.0 mediation_4.5.1 sandwich_3.1-1
## [5] mvtnorm_1.3-3 Matrix_1.7-3 MASS_7.3-65 broom_1.0.8
## [9] effectsize_1.0.1 emmeans_1.11.1 car_3.1-3 carData_3.0-5
## [13] purrr_1.0.4 tidyr_1.3.1 tibble_3.3.0 forcats_1.0.0
## [17] dplyr_1.1.4 readr_2.1.5
##
## loaded via a namespace (and not attached):
## [1] tidyselect_1.2.1 farver_2.1.2 S7_0.2.1 fastmap_1.2.0
## [5] bayestestR_0.17.0 digest_0.6.37 rpart_4.1.24 estimability_1.5.1
## [9] lifecycle_1.0.4 cluster_2.1.8.1 survival_3.8-3 magrittr_2.0.3
## [13] compiler_4.5.1 rlang_1.1.6 Hmisc_5.2-3 sass_0.4.10
## [17] tools_4.5.1 yaml_2.3.10 data.table_1.17.4 htmlwidgets_1.6.4
## [21] bit_4.6.0 RColorBrewer_1.1-3 abind_1.4-8 withr_3.0.2
## [25] foreign_0.8-90 nnet_7.3-20 grid_4.5.1 datawizard_1.2.0
## [29] colorspace_2.1-1 ggplot2_4.0.2 iterators_1.0.14 scales_1.4.0
## [33] insight_1.4.2 cli_3.6.5 crayon_1.5.3 rmarkdown_2.29
## [37] reformulas_0.4.1 generics_0.1.4 rstudioapi_0.17.1 tzdb_0.5.0
## [41] parameters_0.28.1 minqa_1.2.8 cachem_1.1.0 stringr_1.5.1
## [45] splines_4.5.1 parallel_4.5.1 base64enc_0.1-3 vctrs_0.6.5
## [49] boot_1.3-31 jsonlite_2.0.0 hms_1.1.3 bit64_4.6.0-1
## [53] Formula_1.2-5 htmlTable_2.4.3 foreach_1.5.2 jquerylib_0.1.4
## [57] glue_1.8.0 nloptr_2.2.1 codetools_0.2-20 shape_1.4.6.1
## [61] stringi_1.8.7 gtable_0.3.6 lme4_1.1-37 pillar_1.10.2
## [65] htmltools_0.5.8.1 R6_2.6.1 Rdpack_2.6.4 vroom_1.6.5
## [69] evaluate_1.0.3 lpSolve_5.6.23 lattice_0.22-7 rbibutils_2.3
## [73] backports_1.5.0 bslib_0.9.0 Rcpp_1.0.14 gridExtra_2.3
## [77] nlme_3.1-168 checkmate_2.3.2 xfun_0.52 zoo_1.8-14
## [81] pkgconfig_2.0.3