# ============================================================ # process_expert.R - Expert Survey Data Processing # ============================================================ # Processes expert survey data from multiple sources: # - Chapel Hill Expert Survey (CHES) # - V-Party Dataset # - POPPA # - GPS (Norris) # # Outputs: expert_raw.csv, lr_data_raw.csv # # V5 changes: # - val_int (integer rounded to nearest scale point) and n_scale columns # - n_experts column preserved (not dropped) # - V-Party cultural expansion: 5 native items replace GPS ep_v6_lib_cons # - V-Party economic expansion: v2pawelf added # - Reverse-coding for V-Party cultural + welfare items # ============================================================ library(tidyverse) library(countrycode) library(haven) library(foreign) # Set working directory (works both in RStudio and command line) if (interactive() && requireNamespace("rstudioapi", quietly = TRUE)) { try(setwd(dirname(rstudioapi::getActiveDocumentContext()$path)), silent = TRUE) } cat("Processing expert survey data...\n") raw_data_dir <- Sys.getenv( "PARTY2D_RAW_DATA_DIR", unset = file.path("..", "..", "_local", "raw") ) ches_dir <- file.path(raw_data_dir, "ches") vparty_dir <- file.path(raw_data_dir, "vparty") poppa_dir <- file.path(raw_data_dir, "poppa") gps_dir <- file.path(raw_data_dir, "gps") partyfacts_path <- file.path(raw_data_dir, "partyfacts", "partyfacts-external-parties.csv") ches_country_iso2 <- function(country_id) { lookup <- c( `1` = "BE", `2` = "DK", `3` = "DE", `4` = "GR", `5` = "ES", `6` = "FR", `7` = "IE", `8` = "IT", `10` = "NL", `11` = "GB", `12` = "PT", `13` = "AT", `14` = "FI", `16` = "SE", `20` = "BG", `21` = "CZ", `22` = "EE", `23` = "HU", `24` = "LV", `25` = "LT", `26` = "PL", `27` = "RO", `28` = "SK", `29` = "SI", `31` = "HR", `32` = "TR", `33` = "NO", `34` = "CH", `35` = "MT", `36` = "CY", `37` = "IS", `38` = "CH", `40` = "CY" ) unname(lookup[as.character(country_id)]) } ches2024_country_iso2 <- function(country_id) { lookup <- c( `1` = "BE", `2` = "DK", `3` = "DE", `4` = "GR", `5` = "ES", `6` = "FR", `7` = "IE", `8` = "IT", `10` = "NL", `11` = "GB", `12` = "PT", `13` = "AT", `14` = "FI", `16` = "SE", `20` = "BG", `21` = "CZ", `22` = "EE", `23` = "HU", `24` = "LV", `25` = "LT", `26` = "PL", `27` = "RO", `28` = "SK", `29` = "SI", `31` = "HR", `34` = "TR", `35` = "NO", `36` = "CH", `37` = "MT", `40` = "CY", `45` = "IS" ) unname(lookup[as.character(country_id)]) } # ============================================================ # PartyFacts Linkage for CHES # ============================================================ partyfacts_raw <- read_csv(partyfacts_path, show_col_types = FALSE) ches_link <- partyfacts_raw %>% filter(dataset_key == "ches") %>% transmute(id = dataset_party_id, country = countrycode(country, origin = 'iso3c', destination = "iso2c"), party = partyfacts_id) # ============================================================ # Expert Count Tables (from individual response files) # ============================================================ cat(" Loading expert count tables from individual response files...\n") # CHES 2024: dual lookup (party_id primary, country+name fallback for ID mismatches) ches24_exp_raw <- read_csv(file.path(ches_dir, 'CHES_2024_expert_level.csv'), show_col_types = FALSE) ches24_exp_by_id <- ches24_exp_raw %>% group_by(party_id) %>% summarise(n_experts_id = as.integer(n_distinct(id)), .groups = "drop") ches24_exp_by_name <- ches24_exp_raw %>% mutate(country_iso2 = countrycode(cname, origin = "country.name", destination = "iso2c")) %>% group_by(country_iso2, party_name) %>% summarise(n_experts_name = as.integer(n_distinct(id)), .groups = "drop") ches_ca_expert_counts <- read_csv(file.path(ches_dir, 'CHES_CA2023_expert_level.csv'), show_col_types = FALSE) %>% group_by(party_id) %>% summarise(n_experts = as.integer(n_distinct(expert)), .groups = "drop") ches_la_expert_counts <- read_csv(file.path(ches_dir, 'CHES_LA2020_expert_level.csv'), show_col_types = FALSE) %>% group_by(party_id) %>% summarise(n_experts = as.integer(n_distinct(expert_id)), .groups = "drop") ches_il_expert_counts <- read_csv(file.path(ches_dir, 'CHES_IL_expert_level.csv'), show_col_types = FALSE) %>% group_by(party_id, year) %>% summarise(n_experts = as.integer(n_distinct(id)), .groups = "drop") # ============================================================ # Chapel Hill Expert Survey (CHES) - 1999-2019 # ============================================================ cat(" Processing CHES 1999-2019...\n") ches <- read_csv(file.path(ches_dir, '1999-2019_CHES_dataset_means(v3).csv'), show_col_types = FALSE) %>% rename(country_id = country) %>% transmute(country = ches_country_iso2(country_id), vote = vote, year = year, id = as.character(party_id), project = 'CHES', n_experts = as.integer(expert), lrecon_ches = lrecon/10, galtan_ches = galtan/10) %>% pivot_longer(cols = lrecon_ches:galtan_ches, names_to = 'var', values_to = 'val') %>% mutate(n_scale = 10L) %>% left_join(ches_link, by = c("id", "country")) %>% filter(!is.na(val), !is.na(party), !is.na(country)) %>% select(-id) %>% mutate(type_low = ifelse(var == "lrecon_ches", "pro_welfare", "cosmopolitan"), type_high = ifelse(var == "lrecon_ches", "pro_market", "traditional")) # ============================================================ # CHES 2024 Update # ============================================================ cat(" Processing CHES 2024...\n") # Country code lookup for CHES 2024 format country_lookup <- c( "be" = "BE", "dk" = "DK", "ge" = "DE", "gr" = "GR", "esp" = "ES", "fr" = "FR", "irl" = "IE", "it" = "IT", "nl" = "NL", "uk" = "GB", "por" = "PT", "aus" = "AT", "fin" = "FI", "sv" = "SE", "bul" = "BG", "cz" = "CZ", "est" = "EE", "hun" = "HU", "lat" = "LV", "lith" = "LT", "pol" = "PL", "rom" = "RO", "slo" = "SK", "sle" = "SI", "cro" = "HR", "tur" = "TR", "nor" = "NO", "swi" = "CH", "mal" = "MT", "cyp" = "CY", "ice" = "IS" ) convert_country_codes <- function(codes) { numeric_result <- ches2024_country_iso2(codes) result <- country_lookup[codes] result[is.na(result)] <- numeric_result[is.na(result)] result[is.na(result)] <- codes[is.na(result)] return(unname(result)) } ches24 <- read_csv(file.path(ches_dir, 'CHES_2024_final_v2.csv'), show_col_types = FALSE) %>% mutate(country_iso2 = convert_country_codes(country)) %>% left_join(ches24_exp_by_id, by = "party_id") %>% left_join(ches24_exp_by_name, by = c("country_iso2", "party" = "party_name")) %>% transmute(country = country_iso2, vote = vote, year = 2024, id = as.character(party_id), project = 'CHES', n_experts = coalesce(n_experts_id, n_experts_name), lrecon_ches = lrecon/10, galtan_ches = galtan/10) %>% pivot_longer(cols = lrecon_ches:galtan_ches, names_to = 'var', values_to = 'val') %>% mutate(n_scale = 10L) %>% left_join(ches_link, by = c("id", "country")) %>% filter(!is.na(val), !is.na(party), !is.na(country)) %>% select(-id) %>% mutate(type_low = ifelse(var == "lrecon_ches", "pro_welfare", "cosmopolitan"), type_high = ifelse(var == "lrecon_ches", "pro_market", "traditional")) ches <- bind_rows(ches, ches24) # ============================================================ # CHES Canada 2023 # ============================================================ cat(" Processing CHES Canada 2023...\n") ches_ca <- read_csv(file.path(ches_dir, 'CHES_CA2023.csv'), show_col_types = FALSE) %>% filter(!is.na(partyfacts_id)) %>% left_join(ches_ca_expert_counts, by = "party_id") %>% transmute(country = "CA", year = 2023, party = partyfacts_id, project = 'CHES', n_experts = n_experts, lrecon_ches = lrecon/10, galtan_ches = galtan/10) %>% pivot_longer(cols = lrecon_ches:galtan_ches, names_to = 'var', values_to = 'val') %>% mutate(n_scale = 10L) %>% filter(!is.na(val), !is.na(party)) %>% mutate(type_low = ifelse(var == "lrecon_ches", "pro_welfare", "cosmopolitan"), type_high = ifelse(var == "lrecon_ches", "pro_market", "traditional")) ches <- bind_rows(ches, ches_ca) cat(sprintf(" CHES Canada: %d observations\n", nrow(ches_ca))) # ============================================================ # CHES Latin America 2020 # ============================================================ cat(" Processing CHES Latin America 2020...\n") ches_la_link <- partyfacts_raw %>% filter(dataset_key == "ches") %>% transmute(id = as.character(dataset_party_id), country = countrycode(country, origin = "iso3c", destination = "iso2c"), party = partyfacts_id) ches_la <- read_csv(file.path(ches_dir, 'ches_la_2020_aggregate_level_v01.csv'), show_col_types = FALSE) %>% left_join(ches_la_expert_counts, by = "party_id") %>% transmute(country = toupper(country_abb), year = 2020, id = as.character(party_id), project = 'CHES', n_experts = n_experts, lrecon_ches = lrecon/10, galtan_ches = galtan/10) %>% pivot_longer(cols = lrecon_ches:galtan_ches, names_to = 'var', values_to = 'val') %>% mutate(n_scale = 10L) %>% left_join(ches_la_link, by = c("id", "country")) %>% filter(!is.na(val), !is.na(party), !is.na(country)) %>% select(-id) %>% mutate(type_low = as.character(ifelse(var == "lrecon_ches", "pro_welfare", "cosmopolitan")), type_high = as.character(ifelse(var == "lrecon_ches", "pro_market", "traditional"))) ches <- bind_rows(ches, ches_la) cat(sprintf(" CHES Latin America: %d observations\n", nrow(ches_la))) # ============================================================ # CHES Israel 2021-2022 # ============================================================ cat(" Processing CHES Israel 2021-2022...\n") ches_il_link <- partyfacts_raw %>% filter(dataset_key == "ches") %>% transmute(id = as.character(dataset_party_id), country = countrycode(country, origin = "iso3c", destination = "iso2c"), party = partyfacts_id) ches_il <- read_csv(file.path(ches_dir, 'CHES_ISRAEL_means_2021_2022.csv'), show_col_types = FALSE) %>% left_join(ches_il_expert_counts, by = c("party_id", "year")) %>% transmute(country = "IL", year = year, id = as.character(party_id), project = 'CHES', n_experts = n_experts, lrecon_ches = lrecon/10, galtan_ches = galtan/10) %>% pivot_longer(cols = lrecon_ches:galtan_ches, names_to = 'var', values_to = 'val') %>% mutate(n_scale = 10L) %>% left_join(ches_il_link, by = c("id", "country")) %>% filter(!is.na(val), !is.na(party), !is.na(country)) %>% select(-id) %>% mutate(type_low = ifelse(var == "lrecon_ches", "pro_welfare", "cosmopolitan"), type_high = ifelse(var == "lrecon_ches", "pro_market", "traditional")) ches <- bind_rows(ches, ches_il) cat(sprintf(" CHES Israel: %d observations\n", nrow(ches_il))) cat(sprintf(" CHES total: %d observations\n", nrow(ches))) # ============================================================ # CHES General Left-Right (for anchoring) # ============================================================ cat(" Processing CHES LR anchoring data...\n") ches_lr <- read_csv(file.path(ches_dir, '1999-2019_CHES_dataset_means(v3).csv'), show_col_types = FALSE) %>% rename(country_id = country) %>% transmute(country = ches_country_iso2(country_id), vote = vote, year = year, id = as.character(party_id), project = 'CHES', n_experts = as.integer(expert), val = lrgen/10, var = 'lr_ches', n_scale = 10L) %>% left_join(ches_link, by = c("id", "country")) %>% filter(!is.na(val), !is.na(party), !is.na(country)) %>% select(-id) ches24_lr <- read_csv(file.path(ches_dir, 'CHES_2024_final_v2.csv'), show_col_types = FALSE) %>% mutate(country_iso2 = convert_country_codes(country)) %>% left_join(ches24_exp_by_id, by = "party_id") %>% left_join(ches24_exp_by_name, by = c("country_iso2", "party" = "party_name")) %>% transmute(country = country_iso2, vote = vote, year = 2024, id = as.character(party_id), project = 'CHES', n_experts = coalesce(n_experts_id, n_experts_name), val = lrgen/10, var = 'lr_ches', n_scale = 10L) %>% left_join(ches_link, by = c("id", "country")) %>% filter(!is.na(val), !is.na(party), !is.na(country)) %>% select(-id) # CHES Canada LR ches_ca_lr <- read_csv(file.path(ches_dir, 'CHES_CA2023.csv'), show_col_types = FALSE) %>% filter(!is.na(partyfacts_id)) %>% left_join(ches_ca_expert_counts, by = "party_id") %>% transmute(country = "CA", year = 2023, party = partyfacts_id, project = 'CHES', n_experts = n_experts, val = lrgen/10, var = 'lr_ches', n_scale = 10L) %>% filter(!is.na(val), !is.na(party)) # CHES Latin America LR ches_la_lr <- read_csv(file.path(ches_dir, 'ches_la_2020_aggregate_level_v01.csv'), show_col_types = FALSE) %>% left_join(ches_la_expert_counts, by = "party_id") %>% transmute(country = toupper(country_abb), year = 2020, id = as.character(party_id), project = 'CHES', n_experts = n_experts, val = lrgen/10, var = 'lr_ches', n_scale = 10L) %>% left_join(ches_la_link, by = c("id", "country")) %>% filter(!is.na(val), !is.na(party), !is.na(country)) %>% select(-id) # CHES Israel LR ches_il_lr <- read_csv(file.path(ches_dir, 'CHES_ISRAEL_means_2021_2022.csv'), show_col_types = FALSE) %>% left_join(ches_il_expert_counts, by = c("party_id", "year")) %>% transmute(country = "IL", year = year, id = as.character(party_id), project = 'CHES', n_experts = n_experts, val = lrgen/10, var = 'lr_ches', n_scale = 10L) %>% left_join(ches_il_link, by = c("id", "country")) %>% filter(!is.na(val), !is.na(party), !is.na(country)) %>% select(-id) ches_lr <- bind_rows(ches_lr, ches24_lr, ches_ca_lr, ches_la_lr, ches_il_lr) # ============================================================ # V-Party Dataset (V5: expanded to 7 variables) # ============================================================ cat(" Processing V-Party...\n") vparty_raw <- readRDS(file.path(vparty_dir, 'V-Dem-CPD-Party-V2.rds')) # Economic 1: v2pariglef_osp (0-6 scale, higher = more right, NO reverse) vparty_econ1 <- vparty_raw %>% transmute( country = countrycode(country_name, origin = "country.name", destination = "iso2c"), year = year, party = pf_party_id, project = "V-Party", n_experts = as.integer(v2pariglef_nr), val = v2pariglef_osp / 6, val_int = as.integer(round(v2pariglef_osp)), n_scale = 6L, var = "lrecon_vparty", type_low = "pro_welfare", type_high = "pro_market" ) %>% na.omit() # Economic 2 (NEW): v2pawelf_osp (0-5 scale, higher = more welfare = LEFT, REVERSE) vparty_econ2 <- vparty_raw %>% transmute( country = countrycode(country_name, origin = "country.name", destination = "iso2c"), year = year, party = pf_party_id, project = "V-Party", n_experts = as.integer(v2pawelf_nr), val = 1 - v2pawelf_osp / 5, val_int = 5L - as.integer(round(v2pawelf_osp)), n_scale = 5L, var = "welf_vparty", type_low = "pro_welfare", type_high = "pro_market" ) %>% na.omit() # Cultural 1 (NEW): v2paimmig_osp (0-4 scale, higher = more pro-immigration = GAL, REVERSE) vparty_cult1 <- vparty_raw %>% transmute( country = countrycode(country_name, origin = "country.name", destination = "iso2c"), year = year, party = pf_party_id, project = "V-Party", n_experts = as.integer(v2paimmig_nr), val = 1 - v2paimmig_osp / 4, val_int = 4L - as.integer(round(v2paimmig_osp)), n_scale = 4L, var = "immig_vparty", type_low = "cosmopolitan", type_high = "traditional" ) %>% na.omit() # Cultural 2 (NEW): v2palgbt_osp (0-4 scale, higher = more pro-LGBT = GAL, REVERSE) vparty_cult2 <- vparty_raw %>% transmute( country = countrycode(country_name, origin = "country.name", destination = "iso2c"), year = year, party = pf_party_id, project = "V-Party", n_experts = as.integer(v2palgbt_nr), val = 1 - v2palgbt_osp / 4, val_int = 4L - as.integer(round(v2palgbt_osp)), n_scale = 4L, var = "lgbt_vparty", type_low = "cosmopolitan", type_high = "traditional" ) %>% na.omit() # Cultural 3 (NEW): v2paculsup_osp (0-4 scale, higher = less cultural superiority = GAL, REVERSE) vparty_cult3 <- vparty_raw %>% transmute( country = countrycode(country_name, origin = "country.name", destination = "iso2c"), year = year, party = pf_party_id, project = "V-Party", n_experts = as.integer(v2paculsup_nr), val = 1 - v2paculsup_osp / 4, val_int = 4L - as.integer(round(v2paculsup_osp)), n_scale = 4L, var = "culsup_vparty", type_low = "cosmopolitan", type_high = "traditional" ) %>% na.omit() # Cultural 4 (NEW): v2parelig_osp (0-4 scale, higher = less religious = GAL, REVERSE) vparty_cult4 <- vparty_raw %>% transmute( country = countrycode(country_name, origin = "country.name", destination = "iso2c"), year = year, party = pf_party_id, project = "V-Party", n_experts = as.integer(v2parelig_nr), val = 1 - v2parelig_osp / 4, val_int = 4L - as.integer(round(v2parelig_osp)), n_scale = 4L, var = "relig_vparty", type_low = "cosmopolitan", type_high = "traditional" ) %>% na.omit() # Cultural 5 (NEW): v2pagender_osp (0-4 scale, higher = more pro-gender equality = GAL, REVERSE) vparty_cult5 <- vparty_raw %>% transmute( country = countrycode(country_name, origin = "country.name", destination = "iso2c"), year = year, party = pf_party_id, project = "V-Party", n_experts = as.integer(v2pagender_nr), val = 1 - v2pagender_osp / 4, val_int = 4L - as.integer(round(v2pagender_osp)), n_scale = 4L, var = "gender_vparty", type_low = "cosmopolitan", type_high = "traditional" ) %>% na.omit() vparty <- bind_rows(vparty_econ1, vparty_econ2, vparty_cult1, vparty_cult2, vparty_cult3, vparty_cult4, vparty_cult5) cat(sprintf(" V-Party: %d observations (7 variables)\n", nrow(vparty))) cat(sprintf(" lrecon: %d, welf: %d\n", nrow(vparty_econ1), nrow(vparty_econ2))) cat(sprintf(" immig: %d, lgbt: %d, culsup: %d, relig: %d, gender: %d\n", nrow(vparty_cult1), nrow(vparty_cult2), nrow(vparty_cult3), nrow(vparty_cult4), nrow(vparty_cult5))) # ============================================================ # POPPA Dataset # ============================================================ cat(" Processing POPPA...\n") poppa <- readRDS(file.path(poppa_dir, 'poppa_integrated_v2.rds')) %>% transmute(country = countrycode(country_short, origin = "iso3c", destination = "iso2c"), party = partyfacts_id, val = lrecon/10, var = "lrecon_poppa", type_low = "pro_welfare", type_high = "pro_market", n_experts = as.integer(n_experts), n_scale = 10L, year = as.numeric(sub(".*-\\s*(\\d+)", "\\1", wave)), project = "POPPA") %>% na.omit() cat(sprintf(" POPPA: %d observations\n", nrow(poppa))) # POPPA General LR poppa_lr <- readRDS(file.path(poppa_dir, 'poppa_integrated_v2.rds')) %>% transmute(country = countrycode(country_short, origin = "iso3c", destination = "iso2c"), party = partyfacts_id, val = lroverall/10, var = "lr_poppa", n_experts = as.integer(n_experts), n_scale = 10L, year = as.numeric(sub(".*-\\s*(\\d+)", "\\1", wave)), project = "POPPA") %>% na.omit() # ============================================================ # GPS (Norris) Survey # ============================================================ cat(" Processing GPS...\n") gps <- read.delim(file.path(gps_dir, "Global Party Survey by Party SPSS V2_1_Apr_2020-2.tab")) %>% transmute(n_experts = as.integer(Experts), lrecon_gps = as.numeric(V4_Scale)/10, libcon_gps = as.numeric(V6_Scale)/10, party = ID_PartyFacts, country = countrycode(ifelse(ISO == "MAC", "MKD", ISO), origin = "iso3c", destination = "iso2c"), year = 2019, n_scale = 10L, project = "GPS") %>% pivot_longer(cols = lrecon_gps:libcon_gps, names_to = 'var', values_to = 'val') %>% mutate(type_low = ifelse(var == "lrecon_gps", "pro_welfare", "cosmopolitan"), type_high = ifelse(var == "lrecon_gps", "pro_market", "traditional")) %>% na.omit() cat(sprintf(" GPS: %d observations\n", nrow(gps))) # ============================================================ # Combine Expert Data # ============================================================ cat(" Combining expert surveys...\n") expert_raw <- select(ches, -vote) %>% bind_rows(vparty) %>% bind_rows(gps) %>% bind_rows(poppa) %>% unique() %>% arrange(country, party, year, var) %>% filter(!is.na(val), !is.na(party), !is.na(country), !is.na(var)) # Compute val_int for datasets that don't have it pre-computed # V-Party already has val_int; CHES/GPS/POPPA need it computed from val * n_scale expert_raw <- expert_raw %>% mutate( val_int = ifelse(is.na(val_int), as.integer(round(val * n_scale)), val_int), val_int = pmin(pmax(val_int, 0L), n_scale) ) # Boundary adjustments for continuous val (avoid exact 0 or 1 for Stan prior means) expert_raw <- expert_raw %>% mutate( val = case_when( val == 0 ~ val + 1e-4, val == 1 ~ val - 1e-4, TRUE ~ val )) # ============================================================ # Combine LR Data # ============================================================ lr_data_raw <- ches_lr %>% bind_rows(poppa_lr) %>% select(-any_of("vote")) # Boundary adjustments for continuous val (avoid exact 0 or 1) lr_data_raw <- lr_data_raw %>% mutate( val = case_when( val == 0 ~ val + 1e-4, val == 1 ~ val - 1e-4, TRUE ~ val )) # Compute val_int for LR data lr_data_raw <- lr_data_raw %>% mutate( val_int = as.integer(round(val * n_scale)), val_int = pmin(pmax(val_int, 0L), n_scale) ) # ============================================================ # Write Outputs # ============================================================ write_csv(expert_raw, "expert_raw.csv") write_csv(lr_data_raw, "lr_data_raw.csv") cat(sprintf("\nOutputs written:\n")) cat(sprintf(" expert_raw.csv: %d rows\n", nrow(expert_raw))) cat(sprintf(" lr_data_raw.csv: %d rows\n", nrow(lr_data_raw))) cat("\n Expert data by source:\n") expert_raw %>% group_by(project) %>% summarise(n = n(), .groups = "drop") %>% print() cat("\n New columns check:\n") cat(sprintf(" val_int range: %d - %d\n", min(expert_raw$val_int), max(expert_raw$val_int))) cat(sprintf(" n_scale values: %s\n", paste(sort(unique(expert_raw$n_scale)), collapse = ", "))) cat(sprintf(" n_experts non-NA: %d / %d\n", sum(!is.na(expert_raw$n_experts)), nrow(expert_raw)))