RESPONDENTS’ PREFERRED SURVEY TOPICS: MEASUREMENT AND PREVALENCE
Replication Files: Study 1
Tobias Gummer, Saskia Bartholomäus, and Bernd Weiss
19.01.2026
Introduction
Gummer, Tobias, Bartholomäus, Saskia, and Weiss, Bernd (2026): “Respondents’ Preferred Survey Topics: Measurement and Prevalence.” Survey Research Methods.
Respondents’ interest in a survey’s topic is used frequently by survey researchers to explain and predict survey errors. Whether respondents are interested in a survey’s content relates to their participation and cognitive answering processes, which consequently impacts nonresponse and measurement errors. Since the content of a survey is under the control of the researchers who design and conduct it, the content could be varied to improve participation and answering behavior. Unfortunately, research is lacking as to (i) how to measure these preferences, (ii) whether groups of respondents differ in their topic preferences, and (iii) the topic preferences in the social science survey samples. We have addressed this research gap by presenting the findings of three experimental studies that we conducted. In our study, we validated a measurement instrument to assess respondents’ topic interests. Moreover, we found that topic preferences varied between samples and respondent subgroups. However, across samples we consistently found that respondents were more interested in answering questions on personal rather than political topics. Based on our empirical findings, we provide practical recommendations for survey research and outline future research opportunities.
The ReplicationFileStudy1.html contains all analyses of study 1 reported in the cited article. The published R.Rmd files allow users to replicate the results. The data required for the replication code can be granted for scientific purposes upon request. To reproduce the analyses, please follow these steps:
- Place all R.Rmd files in a subfolder named scripts and the data set in a subfolder named data.
- Required R packages are listed and loaded in 01am_pre.Rmd. Please review this file to ensure that all necessary packages are installed before proceeding. Note that running 01am_pre.Rmd will automatically create all required subfolders for the workflow.
- For the file 02dp_pre.Rmd, include the path to required data set in the first code chunk.
- After making any necessary adjustments, you only need to run 05re_pre.Rmd. This file will source all other scripts and reproduce the analyses and results as described in the project.
Bartholomäus, S., and Gummer, T. (2025). PrADePS Pretest (SDN-10.7802-2635; Version 1.0.0) [Data set]. https://doi.org/10.7802/2635
# Random Number Generation
set.seed(42)Data Preparation
The data required for the replication code can be granted for scientific purposes upon request.
Bartholomäus, S., and Gummer, T. (2025). PrADePS Pretest (SDN-10.7802-2635; Version 1.0.0) [Data set]. https://doi.org/10.7802/2635
# Loading Dataset
cat("pretest_csv <- read.csv(file = '[INCLUDE PATH TO THE PRETEST DATA SET HERE]/20251007_PrADePSPretestData.csv', sep = ';')")## pretest_csv <- read.csv(file = '[INCLUDE PATH TO THE PRETEST DATA SET HERE]/20251007_PrADePSPretestData.csv', sep = ';')# Renaming Variables
pretest_csv <- dplyr::rename(
pretest_csv, #dataset
i_gender = v_2683, #newname = oldname
i_birthyear = rtr3p1_y,
i_education = v_2686,
i_state = v_2687,
i_polinterest = jazc030a,
s_interesting = jazq001a,
m_migration = v_2925,
m_pol = v_2927,
m_crisis = v_2932,
m_nature = v_2881,
m_economy = v_2882,
m_work = v_2886,
m_media = v_2890,
m_well = v_2891,
m_values = v_2895,
i_comp = v_2803)# Variable Labels
labels <- list(
i_gender = "Gender",
i_birthyear = "Year of Birth",
i_age = "Age in Years",
i_education = "Educaional Level",
i_state = "Federal State",
i_east = "Eastern Germany",
i_polinterest = "Political Interest",
st_polinterest = "Political Interest",
s_interesting = "Survey is Interesting",
tp_pol = "Topic Interest Politics",
tp_well = "Topic Interest Well-Being",
tp_nature = "Topic Interest Nature",
tp_values = "Topic Interest Values",
tp_media = "Topic Interest Media",
tp_work = "Topic Interest Work",
tp_migration = "Topic Interest Migration",
tp_economy = "Topic Interest Economy",
tp_crisis = "Topic Interest Crisis",
vb_quest = "Questionnaire",
vb_explain = "Explanaition",
vb_comp = "Matrix")# Creating Subsets
subset <- select(pretest_csv, lfdn, duration, i_gender : i_polinterest, s_interesting, v_2786 : v_2802, rnd_pg_7235041 : rnd_pg_7236459,
m_migration, m_values, m_pol, m_crisis, m_nature, m_economy, m_work, m_media, m_well, i_comp)
# subset for balance tests
balance <- select(pretest_csv, i_gender : i_state)# Defining Missing Values
pretest_csv[pretest_csv == -111 | pretest_csv == -77] <- NA
subset[subset == -111 | subset == -77 | subset == 97 | subset == 98 | subset == 99] <- NA
subset$lfdn <- pretest_csv$lfdn
subset$duration <- pretest_csv$duration
subset$duration[subset$duration == -111] <- NA# Defining Experimental Groups
subset <- mutate(subset, vb_quest = ifelse(rnd_pg_7235041 == 7234835, 1, 0))
balance$vb_quest <- subset$vb_quest
subset <- mutate(subset, vb_explain = ifelse(rnd_pg_7235688 == 7235696, 1, 0))
balance$vb_explain <- subset$vb_explain
subset <- mutate(subset, vb_comp = case_match(rnd_pg_7236459, 7236339 ~ 1, 7236470 ~ 2, 7236473 ~ 3))
balance$vb_comp <- subset$vb_comp
subset <- set_labels(subset, vb_quest, labels = c("Politics" = 0, "Well-Being" = 1))
subset <- set_labels(subset, vb_explain, labels = c("without Example" = 0, "with Example" = 1))
subset <- set_labels(subset, vb_comp, labels = c("Economy, Work, Nature" = 1, "Media, Well-Being, Values" = 2, "Migration, Politics, Crisis" = 3))# Merging Variables of Groups
subset <- mutate(subset, tp_pol = ifelse(!is.na(subset$v_2785), v_2785, v_2795))
subset <- mutate(subset, tp_well = ifelse(!is.na(subset$v_2786), v_2786, v_2794))
subset <- mutate(subset, tp_nature = ifelse(!is.na(subset$v_2787), v_2787, v_2796))
subset <- mutate(subset, tp_values = ifelse(!is.na(subset$v_2788), v_2788, v_2797))
subset <- mutate(subset, tp_media = ifelse(!is.na(subset$v_2789), v_2789, v_2798))
subset <- mutate(subset, tp_work = ifelse(!is.na(subset$v_2790), v_2790, v_2799))
subset <- mutate(subset, tp_migration = ifelse(!is.na(subset$v_2791), v_2791, v_2800))
subset <- mutate(subset, tp_economy = ifelse(!is.na(subset$v_2792), v_2792, v_2801))
subset <- mutate(subset, tp_crisis = ifelse(!is.na(subset$v_2793), v_2793, v_2802))
subset <- set_labels(subset, tp_pol, tp_well, tp_nature, tp_values, tp_crisis, tp_media, tp_work, tp_migration, tp_economy,
labels = c("not interested at all" = 1, "very interested" = 7))
# share of correct assessments
subset$m1 <- rowMeans(subset(pretest_csv, select = c(m_migration, m_pol, m_crisis)), na.rm = FALSE)
subset$m2 <- rowMeans(subset(pretest_csv, select = c(m_nature, m_economy, m_work)), na.rm = FALSE)
subset$m3 <- rowMeans(subset(pretest_csv, select = c(m_media, m_well, m_values)), na.rm = FALSE)
subset$matrix_mean <- subset$m1
subset <- mutate(subset, matrix_mean = ifelse(!is.na(subset$matrix_mean), matrix_mean, m2))
subset <- mutate(subset, matrix_mean = ifelse(!is.na(subset$matrix_mean), matrix_mean, m3))# Defining Data Quality Indicators
topic <- select(subset, tp_pol : tp_crisis)
# extreme responding
as.data.frame(extreme <- 1 * (topic == 1 | topic == 7))
subset$extreme <- (rowSums(extreme, na.rm = FALSE))/9
# midpoint responding
as.data.frame(midpoint <- 1 * (topic == 4))
subset$midpoint <- (rowSums(midpoint, na.rm = FALSE))/9
# item nonresponse
as.data.frame(na <- 1 * (is.na(topic)))
subset$na <- (rowSums(na, na.rm = FALSE))/9
# acquiescence
as.data.frame(acquiescence <- 1 * (topic == 7 | topic == 6 | topic == 5))
subset$acquiescence <- (rowSums(acquiescence, na.rm = FALSE))/9
# comprehensability
subset$i_comp <- (subset$i_comp - 1) / 6# Recoding Gender: randomly replace diverse values
diverse <- subset$i_gender == 3
subset$i_gender <- replace(subset$i_gender, diverse, sample(1:2, sum(diverse), TRUE, prob = c(0.5, 0.5)))
rm(diverse)# Categorizing Education
subset <- mutate(subset, i_education = case_match(i_education,
1 ~ 2, 2 ~ 1, 3 ~ 1, 4 ~ 1, 5 ~ 2, 6 ~ 1, 7 ~ 2, 8 ~ 3, 9 ~ 3))
balance$i_education <- subset$i_education
subset <- set_labels(subset, i_education, labels = c("low" = 1, "medium" = 2, "high" = 3))# Recoding Political Interest
subset <- mutate(subset, i_polinterest = case_match(i_polinterest, 1 ~ 5, 2 ~ 4, 3 ~ 3, 4 ~ 2, 5 ~ 1))
subset <- set_labels(subset, i_polinterest, labels = c("not at all" = 1, "very strong" = 5))# Recoding Age in Years
subset <- mutate(subset, i_age = 2022-i_birthyear)
balance$i_age <- subset$i_age
subset <- mutate(subset, age_group = case_when(i_age <= 30 ~ 1, i_age > 30 & i_age <= 48 ~ 2, i_age > 48 & i_age <= 63 ~ 3, i_age > 63 ~ 4))
subset <- set_labels(subset, age_group, labels = c("<= 30" = 1, "> 30 & <= 49" = 2, "> 49 & <= 63" = 3, "> 63" = 4))# Recoding Residence in Germany
subset <- mutate(subset, i_east = ifelse( #gen var east
i_state == 3 | i_state == 4 | i_state == 8 | #2 if i_state = x
i_state == 13 | i_state == 14 |i_state == 16, 2, 1)) #else 1
subset <- set_labels(subset, i_east, labels = c("West Germany" = 1, "East Germany" = 2))
balance <- mutate(balance, i_east = ifelse(i_state == 3 | i_state == 4 | i_state == 8 | i_state == 13 | i_state == 14 |i_state == 16, 2, 1))
balance <- mutate(balance, i_east = ifelse(i_state == 99, 0, i_east))# Defining Factor Variables
subset$vb_quest <- as_factor(subset$vb_quest)
subset$vb_explain <- as_factor(subset$vb_explain)
subset$i_gender <- as_factor(subset$i_gender)
subset$i_education <- as_factor(subset$i_education)
subset$i_east <- as_factor(subset$i_east)
subset$age_group <- as_factor(subset$age_group)
#response$device_type <- as_factor(response$device_type)# Structure Dataset: long format
long <- gather(subset, variable, matrix, m_migration:m_well)
matrix1_long <- filter(long, vb_comp == 1, variable == "m_economy" | variable == "m_work" | variable == "m_nature")
matrix2_long <- filter(long, vb_comp == 2, variable == "m_media" | variable == "m_well" | variable == "m_values")
matrix3_long <- filter(long, vb_comp == 3, variable == "m_migration" | variable == "m_pol" | variable == "m_crisis")
long <- smartbind(matrix1_long, matrix2_long, matrix3_long)
rm(matrix1_long, matrix2_long, matrix3_long)
long$tp_interest <- 0
long <- mutate(long, tp_interest = ifelse(variable == "m_migration", tp_migration, tp_interest))
long <- mutate(long, tp_interest = ifelse(variable == "m_crisis", tp_crisis, tp_interest))
long <- mutate(long, tp_interest = ifelse(variable == "m_economy", tp_economy, tp_interest))
long <- mutate(long, tp_interest = ifelse(variable == "m_media", tp_media, tp_interest))
long <- mutate(long, tp_interest = ifelse(variable == "m_nature", tp_nature, tp_interest))
long <- mutate(long, tp_interest = ifelse(variable == "m_pol", tp_pol, tp_interest))
long <- mutate(long, tp_interest = ifelse(variable == "m_values", tp_values, tp_interest))
long <- mutate(long, tp_interest = ifelse(variable == "m_well", tp_well, tp_interest))
long <- mutate(long, tp_interest = ifelse(variable == "m_work", tp_work, tp_interest))# Save Datasets
save(subset, labels, file = "data/subset.RData")
save(balance, labels, file = "data/balance.RData")
save(long, labels, file = "data/long.RData")# Clearing Memory
rm(list = setdiff(ls(), c("custom_theme")))Balance Test
# Loading Datasets
load("data/balance.RData")Age in Years
bartlett.test(i_age ~ vb_explain, data = balance)##
## Bartlett test of homogeneity of variances
##
## data: i_age by vb_explain
## Bartlett's K-squared = 0.057939, df = 1, p-value = 0.8098tab <- map_df(list(t.test(balance$i_age ~ balance$vb_quest, var.equal = TRUE, alternative = "two.sided")), tidy)
tab[c("estimate", "statistic", "p.value", "conf.low", "conf.high", "method")] %>%
kbl(align = "llllll", col.names = c("Difference in Means", "t", "p.value", "conf.low", "conf.high", "Method"), digits = 3, caption = "Balance Test: Age in Years") %>%
kable_styling()| Difference in Means | t | p.value | conf.low | conf.high | Method |
|---|---|---|---|---|---|
| 0.354 | 0.376 | 0.707 | -1.496 | 2.204 | Two Sample t-test |
rm(tab)Gender (w/o diverse persons)
balance$i_gender[balance$i_gender == 3] <- NA
balance$i_gender <- as_factor(balance$i_gender)
balance$vb_explain <- as_factor(balance$vb_explain)
tab <- map_df(list(chisq.test(balance$i_gender, balance$vb_explain)), tidy)
tab[c("statistic", "p.value", "parameter", "method")] %>%
kbl(align = "llll", col.names = c("Chisq", "p.value", "df", "Method"), digits = 3, caption = "Balance Test: Gender (excluding diverse persons)") %>%
kable_styling()| Chisq | p.value | df | Method |
|---|---|---|---|
| 0.168 | 0.682 | 1 | Pearson’s Chi-squared test with Yates’ continuity correction |
rm(tab)Education (by category)
balance$i_education <- as_factor(balance$i_education)
tab <- map_df(list(chisq.test(balance$i_education, balance$vb_explain)), tidy)
tab[c("statistic", "p.value", "parameter", "method")] %>%
kbl(align = "llll", col.names = c("Chisq", "p.value", "df", "Method"), digits = 3, caption = "Balance Test: Education (by category)") %>%
kable_styling()| Chisq | p.value | df | Method |
|---|---|---|---|
| 10.026 | 0.007 | 2 | Pearson’s Chi-squared test |
tab <- table(balance$i_education, balance$vb_quest)
tab_df <- as.data.frame.matrix(tab)
rownames(tab_df) <- c("Low", "Intermediate", "High")
kable(tab_df, align = "llll", col.names = c("without Example", "with Example"), row.names = TRUE, caption = "Number of Respondents by Education and Treatment") %>%
kable_styling()| without Example | with Example | |
|---|---|---|
| Low | 181 | 183 |
| Intermediate | 183 | 187 |
| High | 189 | 178 |
rm(tab)Residence in Germany
balance$i_east <- as_factor(balance$i_east)
tab <- map_df(list(chisq.test(balance$i_east, balance$vb_explain)), tidy)
tab[c("statistic", "p.value", "parameter", "method")] %>%
kbl(align = "llll", col.names = c("Chisq", "p.value", "df", "Method"), digits = 3, caption = "Balance Test: Residence in Germany (by state)") %>%
kable_styling()| Chisq | p.value | df | Method |
|---|---|---|---|
| 0.701 | 0.704 | 2 | Pearson’s Chi-squared test |
rm(tab, balance)Descriptive Results
# Loading Datasets
load("data/subset.RData")Experimental Group
sumtable(subset, vars = "vb_explain", label = "Questionnaire", out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Percent |
|---|---|---|
| Questionnaire | 1101 | |
| … 0 | 518 | 47% |
| … 1 | 583 | 53% |
Age in Years
sumtable(subset, vars = "i_age", label = "Age in Years", add.median = TRUE, digits = 3, out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Mean | Std. Dev. | Min | Pctl. 25 | Pctl. 50 | Pctl. 75 | Max |
|---|---|---|---|---|---|---|---|---|
| Age in Years | 1101 | 45.2 | 15.6 | 18 | 32 | 45 | 57 | 87 |
sumtable(subset, vars = "age_group", label = "Age Group", out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Percent |
|---|---|---|
| Age Group | 1101 | |
| … 1 | 243 | 22% |
| … 2 | 397 | 36% |
| … 3 | 304 | 28% |
| … 4 | 157 | 14% |
Gender
sumtable(subset, vars = "i_gender", label = "Gender", out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Percent |
|---|---|---|
| Gender | 1101 | |
| … 1 | 549 | 50% |
| … 2 | 552 | 50% |
Education
sumtable(subset, vars = "i_education", label = "Education", out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Percent |
|---|---|---|
| Education | 1101 | |
| … 1 | 364 | 33% |
| … 2 | 370 | 34% |
| … 3 | 367 | 33% |
Eastern Germany
sumtable(subset, vars = "i_east", label = "Residence in Germany", out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Percent |
|---|---|---|
| Residence in Germany | 1024 | |
| … 1 | 792 | 77% |
| … 2 | 232 | 23% |
Interest in Survey
sumtable(subset, vars = "s_interesting", label = "Interestingness of the Survey", add.median = TRUE, digits = 3, out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Mean | Std. Dev. | Min | Pctl. 25 | Pctl. 50 | Pctl. 75 | Max |
|---|---|---|---|---|---|---|---|---|
| Interestingness of the Survey | 1099 | 3.76 | 0.978 | 1 | 3 | 4 | 5 | 5 |
Acquiescence
sumtable(subset, vars = "acquiescence", label = "Acquiescence", add.median = TRUE, digits = 3, out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Mean | Std. Dev. | Min | Pctl. 25 | Pctl. 50 | Pctl. 75 | Max |
|---|---|---|---|---|---|---|---|---|
| Acquiescence | 1060 | 0.582 | 0.327 | 0 | 0.333 | 0.667 | 0.889 | 1 |
Extreme
sumtable(subset, vars = "extreme", label = "Extreme Responding", add.median = TRUE, digits = 3, out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Mean | Std. Dev. | Min | Pctl. 25 | Pctl. 50 | Pctl. 75 | Max |
|---|---|---|---|---|---|---|---|---|
| Extreme Responding | 1060 | 0.254 | 0.309 | 0 | 0 | 0.111 | 0.444 | 1 |
Midpoint
sumtable(subset, vars = "midpoint", label = "Midpoint Responding", add.median = TRUE, digits = 3, out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Mean | Std. Dev. | Min | Pctl. 25 | Pctl. 50 | Pctl. 75 | Max |
|---|---|---|---|---|---|---|---|---|
| Midpoint Responding | 1060 | 0.239 | 0.256 | 0 | 0 | 0.222 | 0.333 | 1 |
Item Nonresponse
sumtable(subset, vars = "na", label = "Item Nonresponse", add.median = TRUE, digits = 3, out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Mean | Std. Dev. | Min | Pctl. 25 | Pctl. 50 | Pctl. 75 | Max |
|---|---|---|---|---|---|---|---|---|
| Item Nonresponse | 1101 | 0.00626 | 0.0448 | 0 | 0 | 0 | 0 | 0.778 |
Comprehension
sumtable(subset, vars = "i_comp", label = "Comprehension", add.median = TRUE, digits = 3, out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Mean | Std. Dev. | Min | Pctl. 25 | Pctl. 50 | Pctl. 75 | Max |
|---|---|---|---|---|---|---|---|---|
| Comprehension | 1097 | 0.827 | 0.219 | 0 | 0.667 | 1 | 1 | 1 |
Correct Assessment
sumtable(subset, vars = "matrix_mean", label = "Correct Assessment", add.median = TRUE, digits = 3, out = "kable") %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Mean | Std. Dev. | Min | Pctl. 25 | Pctl. 50 | Pctl. 75 | Max |
|---|---|---|---|---|---|---|---|---|
| Correct Assessment | 1101 | 0.733 | 0.337 | 0 | 0.333 | 1 | 1 | 1 |
Measurement Properties
Topic Popularity
subset_tp <- select(subset, tp_nature, tp_crisis, tp_values, tp_economy, tp_well, tp_migration, tp_work, tp_pol, tp_media )
subset_tp <- subset_tp[complete.cases(subset_tp), ]
sumtable(subset_tp, vars=c("tp_well", "tp_values", "tp_nature", "tp_crisis",
"tp_work", "tp_economy", "tp_pol", "tp_media", "tp_migration"),
labels = c("Well-Being", "Values", "Nature", "Crisis", "Work", "Economy",
"Politics", "Media", "Migration"), out = "kable", add.median = TRUE, digits = 3) %>%
kableExtra::kable_styling(bootstrap_options = "basic")| Variable | N | Mean | Std. Dev. | Min | Pctl. 25 | Pctl. 50 | Pctl. 75 | Max |
|---|---|---|---|---|---|---|---|---|
| Well-Being | 1060 | 5.3 | 1.41 | 1 | 4 | 5 | 7 | 7 |
| Values | 1060 | 5.23 | 1.49 | 1 | 4 | 5 | 7 | 7 |
| Nature | 1060 | 5.05 | 1.61 | 1 | 4 | 5 | 7 | 7 |
| Crisis | 1060 | 4.96 | 1.66 | 1 | 4 | 5 | 6 | 7 |
| Work | 1060 | 4.88 | 1.54 | 1 | 4 | 5 | 6 | 7 |
| Economy | 1060 | 4.71 | 1.57 | 1 | 4 | 5 | 6 | 7 |
| Politics | 1060 | 4.44 | 1.81 | 1 | 3 | 4 | 6 | 7 |
| Media | 1060 | 4.44 | 1.69 | 1 | 4 | 4 | 6 | 7 |
| Migration | 1060 | 4.3 | 1.82 | 1 | 3 | 4 | 6 | 7 |
Test of Comparisons
topics <- c("tp_nature", "tp_crisis", "tp_values", "tp_economy", "tp_well", "tp_migration", "tp_work", "tp_pol", "tp_media")
tt_results <- list()
for (i in 1:(length(topics) - 1)) {
for (j in (i + 1):length(topics)) {
var1 <- topics[i]
var2 <- topics[j]
tab <- map_df(list(t.test(subset_tp[[var1]], subset_tp[[var2]], paired = TRUE, alternative = "two.sided")), tidy)
tt_results[[paste(var1, "_vs_", var2, sep = "")]] <- tab
}
}
ttresults_df <- do.call(rbind, tt_results)
ttresults_df$Comparison <- gsub("_vs_", " vs. ", rownames(ttresults_df))
ttresults_df <- ttresults_df[c("Comparison", "estimate", "statistic", "p.value", "conf.low", "conf.high", "method")]
ttresults_df[c("Comparison", "estimate", "statistic", "p.value", "conf.low", "conf.high", "method")] %>%
kbl(align = "llllll", col.names = c("Comparison", "Difference in Means", "t", "p.value", "conf.low", "conf.high", "Method"),
digits = 3, caption = "Difference of Topic Popularity") %>%
kable_styling() %>%
kableExtra::scroll_box(width = "100%", height = "300px")| Comparison | Difference in Means | t | p.value | conf.low | conf.high | Method |
|---|---|---|---|---|---|---|
| tp_nature vs. tp_crisis | 0.093 | 1.719 | 0.086 | -0.013 | 0.200 | Paired t-test |
| tp_nature vs. tp_values | -0.180 | -3.931 | 0.000 | -0.270 | -0.090 | Paired t-test |
| tp_nature vs. tp_economy | 0.340 | 6.603 | 0.000 | 0.239 | 0.441 | Paired t-test |
| tp_nature vs. tp_well | -0.247 | -5.517 | 0.000 | -0.335 | -0.159 | Paired t-test |
| tp_nature vs. tp_migration | 0.746 | 12.313 | 0.000 | 0.627 | 0.865 | Paired t-test |
| tp_nature vs. tp_work | 0.170 | 3.230 | 0.001 | 0.067 | 0.273 | Paired t-test |
| tp_nature vs. tp_pol | 0.611 | 10.433 | 0.000 | 0.496 | 0.726 | Paired t-test |
| tp_nature vs. tp_media | 0.613 | 10.399 | 0.000 | 0.497 | 0.729 | Paired t-test |
| tp_crisis vs. tp_values | -0.274 | -5.364 | 0.000 | -0.374 | -0.173 | Paired t-test |
| tp_crisis vs. tp_economy | 0.246 | 5.536 | 0.000 | 0.159 | 0.334 | Paired t-test |
| tp_crisis vs. tp_well | -0.341 | -6.886 | 0.000 | -0.438 | -0.244 | Paired t-test |
| tp_crisis vs. tp_migration | 0.653 | 13.410 | 0.000 | 0.557 | 0.748 | Paired t-test |
| tp_crisis vs. tp_work | 0.076 | 1.493 | 0.136 | -0.024 | 0.177 | Paired t-test |
| tp_crisis vs. tp_pol | 0.518 | 10.513 | 0.000 | 0.421 | 0.615 | Paired t-test |
| tp_crisis vs. tp_media | 0.520 | 9.098 | 0.000 | 0.408 | 0.632 | Paired t-test |
| tp_values vs. tp_economy | 0.520 | 10.344 | 0.000 | 0.421 | 0.618 | Paired t-test |
| tp_values vs. tp_well | -0.067 | -2.018 | 0.044 | -0.132 | -0.002 | Paired t-test |
| tp_values vs. tp_migration | 0.926 | 15.637 | 0.000 | 0.810 | 1.043 | Paired t-test |
| tp_values vs. tp_work | 0.350 | 7.374 | 0.000 | 0.257 | 0.443 | Paired t-test |
| tp_values vs. tp_pol | 0.792 | 14.288 | 0.000 | 0.683 | 0.900 | Paired t-test |
| tp_values vs. tp_media | 0.793 | 14.337 | 0.000 | 0.685 | 0.902 | Paired t-test |
| tp_economy vs. tp_well | -0.587 | -12.039 | 0.000 | -0.682 | -0.491 | Paired t-test |
| tp_economy vs. tp_migration | 0.407 | 8.070 | 0.000 | 0.308 | 0.505 | Paired t-test |
| tp_economy vs. tp_work | -0.170 | -3.518 | 0.000 | -0.265 | -0.075 | Paired t-test |
| tp_economy vs. tp_pol | 0.272 | 5.874 | 0.000 | 0.181 | 0.362 | Paired t-test |
| tp_economy vs. tp_media | 0.274 | 4.848 | 0.000 | 0.163 | 0.384 | Paired t-test |
| tp_well vs. tp_migration | 0.993 | 17.167 | 0.000 | 0.880 | 1.107 | Paired t-test |
| tp_well vs. tp_work | 0.417 | 9.302 | 0.000 | 0.329 | 0.505 | Paired t-test |
| tp_well vs. tp_pol | 0.858 | 15.290 | 0.000 | 0.748 | 0.969 | Paired t-test |
| tp_well vs. tp_media | 0.860 | 16.192 | 0.000 | 0.756 | 0.965 | Paired t-test |
| tp_migration vs. tp_work | -0.576 | -10.351 | 0.000 | -0.686 | -0.467 | Paired t-test |
| tp_migration vs. tp_pol | -0.135 | -2.429 | 0.015 | -0.244 | -0.026 | Paired t-test |
| tp_migration vs. tp_media | -0.133 | -2.176 | 0.030 | -0.253 | -0.013 | Paired t-test |
| tp_work vs. tp_pol | 0.442 | 7.648 | 0.000 | 0.328 | 0.555 | Paired t-test |
| tp_work vs. tp_media | 0.443 | 8.566 | 0.000 | 0.342 | 0.545 | Paired t-test |
| tp_pol vs. tp_media | 0.002 | 0.029 | 0.977 | -0.127 | 0.130 | Paired t-test |
chi_results <- list()
sim_results <- list()
for (i in 1:(length(topics) - 1)) {
for (j in (i + 1):length(topics)) {
var1 <- topics[i]
var2 <- topics[j]
tab <- map_df(list(chisq.test(subset_tp[[var1]], subset_tp[[var2]])), tidy)
tab2 <- map_df(list(chisq.test(subset_tp[[var1]], subset_tp[[var2]], simulate.p.value = TRUE)), tidy)
chi_results[[paste(var1, "_vs_", var2, sep = "")]] <- tab
sim_results[[paste(var1, "_vs_", var2, sep = "")]] <- tab2
}
}## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt sein
## Warning in chisq.test(subset_tp[[var1]], subset_tp[[var2]]): Chi-Quadrat-Approximation kann inkorrekt seinchiresults_df <- do.call(rbind, chi_results)
chiresults_df$Comparison <- gsub("_vs_", " vs. ", rownames(chiresults_df))
chiresults_df <- chiresults_df[c("statistic", "p.value", "parameter", "method")]
chiresults_df[c("statistic", "p.value", "parameter", "method")] %>%
kbl(align = "llllll", col.names = c("Chisq", "p.value", "df", "Method"), digits = 3, caption = "Difference of Topic Popularity") %>%
kable_styling() %>%
kableExtra::scroll_box(width = "100%", height = "300px")| Chisq | p.value | df | Method |
|---|---|---|---|
| 517.252 | 0 | 36 | Pearson’s Chi-squared test |
| 878.983 | 0 | 36 | Pearson’s Chi-squared test |
| 542.759 | 0 | 36 | Pearson’s Chi-squared test |
| 842.261 | 0 | 36 | Pearson’s Chi-squared test |
| 417.751 | 0 | 36 | Pearson’s Chi-squared test |
| 505.308 | 0 | 36 | Pearson’s Chi-squared test |
| 441.558 | 0 | 36 | Pearson’s Chi-squared test |
| 332.322 | 0 | 36 | Pearson’s Chi-squared test |
| 610.117 | 0 | 36 | Pearson’s Chi-squared test |
| 962.310 | 0 | 36 | Pearson’s Chi-squared test |
| 614.954 | 0 | 36 | Pearson’s Chi-squared test |
| 933.662 | 0 | 36 | Pearson’s Chi-squared test |
| 678.072 | 0 | 36 | Pearson’s Chi-squared test |
| 680.329 | 0 | 36 | Pearson’s Chi-squared test |
| 486.981 | 0 | 36 | Pearson’s Chi-squared test |
| 619.657 | 0 | 36 | Pearson’s Chi-squared test |
| 1673.654 | 0 | 36 | Pearson’s Chi-squared test |
| 402.592 | 0 | 36 | Pearson’s Chi-squared test |
| 766.153 | 0 | 36 | Pearson’s Chi-squared test |
| 541.688 | 0 | 36 | Pearson’s Chi-squared test |
| 441.200 | 0 | 36 | Pearson’s Chi-squared test |
| 623.551 | 0 | 36 | Pearson’s Chi-squared test |
| 825.070 | 0 | 36 | Pearson’s Chi-squared test |
| 775.513 | 0 | 36 | Pearson’s Chi-squared test |
| 813.696 | 0 | 36 | Pearson’s Chi-squared test |
| 542.665 | 0 | 36 | Pearson’s Chi-squared test |
| 435.932 | 0 | 36 | Pearson’s Chi-squared test |
| 824.499 | 0 | 36 | Pearson’s Chi-squared test |
| 489.486 | 0 | 36 | Pearson’s Chi-squared test |
| 476.613 | 0 | 36 | Pearson’s Chi-squared test |
| 560.412 | 0 | 36 | Pearson’s Chi-squared test |
| 553.667 | 0 | 36 | Pearson’s Chi-squared test |
| 453.160 | 0 | 36 | Pearson’s Chi-squared test |
| 397.669 | 0 | 36 | Pearson’s Chi-squared test |
| 749.695 | 0 | 36 | Pearson’s Chi-squared test |
| 247.401 | 0 | 36 | Pearson’s Chi-squared test |
simresults_df <- do.call(rbind, sim_results)
simresults_df$Comparison <- gsub("_vs_", " vs. ", rownames(simresults_df))
simresults_df <- simresults_df[c("statistic", "p.value", "parameter", "method")]
simresults_df[c("statistic", "p.value", "parameter", "method")] %>%
kbl(align = "llllll", col.names = c("Chisq", "p.value", "df", "Method"), digits = 3, caption = "Difference of Topic Popularity") %>%
kable_styling() %>%
kableExtra::scroll_box(width = "100%", height = "300px")| Chisq | p.value | df | Method |
|---|---|---|---|
| 517.252 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 878.983 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 542.759 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 842.261 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 417.751 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 505.308 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 441.558 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 332.322 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 610.117 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 962.310 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 614.954 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 933.662 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 678.072 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 680.329 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 486.981 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 619.657 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 1673.654 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 402.592 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 766.153 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 541.688 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 441.200 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 623.551 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 825.070 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 775.513 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 813.696 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 542.665 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 435.932 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 824.499 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 489.486 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 476.613 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 560.412 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 553.667 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 453.160 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 397.669 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 749.695 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
| 247.401 | 0 | NA | Pearson’s Chi-squared test with simulated p-value (based on 2000 replicates) |
By Political Interest
m1 <- mean(subset$tp_pol[subset$i_polinterest == 1], na.rm = T)
m2 <- mean(subset$tp_pol[subset$i_polinterest == 5], na.rm = T)
tab <- rbind(m1, m2)
tab <- data.frame(`Topic Interest in Politics` = round(c(m1, m2), 2))
rownames(tab) <- c("low political interest", "high political interest")
tab %>% kbl(align = "llllll", col.names = c("Topic Interest in Politics")) %>%
kable_styling()| Topic Interest in Politics | |
|---|---|
| low political interest | 2.11 |
| high political interest | 6.21 |
Principal Component Analysis
Identifying Number of Components
i_topic <- select(subset, tp_nature, tp_crisis, tp_values, tp_economy, tp_well, tp_migration, tp_work, tp_pol, tp_media)
i_topic <- i_topic[complete.cases(i_topic), ]
scree_plot(i_topic, method="pc")
Table Principal Component Analysis
fit_topic <- principal(i_topic, nfactors = 2, rotate = "varimax")
results_pca <- as.data.frame.matrix(fit_topic[["loadings"]])
results_pca <- cbind(results_pca, as.data.frame(fit_topic[["uniquenesses"]]))
results_pca <- cbind(results_pca, as.data.frame(fit_topic[["complexity"]]))
results_pca <- cbind(rownames(results_pca), data.frame(results_pca, row.names=NULL))
colnames(results_pca)<- c("Topic Interest", "Factor Loadings 1", "Factor Loadings 2", "Uniqueness", "Complexity")
results_pca[, 2:5] <- round(results_pca[, 2:5], 2)
n_row <- data.frame("Topic Interest" = "N",
"Factor Loadings 1" = fit_topic$n.obs, "Factor Loadings 2" = NA,
"Uniqueness" = NA, "Complexity" = NA)
eigenvalues <- fit_topic$values[1:2]
eigenvalues_row <- data.frame("Topic Interest" = "Eigenvalues",
"Factor Loadings 1" = round(eigenvalues[1], 2),
"Factor Loadings 2" = round(eigenvalues[2], 2),
"Uniqueness" = NA, "Complexity" = NA)
colnames(eigenvalues_row) <- colnames(results_pca)
colnames(n_row) <- colnames(results_pca)
table_pca <- rbind(results_pca, eigenvalues_row, n_row)
table_pca[table_pca[["Topic Interest"]] == "N", "Factor Loadings 1"] <- as.character(as.integer(table_pca[table_pca[["Topic Interest"]] == "N", "Factor Loadings 1"]))
table_pca[is.na(table_pca)] <- ""
vars <- c("tp_well", "tp_values", "tp_nature", "tp_crisis", "tp_work", "tp_economy", "tp_pol", "tp_media", "tp_migration")
labels <- c("Well-Being", "Values", "Nature", "Crisis", "Work", "Economy", "Politics", "Media", "Migration")
var_labels <- setNames(labels, vars)
table_pca <- table_pca %>%
mutate(`Topic Interest` = ifelse(`Topic Interest` %in% names(var_labels),
var_labels[`Topic Interest`], `Topic Interest`))Table Principal Component Analysis
knitr::kable(table_pca)| Topic Interest | Factor Loadings 1 | Factor Loadings 2 | Uniqueness | Complexity |
|---|---|---|---|---|
| Nature | 0.7 | 0.26 | 0.44 | 1.28 |
| Crisis | 0.33 | 0.76 | 0.31 | 1.37 |
| Values | 0.84 | 0.21 | 0.25 | 1.12 |
| Economy | 0.33 | 0.76 | 0.31 | 1.37 |
| Well-Being | 0.86 | 0.2 | 0.23 | 1.11 |
| Migration | 0.18 | 0.8 | 0.33 | 1.1 |
| Work | 0.6 | 0.41 | 0.47 | 1.78 |
| Politics | 0.23 | 0.77 | 0.35 | 1.17 |
| Media | 0.51 | 0.32 | 0.64 | 1.69 |
| Eigenvalues | 4.6 | 1.07 | ||
| N | 1060 |
Plot Principal Component Analysis
g_pca <- ggplot(results_pca, aes(x = `Factor Loadings 2`, y = `Factor Loadings 1`)) +
labs(x = "Factor Loadings 1", y = "Factor Loadings 2") +
geom_point(aes(colour = `Factor Loadings 2` < 0.5 & `Factor Loadings 1` > 0.5), show.legend = FALSE) +
geom_text(aes(label = c("nature and environment", "current crisis", "personality and values", "economy and society", "satisfaction and well-being", "flight and migration", "work and leisure", "political attiudes and behavior", "media and social networks")),
hjust = 0, nudge_x = 0.02, size = 3, family = "Times New Roman", colour = "black") +
theme_light() + custom_theme + scale_color_grey() +
scale_y_continuous(limits = c(0, 1.)) +
scale_x_continuous(limits = c(0, 1.)) +
geom_hline(yintercept = 0.5) +
geom_vline(xintercept = 0.5)
g_pca
Reasearch Question 1. Analyses
crosstab <- CrossTable(subset$matrix_mean, prop.r = TRUE, prop.c = FALSE, prop.t = FALSE, prop.chisq = FALSE)t <- as.data.frame(crosstab[["t"]])
t <- t %>% mutate(across(everything(), ~ as.character(.x)))
prop <- as.data.frame(crosstab[["prop.row"]])
prop <- prop %>% mutate(across(everything(), ~ .x * 100)) # <-- Multiply by 100
prop <- prop %>% mutate(across(everything(), ~ formatC(.x, format = "f", digits = 2)))
tab <- rbind(t, prop)
rownames(tab) <- c("N", "prop.row")
tab %>% kbl(align = "llllll", col.names = c("0", "0.333", "0.667", "1"), caption = "Share of Correct Assessments") %>%
kable_styling()| 0 | 0.333 | 0.667 | 1 | |
|---|---|---|---|---|
| N | 78 | 240 | 169 | 614 |
| prop.row | 7.08 | 21.80 | 15.35 | 55.77 |
Reasearch Question 2. Analyses
Regression Diagnostics
# main model for regression diagnostics
rmatrix <- glmer(matrix ~ vb_explain + tp_interest + s_interesting + i_education + age_group + i_gender + i_east + (1 | lfdn),
data = long, family = "binomial", nAGQ=0)subset_long <- select(long, matrix, vb_explain, tp_interest, s_interesting, i_education, i_gender, age_group, i_east, lfdn)
subset_long <- subset_long[complete.cases(subset_long), ]Regression Model
r_main <- glmer(matrix ~ vb_explain + (1 | lfdn),
data = subset_long, family = "binomial", nAGQ=0)
r_edu <- glmer(matrix ~ vb_explain + i_education +(1 | lfdn),
data = subset_long, family = "binomial", nAGQ=0)
r_socio <- glmer(matrix ~ vb_explain + i_education + age_group + i_gender + i_east + (1 | lfdn),
data = subset_long, family = "binomial", nAGQ=0)
r_comp <- glmer(matrix ~ vb_explain + i_education + age_group + i_gender + i_east + tp_interest + s_interesting + (1 | lfdn),
data = subset_long, family = "binomial", nAGQ=0)Comparisons Test
c <- avg_comparisons(r_edu, variables = list(vb_explain = c(0, 1)), comparison = "difference")
c1 <- avg_comparisons(r_comp, variables = list(s_interesting = c(1, 5)), comparison = "difference")
c2 <- avg_comparisons(r_comp, variables = list(tp_interest = c(1, 7)), comparison = "difference")
c3 <- avg_comparisons(r_comp, variables = list(i_education = c(1, 3)), comparison = "difference")
c_matrix <- rbind(c, c1, c2, c3)
c_matrix[c("term", "contrast", "estimate", "std.error", "statistic", "p.value")] %>%
kbl(align = "llll", digits = 3) %>%
kable_styling()| term | contrast | estimate | std.error | statistic | p.value |
|---|---|---|---|---|---|
| vb_explain | mean(1) - mean(0) | -0.030 | 0.022 | -1.380 | 0.168 |
| s_interesting | mean(5) - mean(1) | 0.109 | 0.049 | 2.239 | 0.025 |
| tp_interest | mean(7) - mean(1) | 0.051 | 0.033 | 1.564 | 0.118 |
| i_education | mean(3) - mean(1) | 0.156 | 0.027 | 5.720 | 0.000 |
Regression Tables
tab_model(r_main, r_edu, r_socio, r_comp,
show.est = TRUE, show.se = TRUE, show.ci = FALSE, show.aic = TRUE, collapse.se = TRUE, linebreak = TRUE, p.style = "numeric", show.reflvl = TRUE,
pred.labels = c("Intercept", "Topic Explanation", "Education: Intermediate", "Education: High", "31-48", "49-63", "63+", "Gender: Female", "Germany: East", "Topic Interest", "Survey Interest" ),
dv.labels = c("Main Effect", "Controlled Effect I", "Controlled Effect II", "Competence Effect"),
title = "Mixed Effects Logistic Regression Model: Correct Assessment of a Survey Questions' Topic",
CSS = list(css.thead = 'border-top: 1px solid;', css.summary= 'border-bottom: 1px solid;', css.table = 'width: 100%;'))| Main Effect | Controlled Effect I | Controlled Effect II | Competence Effect | |||||
|---|---|---|---|---|---|---|---|---|
| Predictors | Odds Ratios | p | Odds Ratios | p | Odds Ratios | p | Odds Ratios | p |
| Intercept |
4.49 (0.51) |
<0.001 |
2.78 (0.43) |
<0.001 |
1.50 (0.36) |
0.095 |
0.59 (0.23) |
0.173 |
| Topic Explanation |
0.75 (0.12) |
0.066 |
0.81 (0.12) |
0.169 |
0.81 (0.12) |
0.153 |
0.81 (0.12) |
0.163 |
| Education: Intermediate |
1.43 (0.26) |
0.049 |
1.63 (0.30) |
0.008 |
1.61 (0.30) |
0.009 | ||
| Education: High |
2.68 (0.50) |
<0.001 |
3.09 (0.59) |
<0.001 |
2.97 (0.57) |
<0.001 | ||
| 31-48 |
1.23 (0.25) |
0.302 |
1.20 (0.24) |
0.362 | ||||
| 49-63 |
2.01 (0.45) |
0.002 |
1.86 (0.41) |
0.005 | ||||
| 63+ |
1.92 (0.50) |
0.012 |
1.78 (0.46) |
0.025 | ||||
| Gender: Female |
1.43 (0.21) |
0.018 |
1.47 (0.22) |
0.010 | ||||
| Germany: East |
0.95 (0.17) |
0.765 |
0.95 (0.17) |
0.768 | ||||
| Topic Interest |
1.06 (0.04) |
0.112 | ||||||
| Survey Interest |
1.20 (0.09) |
0.020 | ||||||
| Random Effects | ||||||||
| σ2 | 3.29 | 3.29 | 3.29 | 3.29 | ||||
| τ00 | 3.33 lfdn | 3.16 lfdn | 2.97 lfdn | 2.85 lfdn | ||||
| ICC | 0.50 | 0.49 | 0.47 | 0.46 | ||||
| N | 1023 lfdn | 1023 lfdn | 1023 lfdn | 1023 lfdn | ||||
| Observations | 3051 | 3051 | 3051 | 3051 | ||||
| Marginal R2 / Conditional R2 | 0.003 / 0.504 | 0.028 / 0.504 | 0.044 / 0.498 | 0.051 / 0.492 | ||||
| AIC | 3201.038 | 3163.606 | 3147.365 | 3137.330 | ||||
Regression Graphs
graph_matrix = ggarrange( g_edu, g_tp, g_s, ncol = 1, nrow = 3)
graph_matrix = annotate_figure(graph_matrix,
top = text_grob("Predicted Values\nCorrect Assessment of a Survey Questions' Topic\nwith 95% Confidence Intervals", size = 10, family = "Times New Roman", face = "plain"))
graph_matrix
Reasearch Question 3. Analyses
Correct Assessment
t-test for Difference in Means
bartlett.test(matrix_mean ~ vb_explain, data = subset)##
## Bartlett test of homogeneity of variances
##
## data: matrix_mean by vb_explain
## Bartlett's K-squared = 2.1801, df = 1, p-value = 0.1398tab <- map_df(list(t.test(subset$matrix_mean ~ subset$vb_explain, var.equal = TRUE, alternative = "two.sided")), tidy)
tab[c("estimate", "statistic", "p.value", "conf.low", "conf.high", "method")] %>%
kbl(align = "llllll", col.names = c("Difference in Means", "t", "p.value", "conf.low", "conf.high", "Method"), digits = 3) %>%
kable_styling()| Difference in Means | t | p.value | conf.low | conf.high | Method |
|---|---|---|---|---|---|
| 0.055 | 2.723 | 0.007 | 0.015 | 0.095 | Two Sample t-test |
t.test.cluster(long$matrix, cluster = long$lfdn, group = long$vb_explain)## 0 1
## N 1554 1749
## Clusters 518 583
## Mean 0.7619048 0.7066895
## SS among clusters within groups 163.2381 208.5317
## SS within clusters within groups 118.6667 154.0000
## MS among clusters within groups 0.3382801
## d.f. 1099
## MS within clusters within groups 0.1238268
## d.f. 2202
## Na 2.997273
## Intracluster correlation 0.3662137
## Variance Correction Factor 1.732427 1.732427
## Variance of effect 0.0002606979
## Variance without cluster adjustment 0.0001504813
## Design Effect 1.732427
## Effect (Difference in Means) -0.05521523
## S.E. of Effect 0.01614614
## 0.95 Confidence limits -0.08686108 -0.02356937
## Z Statistic -3.419716
## 2-sided P Value 0.0006268645Topic Preferences
t-test for Difference in Means
vb_results <- list()
for (i in topics) {
bartlett_result <- bartlett.test(subset[[i]] ~ subset$vb_explain)
p_value_bartlett <- bartlett_result$p.value
var_equal <- ifelse(p_value_bartlett > 0.05, TRUE, FALSE)
t_test_result <- t.test(subset[[i]] ~ subset$vb_explain, alternative = "two.sided", var.equal = var_equal)
t_test_tab <- broom::tidy(t_test_result)
t_test_tab$Comparison <- paste(i, "_by_", "vb_explain", sep = "")
vb_results[[paste(i, "_by_", "vb_explain", sep = "")]] <- rbind(t_test_tab)
}
vbresults_df <- do.call(rbind, vb_results)
vbresults_df$Comparison <- gsub("_by_", " by ", rownames(vbresults_df))
vbresults_df <- vbresults_df[c("Comparison", "estimate", "statistic", "p.value", "conf.low", "conf.high", "method")]
vbresults_df[c("Comparison", "estimate", "statistic", "p.value", "conf.low", "conf.high", "method")] %>%
kbl(align = "llllll", col.names = c("Comparison", "Difference in Means", "t", "p.value", "conf.low", "conf.high", "Method"), digits = 3,
caption = "Topic Popularity by Experimental Group") %>%
kable_styling() %>%
kableExtra::scroll_box(width = "100%", height = "300px")| Comparison | Difference in Means | t | p.value | conf.low | conf.high | Method |
|---|---|---|---|---|---|---|
| tp_nature by vb_explain | -0.008 | -0.083 | 0.934 | -0.200 | 0.184 | Two Sample t-test |
| tp_crisis by vb_explain | 0.016 | 0.159 | 0.873 | -0.181 | 0.213 | Two Sample t-test |
| tp_values by vb_explain | 0.048 | 0.535 | 0.593 | -0.129 | 0.226 | Two Sample t-test |
| tp_economy by vb_explain | 0.016 | 0.172 | 0.863 | -0.170 | 0.203 | Two Sample t-test |
| tp_well by vb_explain | 0.081 | 0.944 | 0.345 | -0.087 | 0.249 | Welch Two Sample t-test |
| tp_migration by vb_explain | 0.120 | 1.087 | 0.277 | -0.097 | 0.337 | Two Sample t-test |
| tp_work by vb_explain | -0.006 | -0.063 | 0.950 | -0.189 | 0.177 | Two Sample t-test |
| tp_pol by vb_explain | 0.309 | 2.810 | 0.005 | 0.093 | 0.524 | Two Sample t-test |
| tp_media by vb_explain | -0.023 | -0.220 | 0.826 | -0.224 | 0.179 | Two Sample t-test |
Acquiescence
t-test for Difference in Means
bartlett.test(acquiescence ~ vb_explain, data = subset)##
## Bartlett test of homogeneity of variances
##
## data: acquiescence by vb_explain
## Bartlett's K-squared = 0.056007, df = 1, p-value = 0.8129tab <- map_df(list(t.test(subset$acquiescence ~ subset$vb_explain, var.equal = TRUE, alternative = "two.sided")), tidy)
tab[c("estimate", "statistic", "p.value", "conf.low", "conf.high", "method")] %>%
kbl(align = "llllll", col.names = c("Difference in Means", "t", "p.value", "conf.low", "conf.high", "Method"), digits = 3) %>%
kable_styling()| Difference in Means | t | p.value | conf.low | conf.high | Method |
|---|---|---|---|---|---|
| 0.014 | 0.707 | 0.48 | -0.025 | 0.054 | Two Sample t-test |
rm(tab)Proportion Test
prop_test_data <- subset %>%
group_by(vb_explain) %>%
dplyr::summarise( mean_acquiescence = mean(acquiescence, na.rm = TRUE), n = n()) %>%
ungroup()
prop_test_data <- prop_test_data %>% mutate(count = mean_acquiescence * n)
prop_test <- prop.test(prop_test_data$count, prop_test_data$n)
tab <- tidy(prop_test)
tab %>% select(estimate1, estimate2, statistic, p.value, conf.low, conf.high, method) %>%
kbl(align = "llllll", digits = 3) %>%
kable_styling()| estimate1 | estimate2 | statistic | p.value | conf.low | conf.high | method |
|---|---|---|---|---|---|---|
| 0.589 | 0.575 | 0.173 | 0.677 | -0.046 | 0.074 | 2-sample test for equality of proportions with continuity correction |
rm(tab)Regression Diagnostics
# main model for regression diagnostics
racqu <- lm(acquiescence ~ vb_explain + i_education, data= subset)# Breusch-Pagan test
lmtest::bptest(racqu) ##
## studentized Breusch-Pagan test
##
## data: racqu
## BP = 13.682, df = 3, p-value = 0.003372# identifying influential cases
cooksd <- cooks.distance(racqu)
influential_acqu <- as.numeric(names(cooksd)[(cooksd > 4*mean(cooksd, na.rm=T))])
subset_acq <- subset[-c(influential_acqu), ]
subset_acq <- select(subset_acq, acquiescence, vb_explain, i_education)
subset_acq <- subset_acq[complete.cases(subset_acq), ]Regression Model
racqu <- lm_robust(acquiescence ~ vb_explain + i_education, data= subset)Comparisons Test
c <- avg_comparisons(racqu, variables = list(vb_explain = c(0, 1)), comparison = "difference")
c[c("term", "contrast", "estimate", "std.error", "statistic", "p.value")] %>%
kbl(align = "llll", digits = 3) %>%
kable_styling()| term | contrast | estimate | std.error | statistic | p.value |
|---|---|---|---|---|---|
| vb_explain | mean(1) - mean(0) | -0.004 | 0.02 | -0.188 | 0.851 |
Extreme Responding
t-test for Difference in Means
bartlett.test(extreme ~ vb_explain, data = subset)##
## Bartlett test of homogeneity of variances
##
## data: extreme by vb_explain
## Bartlett's K-squared = 0.18482, df = 1, p-value = 0.6673tab <- map_df(list(t.test(subset$extreme ~ subset$vb_explain, var.equal = TRUE, alternative = "two.sided")), tidy)
tab[c("estimate", "statistic", "p.value", "conf.low", "conf.high", "method")] %>%
kbl(align = "llllll", col.names = c("Difference in Means", "t", "p.value", "conf.low", "conf.high", "Method"), digits = 3) %>%
kable_styling()| Difference in Means | t | p.value | conf.low | conf.high | Method |
|---|---|---|---|---|---|
| -0.025 | -1.322 | 0.187 | -0.062 | 0.012 | Two Sample t-test |
rm(tab)Proportion Test
prop_test_data <- subset %>%
group_by(vb_explain) %>%
dplyr::summarise(mean_extreme = mean(extreme, na.rm = TRUE), n = n()) %>%
ungroup()
prop_test_data <- prop_test_data %>% mutate(count = mean_extreme * n)
prop_test <- prop.test(prop_test_data$count, prop_test_data$n)
tab <- tidy(prop_test)
tab %>% select(estimate1, estimate2, statistic, p.value, conf.low, conf.high, method) %>%
kbl(align = "llllll", digits = 3) %>%
kable_styling()| estimate1 | estimate2 | statistic | p.value | conf.low | conf.high | method |
|---|---|---|---|---|---|---|
| 0.241 | 0.266 | 0.786 | 0.375 | -0.078 | 0.028 | 2-sample test for equality of proportions with continuity correction |
rm(tab)Regression Diagnostics
# main model for regression diagnostics
rext <- lm(extreme ~ vb_explain + i_education, data= subset)# Breusch-Pagan test
lmtest::bptest(rext) ##
## studentized Breusch-Pagan test
##
## data: rext
## BP = 5.7053, df = 3, p-value = 0.1269# identifying influential cases
cooksd <- cooks.distance(rext)
influential_ext <- as.numeric(names(cooksd)[(cooksd > 4*mean(cooksd, na.rm=T))])
subset_ext <- subset[-c(influential_ext), ]
subset_ext <- select(subset_ext, extreme, vb_explain, i_education)
subset_ext <- subset_ext[complete.cases(subset_ext), ]Regression Models
rext <- lm(extreme ~ vb_explain + i_education, data= subset)Comparisons Test
c <- avg_comparisons(rext, variables = list(vb_explain = c(0, 1)), comparison = "difference")
c[c("term", "contrast", "estimate", "std.error", "statistic", "p.value")] %>%
kbl(align = "llll", digits = 3) %>%
kable_styling()| term | contrast | estimate | std.error | statistic | p.value |
|---|---|---|---|---|---|
| vb_explain | mean(1) - mean(0) | 0.02 | 0.019 | 1.057 | 0.29 |
Midpoint Responding
t-test for Difference in Means
bartlett.test(midpoint ~ vb_explain, data = subset)##
## Bartlett test of homogeneity of variances
##
## data: midpoint by vb_explain
## Bartlett's K-squared = 0.0030992, df = 1, p-value = 0.9556tab <- map_df(list(t.test(subset$midpoint ~ subset$vb_explain, var.equal = TRUE, alternative = "two.sided")), tidy)
tab[c("estimate", "statistic", "p.value", "conf.low", "conf.high", "method")] %>%
kbl(align = "llllll", col.names = c("Difference in Means", "t", "p.value", "conf.low", "conf.high", "Method"), digits = 3) %>%
kable_styling()| Difference in Means | t | p.value | conf.low | conf.high | Method |
|---|---|---|---|---|---|
| 0 | -0.001 | 0.999 | -0.031 | 0.031 | Two Sample t-test |
rm(tab)Proportion Test
prop_test_data <- subset %>%
group_by(vb_explain) %>%
dplyr::summarise(mean_midpoint = mean(midpoint, na.rm = TRUE), n = n()) %>%
ungroup()
prop_test_data <- prop_test_data %>% mutate(count = mean_midpoint * n)
prop_test <- prop.test(prop_test_data$count, prop_test_data$n)
tab <- tidy(prop_test)
tab %>% select(estimate1, estimate2, statistic, p.value, conf.low, conf.high, method) %>%
kbl(align = "llllll", digits = 3) %>%
kable_styling()| estimate1 | estimate2 | statistic | p.value | conf.low | conf.high | method |
|---|---|---|---|---|---|---|
| 0.239 | 0.239 | 0 | 1 | -0.05 | 0.05 | 2-sample test for equality of proportions with continuity correction |
rm(tab)Regression Diagnostics
# main model for regression diagnostics
rmid <- lm(midpoint ~ vb_explain + i_education, data= subset)# Breusch-Pagan test
lmtest::bptest(rmid) ##
## studentized Breusch-Pagan test
##
## data: rmid
## BP = 6.0382, df = 3, p-value = 0.1098# identifying influential cases
cooksd <- cooks.distance(rmid)
influential_mid <- as.numeric(names(cooksd)[(cooksd > 4*mean(cooksd, na.rm=T))])
subset_mid <- subset[-c(influential_mid), ]
subset_mid <- select(subset_mid, midpoint, vb_explain, i_education)
subset_mid <- subset_mid[complete.cases(subset_mid), ]Regression Models
rmid <- lm(midpoint ~ vb_explain + i_education, data= subset)Comparisons Test
c <- avg_comparisons(rmid, variables = list(vb_explain = c(0, 1)), comparison = "difference")
c[c("term", "contrast", "estimate", "std.error", "statistic", "p.value")] %>%
kbl(align = "llll", digits = 3) %>%
kable_styling()| term | contrast | estimate | std.error | statistic | p.value |
|---|---|---|---|---|---|
| vb_explain | mean(1) - mean(0) | -0.004 | 0.016 | -0.252 | 0.801 |
Item Nonresponse
t-test for Difference in Means
bartlett.test(na ~ vb_explain, data = subset)##
## Bartlett test of homogeneity of variances
##
## data: na by vb_explain
## Bartlett's K-squared = 206.25, df = 1, p-value < 2.2e-16tab <- map_df(list(t.test(subset$na ~ subset$vb_explain, var.equal = FALSE, alternative = "two.sided")), tidy)
tab[c("estimate", "statistic", "p.value", "conf.low", "conf.high", "method")] %>%
kbl(align = "llllll", col.names = c("Difference in Means", "t", "p.value", "conf.low", "conf.high", "Method"), digits = 3) %>%
kable_styling()| Difference in Means | t | p.value | conf.low | conf.high | Method |
|---|---|---|---|---|---|
| -0.004 | -1.422 | 0.155 | -0.009 | 0.001 | Welch Two Sample t-test |
rm(tab)Proportion Test
prop_test_data <- subset %>%
group_by(vb_explain) %>%
dplyr::summarise(mean_na = mean(na, na.rm = TRUE), n = n()) %>%
ungroup()
prop_test_data <- prop_test_data %>% mutate(count = mean_na * n)
prop_test <- prop.test(prop_test_data$count, prop_test_data$n)
tab <- tidy(prop_test)
tab %>% select(estimate1, estimate2, statistic, p.value, conf.low, conf.high, method) %>%
kbl(align = "llllll", digits = 3) %>%
kable_styling()| estimate1 | estimate2 | statistic | p.value | conf.low | conf.high | method |
|---|---|---|---|---|---|---|
| 0.004 | 0.008 | 0.158 | 0.691 | -0.015 | 0.007 | 2-sample test for equality of proportions with continuity correction |
rm(tab)Regression Diagnostics
# main model for regression diagnostics
rna <- lm(na ~ vb_explain + i_education, data= subset)# Breusch-Pagan test
lmtest::bptest(rna) ##
## studentized Breusch-Pagan test
##
## data: rna
## BP = 5.7109, df = 3, p-value = 0.1266# identifying influential cases
cooksd <- cooks.distance(rna)
influential_na <- as.numeric(names(cooksd)[(cooksd > 4*mean(cooksd, na.rm=T))])
subset_na <- subset[-c(influential_na), ]
subset_na <- select(subset_na, na, vb_explain, i_education)
subset_na <- subset_na[complete.cases(subset_na), ]Regression Models
rna <- lm(na ~ vb_explain + i_education, data= subset)Comparisons Test
c <- avg_comparisons(rna, variables = list(vb_explain = c(0, 1)), comparison = "difference")
c[c("term", "contrast", "estimate", "std.error", "statistic", "p.value")] %>%
kbl(align = "llll", digits = 3) %>%
kable_styling()| term | contrast | estimate | std.error | statistic | p.value |
|---|---|---|---|---|---|
| vb_explain | mean(1) - mean(0) | 0.003 | 0.003 | 1.189 | 0.235 |
Comprehensibility
t-test for Difference in Means
bartlett.test(i_comp ~ vb_explain, data = subset)##
## Bartlett test of homogeneity of variances
##
## data: i_comp by vb_explain
## Bartlett's K-squared = 0.71633, df = 1, p-value = 0.3974tab <- map_df(list(t.test(subset$i_comp ~ subset$vb_explain, var.equal = TRUE, alternative = "two.sided")), tidy)
tab[c("estimate", "statistic", "p.value", "conf.low", "conf.high", "method")] %>%
kbl(align = "llllll", col.names = c("Difference in Means", "t", "p.value", "conf.low", "conf.high", "Method"), digits = 3) %>%
kable_styling()| Difference in Means | t | p.value | conf.low | conf.high | Method |
|---|---|---|---|---|---|
| 0.002 | 0.172 | 0.863 | -0.024 | 0.028 | Two Sample t-test |
rm(tab)Regression Diagnostics
# main model for regression diagnostics
rcomp <- lm(i_comp ~ vb_explain + i_education, data= subset)# Breusch-Pagan test
lmtest::bptest(rcomp) ##
## studentized Breusch-Pagan test
##
## data: rcomp
## BP = 13.532, df = 3, p-value = 0.003617# identifying influential cases
cooksd <- cooks.distance(rcomp)
influential_comp <- as.numeric(names(cooksd)[(cooksd > 4*mean(cooksd, na.rm=T))])
subset_comp <- subset[-c(influential_comp), ]
subset_comp <- select(subset_comp, i_comp, vb_explain, i_education)
subset_comp <- subset_comp[complete.cases(subset_comp), ]Regression Models
rcomp <- lm(i_comp ~ vb_explain + i_education, data= subset)Comparisons Test
c <- avg_comparisons(rcomp, variables = list(vb_explain = c(0, 1)), comparison = "difference")
c[c("term", "contrast", "estimate", "std.error", "statistic", "p.value")] %>%
kbl(align = "llll", digits = 3) %>%
kable_styling()| term | contrast | estimate | std.error | statistic | p.value |
|---|---|---|---|---|---|
| vb_explain | mean(1) - mean(0) | 0.002 | 0.013 | 0.146 | 0.884 |
Regression Tables
tab_model(racqu, rext, rmid, rna, rcomp,
show.est = TRUE, show.se = TRUE, show.ci = FALSE, show.aic = TRUE, collapse.se = TRUE, linebreak = TRUE, p.style = "numeric", show.reflvl = TRUE,
pred.labels = c("Intercept", "Topic Explanation", "Education: Intermediate", "Education: High"),
dv.labels = c("Acquiescence", "Extreme Responding", "Midpoint Responding", "Item Nonresponse", "Comprehension"),
title = "OLS Regression Model: Data Quality by Experimental Group",
CSS = list(css.thead = 'border-top: 1px solid;', css.summary= 'border-bottom: 1px solid;', css.table = 'width: 100%;'))| Acquiescence | Extreme Responding | Midpoint Responding | Item Nonresponse | Comprehension | ||||||
|---|---|---|---|---|---|---|---|---|---|---|
| Predictors | Estimates | p | Estimates | p | Estimates | p | Estimates | p | Estimates | p |
| Intercept |
0.52 (0.02) |
<0.001 |
0.28 (0.02) |
<0.001 |
0.26 (0.02) |
<0.001 |
0.01 (0.00) |
0.005 |
0.81 (0.01) |
<0.001 |
| Topic Explanation |
-0.00 (0.02) |
0.851 |
0.02 (0.02) |
0.291 |
-0.00 (0.02) |
0.801 |
0.00 (0.00) |
0.235 |
0.00 (0.01) |
0.884 |
| Education: Intermediate |
0.05 (0.03) |
0.032 |
-0.03 (0.02) |
0.138 |
-0.00 (0.02) |
0.998 |
-0.00 (0.00) |
0.276 |
-0.00 (0.02) |
0.969 |
| Education: High |
0.12 (0.02) |
<0.001 |
-0.06 (0.02) |
0.011 |
-0.05 (0.02) |
0.016 |
-0.01 (0.00) |
0.056 |
0.05 (0.02) |
0.002 |
| Observations | 1060 | 1060 | 1060 | 1101 | 1097 | |||||
| R2 / R2 adjusted | 0.025 / 0.022 | 0.008 / 0.005 | 0.007 / 0.005 | 0.005 / 0.002 | 0.012 / 0.009 | |||||
| AIC | 620.771 | 520.895 | 118.649 | -3712.467 | -218.254 | |||||
Documentation
out <- out <- capture.output(sessioninfo::session_info())
out <- out[!grepl("^\\s*\\[\\d+\\]", out)]
out <- out[!grepl("^\\s*quarto\\s+ERROR:", out)]
cat(out, sep = "\n")## ─ Session info ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## setting value
## version R version 4.4.0 (2024-04-24 ucrt)
## os Windows 11 x64 (build 26100)
## system x86_64, mingw32
## ui RStudio
## language (EN)
## collate German_Germany.utf8
## ctype German_Germany.utf8
## tz Europe/Berlin
## date 2026-01-23
## rstudio 2025.09.2+418 Cucumberleaf Sunflower (desktop)
## pandoc 3.6.3 @ C:/Program Files/RStudio/resources/app/bin/quarto/bin/tools/ (via rmarkdown)
##
## ─ Packages ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## package * version date (UTC) lib source
## abind 1.4-8 2024-09-12 [1] CRAN (R 4.4.1)
## backports 1.5.0 2024-05-23 [1] CRAN (R 4.4.0)
## base64enc 0.1-3 2015-07-28 [1] CRAN (R 4.4.0)
## bayestestR 0.16.1 2025-07-01 [1] CRAN (R 4.4.3)
## boot 1.3-31 2024-08-28 [1] CRAN (R 4.4.3)
## broom * 1.0.8 2025-03-28 [1] CRAN (R 4.4.3)
## bslib 0.9.0 2025-01-30 [1] CRAN (R 4.4.3)
## cachem 1.1.0 2024-05-16 [1] CRAN (R 4.4.0)
## car 3.1-3 2024-09-27 [1] CRAN (R 4.4.3)
## carData 3.0-5 2022-01-06 [1] CRAN (R 4.4.0)
## checkmate 2.3.1 2023-12-04 [1] CRAN (R 4.4.0)
## cli 3.6.5 2025-04-23 [1] CRAN (R 4.4.3)
## cluster 2.1.6 2023-12-01 [1] CRAN (R 4.4.0)
## coda 0.19-4.1 2024-01-31 [1] CRAN (R 4.4.1)
## codetools 0.2-20 2024-03-31 [1] CRAN (R 4.4.0)
## colorspace 2.1-0 2023-01-23 [1] CRAN (R 4.4.0)
## cowplot 1.2.0 2025-07-07 [1] CRAN (R 4.4.3)
## data.table 1.15.4 2024-03-30 [1] CRAN (R 4.4.0)
## datawizard 1.1.0 2025-05-09 [1] CRAN (R 4.4.3)
## devtools * 2.4.6 2025-10-03 [1] CRAN (R 4.4.3)
## dichromat 2.0-0.1 2022-05-02 [1] CRAN (R 4.4.0)
## digest 0.6.35 2024-03-11 [1] CRAN (R 4.4.0)
## dplyr * 1.1.4 2023-11-17 [1] CRAN (R 4.4.0)
## effectsize 1.0.1 2025-05-27 [1] CRAN (R 4.4.3)
## ellipsis 0.3.2 2021-04-29 [1] CRAN (R 4.4.0)
## emmeans 1.11.1 2025-05-04 [1] CRAN (R 4.4.3)
## estimability 1.5.1 2024-05-12 [1] CRAN (R 4.4.0)
## estimatr * 1.0.4 2024-03-31 [1] CRAN (R 4.4.0)
## evaluate 1.0.4 2025-06-18 [1] CRAN (R 4.4.3)
## factoextra 1.0.7 2020-04-01 [1] CRAN (R 4.4.3)
## farver 2.1.2 2024-05-13 [1] CRAN (R 4.4.0)
## fastmap 1.2.0 2024-05-15 [1] CRAN (R 4.4.0)
## forcats 1.0.0 2023-01-29 [1] CRAN (R 4.4.0)
## foreign 0.8-86 2023-11-28 [1] CRAN (R 4.4.0)
## Formula 1.2-5 2023-02-24 [1] CRAN (R 4.4.0)
## fs 1.6.6 2025-04-12 [1] CRAN (R 4.4.3)
## gdata 3.0.1 2024-10-22 [1] CRAN (R 4.4.3)
## generics 0.1.4 2025-05-09 [1] CRAN (R 4.4.3)
## ggeffects * 2.3.0 2025-06-13 [1] CRAN (R 4.4.3)
## ggplot2 * 3.5.2 2025-04-09 [1] CRAN (R 4.4.3)
## ggpubr * 0.6.1 2025-06-27 [1] CRAN (R 4.4.3)
## ggrepel 0.9.6 2024-09-07 [1] CRAN (R 4.4.3)
## ggsignif 0.6.4 2022-10-13 [1] CRAN (R 4.4.0)
## glue 1.7.0 2024-01-09 [1] CRAN (R 4.4.0)
## gmodels * 2.19.1 2024-03-06 [1] CRAN (R 4.4.1)
## gridExtra 2.3 2017-09-09 [1] CRAN (R 4.4.0)
## gtable 0.3.6 2024-10-25 [1] CRAN (R 4.4.3)
## gtools * 3.9.5 2023-11-20 [1] CRAN (R 4.4.0)
## haven 2.5.4 2023-11-30 [1] CRAN (R 4.4.0)
## Hmisc * 5.1-3 2024-05-28 [1] CRAN (R 4.4.0)
## hms 1.1.3 2023-03-21 [1] CRAN (R 4.4.0)
## htmlTable 2.4.3 2024-07-21 [1] CRAN (R 4.4.3)
## htmltools 0.5.8.1 2024-04-04 [1] CRAN (R 4.4.0)
## htmlwidgets 1.6.4 2023-12-06 [1] CRAN (R 4.4.0)
## httr 1.4.7 2023-08-15 [1] CRAN (R 4.4.0)
## insight 1.3.1 2025-06-30 [1] CRAN (R 4.4.3)
## jquerylib 0.1.4 2021-04-26 [1] CRAN (R 4.4.0)
## jsonlite 2.0.0 2025-03-27 [1] CRAN (R 4.4.3)
## kableExtra * 1.4.0 2024-01-24 [1] CRAN (R 4.4.0)
## knitr * 1.50 2025-03-16 [1] CRAN (R 4.4.3)
## labeling 0.4.3 2023-08-29 [1] CRAN (R 4.4.0)
## lattice 0.22-6 2024-03-20 [1] CRAN (R 4.4.0)
## lifecycle 1.0.4 2023-11-07 [1] CRAN (R 4.4.0)
## lme4 * 1.1-35.3 2024-04-16 [1] CRAN (R 4.4.0)
## lmtest * 0.9-40 2022-03-21 [1] CRAN (R 4.4.0)
## magrittr 2.0.3 2022-03-30 [1] CRAN (R 4.4.0)
## marginaleffects * 0.20.1 2024-05-08 [1] CRAN (R 4.4.0)
## MASS 7.3-60.2 2024-04-24 [1] local
## Matrix * 1.7-0 2024-03-22 [1] CRAN (R 4.4.0)
## memoise 2.0.1 2021-11-26 [1] CRAN (R 4.4.0)
## minqa 1.2.7 2024-05-20 [1] CRAN (R 4.4.0)
## mnormt 2.1.1 2022-09-26 [1] CRAN (R 4.4.0)
## multcomp 1.4-28 2025-01-29 [1] CRAN (R 4.4.3)
## mvtnorm 1.2-5 2024-05-21 [1] CRAN (R 4.4.1)
## nlme 3.1-164 2023-11-27 [1] CRAN (R 4.4.0)
## nloptr 2.0.3 2022-05-26 [1] CRAN (R 4.4.0)
## nnet 7.3-19 2023-05-03 [1] CRAN (R 4.4.0)
## parameters 0.27.0 2025-07-09 [1] CRAN (R 4.4.0)
## performance 0.14.0 2025-05-22 [1] CRAN (R 4.4.3)
## pillar 1.11.0 2025-07-04 [1] CRAN (R 4.4.3)
## pkgbuild 1.4.8 2025-05-26 [1] CRAN (R 4.4.3)
## pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 4.4.0)
## pkgload 1.4.1 2025-09-23 [1] CRAN (R 4.4.3)
## plyr * 1.8.9 2023-10-02 [1] CRAN (R 4.4.0)
## psych * 2.5.6 2025-06-23 [1] CRAN (R 4.4.3)
## purrr * 1.0.2 2023-08-10 [1] CRAN (R 4.4.0)
## qacDR * 0.1.0 2025-03-26 [1] Github (rkabacoff/qacDR@fd1d6a0)
## R6 2.6.1 2025-02-15 [1] CRAN (R 4.4.3)
## rbibutils 2.3 2024-10-04 [1] CRAN (R 4.4.3)
## RColorBrewer 1.1-3 2022-04-03 [1] CRAN (R 4.4.0)
## Rcpp 1.0.12 2024-01-09 [1] CRAN (R 4.4.0)
## Rdpack 2.6.4 2025-04-09 [1] CRAN (R 4.4.3)
## reformulas 0.4.1 2025-04-30 [1] CRAN (R 4.4.3)
## remotes 2.5.0 2024-03-17 [1] CRAN (R 4.4.0)
## rlang 1.1.4 2024-06-04 [1] CRAN (R 4.4.0)
## rmarkdown 2.29 2024-11-04 [1] CRAN (R 4.4.3)
## rpart 4.1.23 2023-12-05 [1] CRAN (R 4.4.0)
## rprojroot 2.1.1 2025-08-26 [1] CRAN (R 4.4.3)
## rstatix 0.7.2 2023-02-01 [1] CRAN (R 4.4.0)
## rstudioapi 0.17.1 2024-10-22 [1] CRAN (R 4.4.3)
## sandwich * 3.1-1 2024-09-15 [1] CRAN (R 4.4.3)
## sass 0.4.10 2025-04-11 [1] CRAN (R 4.4.3)
## scales 1.4.0 2025-04-24 [1] CRAN (R 4.4.3)
## sessioninfo 1.2.3 2025-02-05 [1] CRAN (R 4.4.3)
## sjlabelled * 1.2.0 2022-04-10 [1] CRAN (R 4.4.0)
## sjmisc 2.8.10 2024-05-13 [1] CRAN (R 4.4.0)
## sjPlot * 2.8.17 2024-11-29 [1] CRAN (R 4.4.3)
## sjstats 0.19.1 2025-06-13 [1] CRAN (R 4.4.3)
## snakecase 0.11.1 2023-08-27 [1] CRAN (R 4.4.1)
## stringi 1.8.4 2024-05-06 [1] CRAN (R 4.4.0)
## stringr 1.5.1 2023-11-14 [1] CRAN (R 4.4.0)
## survival 3.5-8 2024-02-14 [1] CRAN (R 4.4.0)
## svglite 2.1.3 2023-12-08 [1] CRAN (R 4.4.0)
## systemfonts 1.1.0 2024-05-15 [1] CRAN (R 4.4.0)
## texreg 1.39.4 2024-07-24 [1] CRAN (R 4.4.3)
## TH.data 1.1-3 2025-01-17 [1] CRAN (R 4.4.3)
## tibble 3.2.1 2023-03-20 [1] CRAN (R 4.4.0)
## tidyr * 1.3.1 2024-01-24 [1] CRAN (R 4.4.0)
## tidyselect 1.2.1 2024-03-11 [1] CRAN (R 4.4.0)
## usethis * 3.2.1 2025-09-06 [1] CRAN (R 4.4.3)
## vctrs 0.6.5 2023-12-01 [1] CRAN (R 4.4.0)
## viridisLite 0.4.2 2023-05-02 [1] CRAN (R 4.4.1)
## vtable * 1.4.8 2024-12-21 [1] CRAN (R 4.4.3)
## withr 3.0.2 2024-10-28 [1] CRAN (R 4.4.3)
## xfun 0.52 2025-04-02 [1] CRAN (R 4.4.3)
## xml2 1.3.6 2023-12-04 [1] CRAN (R 4.4.0)
## xtable 1.8-4 2019-04-21 [1] CRAN (R 4.4.0)
## yaml 2.3.8 2023-12-11 [1] CRAN (R 4.4.0)
## zoo * 1.8-12 2023-04-13 [1] CRAN (R 4.4.0)
##
## * ── Packages attached to the search path.
##
## ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────