s4_age_midpoints <- c(
`4` = 23.5, # 18-29
`5` = 37, # 30-44
`6` = 52, # 45-59
`7` = 67 # 60+
)
s4_cleaned_ids <- readxl::read_excel(
here::here("data", "raw_data", "s4", "Study 4_DE-CONSPIRATOR Survey_cleaned.xlsx"),
sheet = 1
) %>% dplyr::pull(ResponseId) %>% unique() # canonical retained respondents
s4_region_mapping_raw <- readr::read_csv(
here::here("data", "raw_data", "s4", "Study 4_participant-region-mapping.csv"),
show_col_types = FALSE
)
s4_participant_regions <- s4_region_mapping_raw %>%
transmute(
psid = ENCRYPTED_ID,
panel_source_country = stringr::str_to_upper(`Panel Source Country`)
) %>%
filter(!is.na(psid), psid != "", !is.na(panel_source_country), panel_source_country != "") %>%
distinct(psid, .keep_all = TRUE)
s4_participant_regions_external_pid <- s4_region_mapping_raw %>%
transmute(
external_pid = EXTERNAL_PID,
panel_source_country = stringr::str_to_upper(`Panel Source Country`)
) %>%
filter(!is.na(external_pid), external_pid != "", !is.na(panel_source_country), panel_source_country != "") %>%
distinct(external_pid, .keep_all = TRUE)
stopifnot(!anyDuplicated(s4_participant_regions$psid)) # one residence record per panel ID
stopifnot(!anyDuplicated(s4_participant_regions_external_pid$external_pid)) # second provider ID is unique but currently not joinable
s4_prepared <- raw_data$S4 %>%
rename(
response_id = responseid,
start_time_raw = startdate,
end_time_raw = enddate,
recorded_time_raw = recordeddate,
duration_seconds = duration_in_seconds,
lang = userlanguage, # Qualtrics-recorded survey language (ISO code)
age_bracket = year, # raw "How old are you?" coded as 18-29 / 30-44 / 45-59 / 60+
att_q16 = q16_attention_check # explicit attention check (3 = "Newspaper")
) %>%
rename_with(~ stringr::str_replace(.x, "^q6__", "q6_"), .cols = dplyr::matches("^q6__")) %>% # collapse the double-underscore artefact on Q6 items
mutate(
country_of_origin = country, # duplicate birth-country item so the placeholder status remains explicit
start_time = lubridate::ymd_hms(start_time_raw, tz = "UTC"),
end_time = lubridate::ymd_hms(end_time_raw, tz = "UTC"),
recorded_time = lubridate::ymd_hms(recorded_time_raw, tz = "UTC"),
start_time_local = lubridate::with_tz(start_time, "Europe/Brussels"), # single CET reference for the multi-country sample
end_time_local = lubridate::with_tz(end_time, "Europe/Brussels"),
recorded_date = as.Date(recorded_time),
study = "S4_INTL_2025"
)
s4_numeric_all <- s4_prepared %>%
mutate(across(where(haven::is.labelled), haven::zap_labels)) # logical filters operate on numerics
s4_conditions <- list(
"Provided informed consent" = rlang::expr(consent == 1),
"Finished survey" = rlang::expr(finished == 1),
"Retained in cleaned ID list (Q16 attention check)" = rlang::expr(response_id %in% s4_cleaned_ids)
)
s4_flow_res <- run_flow(s4_numeric_all, s4_conditions, id_var = "response_id")
s4_flow <- format_flow_table(s4_flow_res$log)
s4_ids_keep <- s4_flow_res$data$response_id
s4_fast_cutoff <- stats::quantile(s4_numeric_all$duration_seconds, probs = 0.01, na.rm = TRUE)
s4_factor_vars <- c("consent", "gender", "education", "marital_st", "country", "country_of_origin", "lang", "age_bracket", "cond")
s4_clean <- s4_prepared %>%
filter(response_id %in% s4_ids_keep) %>%
distinct(response_id, .keep_all = TRUE) %>%
mutate(across(all_of(s4_factor_vars), make_factor, .names = "{.col}_fct")) %>%
mutate(across(where(haven::is.labelled), haven::zap_labels)) %>%
mutate(
age_midpoint = as.numeric(dplyr::recode(as.character(age_bracket), !!!s4_age_midpoints)),
duration_minutes = duration_seconds / 60,
fast_completion = duration_seconds < s4_fast_cutoff,
att_pass_q16 = att_q16 == 3, # primary attention check (already enforced by the cleaned ID list, retained for transparency)
att_pass_embedded = att == 4, # secondary embedded check inside the DisInformeter block
att_pass_q29 = q29_2 == 1 # tertiary check embedded in the EU referendum item
) %>%
select(-start_time_raw, -end_time_raw, -recorded_time_raw) %>%
relocate(any_of(c(
"study", "response_id", "start_time", "end_time", "start_time_local",
"end_time_local", "recorded_time", "recorded_date", "duration_seconds", "duration_minutes",
"fast_completion", "progress", "finished", "consent", "cond", "cond_fct",
"country", "country_fct", "country_of_origin", "country_of_origin_fct",
"lang", "lang_fct", "age_bracket", "age_bracket_fct", "age_midpoint",
"gender", "gender_fct", "education", "education_fct", "marital_st", "marital_st_fct",
"att_q16", "att", "att_pass_q16", "att_pass_embedded", "att_pass_q29"
)))
s4_region_mapping_audit <- s4_clean %>%
mutate(region_mapping_available = psid %in% s4_participant_regions$psid) %>%
summarise(
retained_n = n(),
unique_retained_psid_n = n_distinct(psid),
region_mapping_rows_n = nrow(s4_region_mapping_raw),
unique_region_mapping_psid_n = n_distinct(s4_participant_regions$psid),
external_pid_rows_n = nrow(s4_participant_regions_external_pid),
unique_external_pid_n = n_distinct(s4_participant_regions_external_pid$external_pid),
matched_rows_n = sum(region_mapping_available),
unmatched_rows_n = sum(!region_mapping_available),
matched_unique_psid_n = n_distinct(psid[region_mapping_available]),
unmatched_unique_psid_n = n_distinct(psid[!region_mapping_available]),
mapping_ids_not_retained_n = sum(!s4_participant_regions$psid %in% psid),
external_pid_matches_psid_n = sum(psid %in% s4_participant_regions_external_pid$external_pid),
external_pid_matches_response_id_n = sum(response_id %in% s4_participant_regions_external_pid$external_pid),
mapping_ids_with_literal_star_n = sum(stringr::str_detect(s4_region_mapping_raw$ENCRYPTED_ID, stringr::fixed("*"))),
raw_psids_with_literal_star_n = sum(stringr::str_detect(psid, stringr::fixed("*"))),
panel_source_country_n = n_distinct(s4_region_mapping_raw$`Panel Source Country`),
encrypted_id_panel_source_country_n = n_distinct(s4_participant_regions$panel_source_country),
external_pid_panel_source_country_n = n_distinct(s4_participant_regions_external_pid$panel_source_country),
origin_country_n = n_distinct(country_of_origin_fct, na.rm = TRUE),
survey_language_n = n_distinct(lang_fct, na.rm = TRUE)
)
s4_region_mapping_panel_countries <- sort(unique(stats::na.omit(s4_region_mapping_raw[["Panel Source Country"]])))
s4_region_mapping_coverage_by_origin <- s4_clean %>%
mutate(region_mapping_available = psid %in% s4_participant_regions$psid) %>%
count(country_of_origin_fct, region_mapping_available, name = "n") %>%
tidyr::pivot_wider(
names_from = region_mapping_available,
values_from = n,
values_fill = 0,
names_prefix = "mapped_"
) %>%
rename(
origin_country = country_of_origin_fct,
unmapped_n = mapped_FALSE,
mapped_n = mapped_TRUE
) %>%
mutate(total_n = mapped_n + unmapped_n, mapped_pct = mapped_n / total_n) %>%
arrange(desc(unmapped_n), desc(total_n))
# DisInformeter measurement items (carry the S2/S3 naming) plus the cross-national outcome battery (Q*).
# The include pattern anchors each construct prefix to a digit so that pre-computed Qualtrics
# aggregate columns ("threat", "aband", "general", "newsorder", ...) and demographics like
# "gender" are NOT mistaken for items. The exclude pattern then drops Qualtrics timing blocks
# (Q146–Q169 page-level click timers), free-text follow-ups, and the engineered attention flags.
s4_item_columns <- names(s4_clean) %>%
stringr::str_subset("^(gen[0-9]|th[0-9]|ab[0-9]|pa[0-9]|fru[0-9]|fch[0-9]|news[0-9]|att$|q[0-9])") %>%
stringr::str_subset("(_first_click$|_last_click$|_page_submit$|_click_count$|_text$|^q_|^q1(46|47|48|49|50|51|56|57|58|59|61|62|63|65|66|67|68|69)(_|$)|^att_pass_)", negate = TRUE)
# Scale registry — grouped by purpose. Items are listed once each; constructs that have
# multiple plausible operationalisations (e.g. THREAT in the long vs short DisInformeter)
# are exposed under separate names so downstream models can pick freely.
s4_scale_items <- list(
# ---- Outcome (DV) — FIMI news-evaluation items --------------------------------
# Same 8-item battery + 4-item source-balanced short form as S2/S3. Outcome
# the DisInformeter scale is designed to predict — NOT part of the scale itself.
FIMI = paste0("news", 1:8),
FIMI_SHORT = c("news2", "news5", "news7", "news8"),
# ---- DisInformeter scale predictors (cross-national validation in 03d) --------
# Registry keys drive Layer-2 column naming; canonical SEM latents in
# R/sem_specs.R are:
# PRAG / PRAG_LONG -> FEAR (affective fear / pragmatic accommodation)
# SUPR -> SUPF (S4 fields *affective* admiration via `fru*`)
# SUPCH -> SUPFCH (S4 fields affective China admiration via `fch*`)
GEN = c("gen1", "gen2", "gen3", "gen5", "gen7"),
THREAT = c("th9", "th6"), # core indicators retained from S2/S3 (th4 is absent in S4)
THREAT_LONG = c("th1", "th5", "th6", "th7", "th8", "th9", "th10"),
ABAND = c("ab2", "ab4", "ab7"), # S2/S3 ABAND triplet
ABAND_LONG = c("ab1", "ab2", "ab3", "ab4", "ab7", "ab8"),
PRAG = c("pa2"), # only PRAG anchor available (pa6 is absent in S4); SEM latent: FEAR
PRAG_LONG = c("pa1", "pa2", "pa4"), # SEM latent: FEAR
SUPR = c("fru1", "fru2", "fru3"), # Russia *affective* admiration; SEM latent: SUPF
SUPCH = c("fch1", "fch2", "fch3"), # China *affective* admiration (new in S4); SEM latent: SUPFCH
# ---- Misinformation perceptions and behaviours (candidate COND outcomes) -----
MEDIA_FREQ = c("q3_1", "q3_2", "q3_3", "q3_4", "q3_5"), # frequency of media use for news
MISINFO_REGUL = c("q4_2", "q4_5"), # pro-regulation attitudes
MISINFO_FREE = c("q4_4"), # free-speech preference (reverse-keyed)
MISINFO_CONF = c("q4_1"), # confidence in detecting misinfo
MISINFO_POL = c("q4_3"), # belief that misinfo is politically intentional
MISINFO_SRC = c("q5_1", "q5_2", "q5_3", "q5_4", "q5_5", "q5_6", "q5_7", "q5_8", "q5_9"),
MISINFO_FOREIGN = c("q6_1", "q6_2", "q6_3", "q6_4", "q6_5", "q6_6", "q6_7", "q6_8", "q6_9"),
CLICK_REASONS = c("q11_1", "q11_2", "q11_3", "q11_4", "q11_5", "q11_6"),
MISINFO_ACTION = c("q12_1", "q12_2", "q12_3", "q12_4", "q12_5", "q12_6"), # binary-style behavioural set
MISINFO_IMPACT = c("q14_1", "q14_2", "q14_3", "q14_4", "q14_5", "q14_6"),
MISINFO_RESP = c("q15_1", "q15_2", "q15_3", "q15_4", "q15_5", "q15_6", "q15_7", "q15_8", "q15_9"),
# ---- Civic / political attitudes (broader COND outcomes) ----------------------
SOC_TRUST = c("q17", "q18", "q19"), # ESS-style generalised social trust (0–10 with 1-shift)
INST_TRUST = c("q23_1", "q23_2", "q23_3", "q23_4", "q23_5", "q23_6", "q23_7", "q23_8"),
POL_PARTIC = c("q25_1", "q25_2", "q25_3", "q25_4", "q25_5", "q25_6", "q25_7", "q25_8"), # excludes "None" and free-text
EU_SUPPORT = c("q28"),
DEM_IMPORT = c("q30"),
LIFE_SAT = c("q27"),
LR_SCALE = c("q26"),
POL_INTEREST = c("q20"),
POL_EFF_EXT = c("q21"),
POL_EFF_INT = c("q22"),
RELIGIOSITY = c("q32")
)
# Three-way taxonomy for S4. The DisInformeter scale predictors live alongside the
# experimental-condition outcomes; FIMI is the *primary* outcome the scale predicts,
# while the Q-block items are *secondary* outcomes for the COND treatment effects.
s4_construct_taxonomy <- list(
outcome = c("FIMI", "FIMI_SHORT"),
predictor = c("GEN", "THREAT", "THREAT_LONG", "ABAND", "ABAND_LONG",
"PRAG", "PRAG_LONG", "SUPR", "SUPCH"),
cond_outcome = c("MEDIA_FREQ", "MISINFO_REGUL", "MISINFO_FREE", "MISINFO_CONF",
"MISINFO_POL", "MISINFO_SRC", "MISINFO_FOREIGN", "CLICK_REASONS",
"MISINFO_ACTION", "MISINFO_IMPACT", "MISINFO_RESP",
"SOC_TRUST", "INST_TRUST", "POL_PARTIC", "EU_SUPPORT",
"DEM_IMPORT", "LIFE_SAT", "LR_SCALE", "POL_INTEREST",
"POL_EFF_EXT", "POL_EFF_INT", "RELIGIOSITY"),
validation = character()
)