Publish party-position estimates and validation materials
This commit is contained in:
Armin Seimel
@@ -0,0 +1,16 @@
|
||||
#!/usr/bin/env Rscript
|
||||
|
||||
repo_root <- normalizePath(getwd(), mustWork = TRUE)
|
||||
lib <- Sys.getenv("R_LIBS_USER", file.path(repo_root, "_local", "R", "library"))
|
||||
dir.create(lib, recursive = TRUE, showWarnings = FALSE)
|
||||
.libPaths(c(lib, .libPaths()))
|
||||
|
||||
required <- c("tidyverse", "countrycode", "haven", "foreign", "jsonlite")
|
||||
missing <- required[!vapply(required, requireNamespace, quietly = TRUE, FUN.VALUE = logical(1))]
|
||||
|
||||
if (length(missing) > 0) {
|
||||
message("Installing missing R packages into ", lib, ": ", paste(missing, collapse = ", "))
|
||||
install.packages(missing, repos = "https://cloud.r-project.org", lib = lib)
|
||||
} else {
|
||||
message("R data-setup dependencies already available")
|
||||
}
|
||||
@@ -0,0 +1,203 @@
|
||||
#!/usr/bin/env Rscript
|
||||
|
||||
args <- commandArgs(trailingOnly = FALSE)
|
||||
file_arg <- args[grepl("^--file=", args)][1]
|
||||
if (!is.na(file_arg)) {
|
||||
script_path <- sub("^--file=", "", file_arg)
|
||||
repo_root <- normalizePath(file.path(dirname(script_path), "..", ".."), mustWork = FALSE)
|
||||
} else {
|
||||
repo_root <- normalizePath(getwd(), mustWork = TRUE)
|
||||
}
|
||||
if (!dir.exists(file.path(repo_root, "data-setup"))) repo_root <- normalizePath(getwd(), mustWork = TRUE)
|
||||
|
||||
raw_dir <- normalizePath(Sys.getenv("PARTY2D_RAW_DATA_DIR", file.path(repo_root, "_local", "raw")), mustWork = FALSE)
|
||||
report_dir <- normalizePath(Sys.getenv("PARTY2D_REPORT_DIR", file.path(repo_root, "_local", "reports")), mustWork = FALSE)
|
||||
dir.create(raw_dir, recursive = TRUE, showWarnings = FALSE)
|
||||
dir.create(report_dir, recursive = TRUE, showWarnings = FALSE)
|
||||
|
||||
ua <- "party2d-data-setup/1.0 (+https://git.seimel.app/armin/party2d)"
|
||||
|
||||
download_file <- function(url, dest, overwrite = FALSE, headers = character()) {
|
||||
dir.create(dirname(dest), recursive = TRUE, showWarnings = FALSE)
|
||||
if (file.exists(dest) && file.info(dest)$size > 0 && !overwrite) {
|
||||
message("OK existing: ", dest)
|
||||
return(TRUE)
|
||||
}
|
||||
tmp <- paste0(dest, ".tmp")
|
||||
if (file.exists(tmp)) unlink(tmp)
|
||||
message("Downloading ", url, " -> ", dest)
|
||||
ok <- tryCatch({
|
||||
utils::download.file(
|
||||
url,
|
||||
tmp,
|
||||
mode = "wb",
|
||||
quiet = TRUE,
|
||||
method = "libcurl",
|
||||
headers = c("User-Agent" = ua, headers)
|
||||
)
|
||||
file.rename(tmp, dest)
|
||||
}, error = function(e) {
|
||||
message("FAILED ", url, ": ", conditionMessage(e))
|
||||
FALSE
|
||||
})
|
||||
if (!ok && file.exists(tmp)) unlink(tmp)
|
||||
isTRUE(ok)
|
||||
}
|
||||
|
||||
download_dataverse <- function(doi, filename, dest, directory = NA_character_) {
|
||||
if (!requireNamespace("jsonlite", quietly = TRUE)) {
|
||||
message("FAILED Dataverse lookup: install R package jsonlite")
|
||||
return(FALSE)
|
||||
}
|
||||
api <- paste0("https://dataverse.harvard.edu/api/datasets/:persistentId/?persistentId=", utils::URLencode(doi, reserved = TRUE))
|
||||
fid <- tryCatch({
|
||||
meta <- jsonlite::fromJSON(api, simplifyVector = FALSE)
|
||||
files <- meta$data$latestVersion$files
|
||||
matches <- Filter(function(x) {
|
||||
same_file <- identical(x$dataFile$filename, filename)
|
||||
same_dir <- is.na(directory) || identical(x$directoryLabel, directory)
|
||||
same_file && same_dir
|
||||
}, files)
|
||||
if (length(matches) == 0) NA_integer_ else as.integer(matches[[1]]$dataFile$id)
|
||||
}, error = function(e) {
|
||||
message("FAILED Dataverse lookup ", doi, " ", filename, ": ", conditionMessage(e))
|
||||
NA_integer_
|
||||
})
|
||||
if (is.na(fid)) {
|
||||
message("FAILED Dataverse lookup ", doi, ": file not found: ", filename)
|
||||
return(FALSE)
|
||||
}
|
||||
download_file(paste0("https://dataverse.harvard.edu/api/access/datafile/", fid), dest)
|
||||
}
|
||||
|
||||
download_manifesto <- function(dest) {
|
||||
key <- Sys.getenv("MANIFESTO_API_KEY", Sys.getenv("PARTY2D_MANIFESTO_API_KEY", ""))
|
||||
if (!nzchar(key)) {
|
||||
message("SKIP Manifesto: set MANIFESTO_API_KEY or PARTY2D_MANIFESTO_API_KEY")
|
||||
return(FALSE)
|
||||
}
|
||||
url <- "https://manifesto-project.wzb.eu/api/v1/get_core?key=MPDS2025a&raw=true"
|
||||
download_file(
|
||||
url,
|
||||
dest,
|
||||
overwrite = TRUE,
|
||||
headers = c("Referer" = "https://manifesto-project.wzb.eu/datasets", "API_KEY" = key)
|
||||
)
|
||||
}
|
||||
|
||||
download_vparty <- function(dest) {
|
||||
email <- Sys.getenv("PARTY2D_VDEM_EMAIL", "")
|
||||
if (!nzchar(email)) {
|
||||
message("SKIP V-Party: set PARTY2D_VDEM_EMAIL to use V-Dem's required download form")
|
||||
return(FALSE)
|
||||
}
|
||||
curl <- Sys.which("curl")
|
||||
if (!nzchar(curl)) {
|
||||
message("FAILED V-Party: curl is required for the provider form")
|
||||
return(FALSE)
|
||||
}
|
||||
page <- "https://www.v-dem.net/data/v-party-dataset/country-party-date-v2/"
|
||||
tmpdir <- tempfile("vparty")
|
||||
dir.create(tmpdir)
|
||||
on.exit(unlink(tmpdir, recursive = TRUE), add = TRUE)
|
||||
cookie <- file.path(tmpdir, "cookies.txt")
|
||||
html <- file.path(tmpdir, "page.html")
|
||||
payload <- file.path(tmpdir, "payload.bin")
|
||||
zip_path <- file.path(tmpdir, "vparty.zip")
|
||||
status <- system2(curl, c("-L", "-A", ua, "-c", cookie, "-b", cookie, "-o", html, page), stdout = TRUE, stderr = TRUE)
|
||||
if (!file.exists(html)) {
|
||||
message("FAILED V-Party form load")
|
||||
return(FALSE)
|
||||
}
|
||||
page_text <- paste(readLines(html, warn = FALSE), collapse = "\n")
|
||||
csrf <- sub('.*name="csrfmiddlewaretoken"[^>]*value="([^"]*)".*', '\\1', page_text)
|
||||
if (identical(csrf, page_text)) csrf <- ""
|
||||
gender <- Sys.getenv("PARTY2D_VDEM_GENDER", "")
|
||||
form <- c(
|
||||
"csrfmiddlewaretoken", csrf,
|
||||
"email", email,
|
||||
"gender", gender,
|
||||
"accept_terms", "on",
|
||||
"dataset_file", "17",
|
||||
"website", ""
|
||||
)
|
||||
args <- c(
|
||||
"-L", "-A", ua, "-c", cookie, "-b", cookie,
|
||||
"-H", paste0("Referer: ", page),
|
||||
"-H", paste0("X-CSRFToken: ", csrf),
|
||||
"-H", "X-Requested-With: XMLHttpRequest",
|
||||
"-o", payload,
|
||||
"--data-urlencode", paste0(form[1], "=", form[2]),
|
||||
"--data-urlencode", paste0(form[3], "=", form[4]),
|
||||
"--data-urlencode", paste0(form[5], "=", form[6]),
|
||||
"--data-urlencode", paste0(form[7], "=", form[8]),
|
||||
"--data-urlencode", paste0(form[9], "=", form[10]),
|
||||
"--data-urlencode", paste0(form[11], "=", form[12]),
|
||||
paste0(page, "#dataset-download")
|
||||
)
|
||||
system2(curl, args, stdout = TRUE, stderr = TRUE)
|
||||
if (!file.exists(payload) || file.info(payload)$size == 0) {
|
||||
message("FAILED V-Party form submit")
|
||||
return(FALSE)
|
||||
}
|
||||
bytes <- readBin(payload, "raw", n = min(file.info(payload)$size, 4))
|
||||
if (length(bytes) >= 2 && identical(as.integer(bytes[1:2]), c(0x50L, 0x4bL))) {
|
||||
file.copy(payload, zip_path, overwrite = TRUE)
|
||||
} else {
|
||||
text <- paste(readLines(payload, warn = FALSE), collapse = "\n")
|
||||
m <- regexpr('https?://[^" ]*CPD_V-Party_R_v2\\.zip|/[^" ]*CPD_V-Party_R_v2\\.zip', text)
|
||||
if (m[1] < 0) {
|
||||
message("FAILED V-Party form response did not include a recognizable ZIP download")
|
||||
return(FALSE)
|
||||
}
|
||||
url <- regmatches(text, m)[1]
|
||||
if (startsWith(url, "/")) url <- paste0("https://www.v-dem.net", url)
|
||||
if (!download_file(url, zip_path, overwrite = TRUE, headers = c("Referer" = page))) return(FALSE)
|
||||
}
|
||||
listing <- utils::unzip(zip_path, list = TRUE)
|
||||
member <- listing$Name[grepl("\\.(rds|rda|rdata)$", listing$Name, ignore.case = TRUE)][1]
|
||||
if (is.na(member)) {
|
||||
message("FAILED V-Party ZIP contains no R data file")
|
||||
return(FALSE)
|
||||
}
|
||||
dir.create(dirname(dest), recursive = TRUE, showWarnings = FALSE)
|
||||
utils::unzip(zip_path, files = member, exdir = tmpdir, overwrite = TRUE)
|
||||
file.copy(file.path(tmpdir, member), dest, overwrite = TRUE)
|
||||
message("Extracted V-Party R data: ", dest)
|
||||
TRUE
|
||||
}
|
||||
|
||||
status <- c()
|
||||
status["PolDem"] <- download_file("https://poldem.eui.eu/downloads/cosa/poldem-election_all.csv", file.path(raw_dir, "poldem", "poldem-election_all.csv"))
|
||||
status["PartyFacts external parties"] <- download_file("https://partyfacts.herokuapp.com/download/external-parties-csv/", file.path(raw_dir, "partyfacts", "partyfacts-external-parties.csv"))
|
||||
status["Manifesto MPDS 2025a"] <- download_manifesto(file.path(raw_dir, "manifesto", "MPDataset_MPDS2025a.csv"))
|
||||
|
||||
ches_base <- "https://www.chesdata.eu/s/"
|
||||
ches_files <- c(
|
||||
"1999-2019_CHES_dataset_meansv3.csv" = "1999-2019_CHES_dataset_means(v3).csv",
|
||||
"1999-2024_CHES_dataset_meansV2-3k4l.csv" = "1999-2024_CHES_dataset_meansV2-3k4l.csv",
|
||||
"CHES_2024_final_v2.csv" = "CHES_2024_final_v2.csv",
|
||||
"CHES_2024_ALL_Stacked_Expert.csv" = "CHES_2024_expert_level.csv",
|
||||
"CHES_CA2023.csv" = "CHES_CA2023.csv",
|
||||
"CHES_CA2023_expert-level.csv" = "CHES_CA2023_expert_level.csv",
|
||||
"ches_la_2020_aggregate_level_v01.csv" = "ches_la_2020_aggregate_level_v01.csv",
|
||||
"ches_la_2020_expert_level_v01.csv" = "CHES_LA2020_expert_level.csv",
|
||||
"CHES_ISRAEL_means_2021_2022.csv" = "CHES_ISRAEL_means_2021_2022.csv",
|
||||
"CHES_ISRAEL_expert_level_2021_2022.csv" = "CHES_IL_expert_level.csv"
|
||||
)
|
||||
for (remote in names(ches_files)) {
|
||||
local <- ches_files[[remote]]
|
||||
status[paste("CHES", local)] <- download_file(paste0(ches_base, utils::URLencode(remote, reserved = TRUE)), file.path(raw_dir, "ches", local))
|
||||
}
|
||||
|
||||
status["POPPA integrated v2"] <- download_dataverse("doi:10.7910/DVN/RMQREQ", "poppa_integrated_v2.rds", file.path(raw_dir, "poppa", "poppa_integrated_v2.rds"), "final_data_v2")
|
||||
status["GPS 2019 party"] <- download_dataverse("doi:10.7910/DVN/WMGTNS", "Global Party Survey by Party SPSS V2_1_Apr_2020-2.tab", file.path(raw_dir, "gps", "Global Party Survey by Party SPSS V2_1_Apr_2020-2.tab"))
|
||||
status["V-Party"] <- download_vparty(file.path(raw_dir, "vparty", "V-Dem-CPD-Party-V2.rds"))
|
||||
|
||||
report <- file.path(report_dir, "download_sources_report.md")
|
||||
lines <- c("# Download sources report", "", "| source | status |", "| --- | --- |")
|
||||
for (name in names(status)) lines <- c(lines, paste0("| ", name, " | ", if (isTRUE(status[[name]])) "ok" else "missing/failed", " |"))
|
||||
writeLines(lines, report)
|
||||
message("Wrote download report: ", report)
|
||||
|
||||
quit(status = if (all(status)) 0 else 2)
|
||||
@@ -0,0 +1,348 @@
|
||||
# ============================================================
|
||||
# 02_build_model_inputs.R - Master Data Pipeline Orchestrator
|
||||
# ============================================================
|
||||
# Coordinates all data processing sub-scripts and produces
|
||||
# final output files for the two-dimensional party-position model. By default this writes only
|
||||
# to local-only directories under _local/ and never overwrites committed data/.
|
||||
#
|
||||
# Sub-scripts (run conditionally based on intermediate file existence):
|
||||
# process_manifesto.R -> manifesto_data.csv
|
||||
# process_poldem.R -> poldem_data.csv
|
||||
# process_expert.R -> expert_raw.csv, lr_data_raw.csv
|
||||
# process_morgan.R -> morgan_data.csv, morgan_lr.csv
|
||||
#
|
||||
# Final generated model inputs:
|
||||
# text_data.csv - Combined manifesto + PolDem
|
||||
# expert.csv - Expert survey data (CHES, V-Party, POPPA, GPS)
|
||||
# lr_data.csv - General left-right anchoring data
|
||||
# ============================================================
|
||||
|
||||
library(tidyverse)
|
||||
library(countrycode)
|
||||
|
||||
cmd_args <- commandArgs(trailingOnly = FALSE)
|
||||
file_arg <- grep("^--file=", cmd_args, value = TRUE)
|
||||
if (length(file_arg) > 0) {
|
||||
this_file <- normalizePath(sub("^--file=", "", file_arg[[1]]), mustWork = TRUE)
|
||||
repo_root <- normalizePath(file.path(dirname(this_file), "..", ".."), mustWork = TRUE)
|
||||
} else {
|
||||
repo_root <- normalizePath(getwd(), mustWork = TRUE)
|
||||
}
|
||||
script_dir <- file.path(repo_root, "data-setup", "R")
|
||||
build_dir <- normalizePath(
|
||||
Sys.getenv("PARTY2D_BUILD_DIR", file.path(repo_root, "_local", "build")),
|
||||
mustWork = FALSE
|
||||
)
|
||||
generated_input_dir <- normalizePath(
|
||||
Sys.getenv("PARTY2D_GENERATED_INPUT_DIR", file.path(repo_root, "_local", "generated-inputs")),
|
||||
mustWork = FALSE
|
||||
)
|
||||
dir.create(build_dir, recursive = TRUE, showWarnings = FALSE)
|
||||
dir.create(generated_input_dir, recursive = TRUE, showWarnings = FALSE)
|
||||
|
||||
# The source-processing scripts use relative paths for intermediate files.
|
||||
# Keep those intermediates in the ignored build directory, never committed data/.
|
||||
setwd(build_dir)
|
||||
|
||||
# Static model support inputs are versioned in data/ and copied into the local
|
||||
# generated-input set for comparison. They are not regenerated by raw-source setup.
|
||||
for (support_file in c("union_mapping.csv", "party_families.csv")) {
|
||||
src <- file.path(repo_root, "data", support_file)
|
||||
if (!file.exists(src)) {
|
||||
stop("Required committed support input not found: ", src)
|
||||
}
|
||||
file.copy(src, file.path(build_dir, support_file), overwrite = TRUE)
|
||||
}
|
||||
|
||||
cat("============================================================\n")
|
||||
cat("Data Management Pipeline\n")
|
||||
cat("============================================================\n\n")
|
||||
cat("Build directory: ", build_dir, "\n", sep = "")
|
||||
cat("Generated input directory: ", generated_input_dir, "\n\n", sep = "")
|
||||
|
||||
# ============================================================
|
||||
# Configuration: Set to TRUE to force re-run of sub-scripts
|
||||
# ============================================================
|
||||
|
||||
FORCE_RERUN_MANIFESTO <- FALSE
|
||||
FORCE_RERUN_POLDEM <- FALSE
|
||||
FORCE_RERUN_EXPERT <- FALSE
|
||||
FORCE_RERUN_MORGAN <- FALSE
|
||||
|
||||
# ============================================================
|
||||
# Step 1: Manifesto Data
|
||||
# ============================================================
|
||||
|
||||
cat("Step 1: Manifesto data\n")
|
||||
if (!file.exists("manifesto_data.csv") || !file.exists("election_data.csv") || FORCE_RERUN_MANIFESTO) {
|
||||
cat(" Running process_manifesto.R...\n")
|
||||
source(file.path(script_dir, "process_manifesto.R"))
|
||||
} else {
|
||||
cat(" Loading cached manifesto_data.csv and election_data.csv...\n")
|
||||
}
|
||||
manifesto <- read_csv("manifesto_data.csv", show_col_types = FALSE)
|
||||
election_data <- read_csv("election_data.csv", show_col_types = FALSE)
|
||||
cat(sprintf(" Loaded manifesto: %d rows, %d parties\n", nrow(manifesto), n_distinct(manifesto$party)))
|
||||
cat(sprintf(" Loaded election: %d rows, %d parties\n\n", nrow(election_data), n_distinct(election_data$party)))
|
||||
|
||||
# ============================================================
|
||||
# Step 2: PolDem Media Data
|
||||
# ============================================================
|
||||
|
||||
cat("Step 2: PolDem media data\n")
|
||||
if (!file.exists("poldem_data.csv") || FORCE_RERUN_POLDEM) {
|
||||
cat(" Running process_poldem.R...\n")
|
||||
source(file.path(script_dir, "process_poldem.R"))
|
||||
} else {
|
||||
cat(" Loading cached poldem_data.csv...\n")
|
||||
}
|
||||
poldem_data <- read_csv("poldem_data.csv", show_col_types = FALSE)
|
||||
cat(sprintf(" Loaded: %d rows, %d parties\n\n", nrow(poldem_data), n_distinct(poldem_data$party)))
|
||||
|
||||
# ============================================================
|
||||
# Step 4: Expert Survey Data
|
||||
# ============================================================
|
||||
|
||||
cat("Step 3: Expert survey data\n")
|
||||
if (!file.exists("expert_raw.csv") || !file.exists("lr_data_raw.csv") || FORCE_RERUN_EXPERT) {
|
||||
cat(" Running process_expert.R...\n")
|
||||
source(file.path(script_dir, "process_expert.R"))
|
||||
} else {
|
||||
cat(" Loading cached expert_raw.csv and lr_data_raw.csv...\n")
|
||||
}
|
||||
expert_raw <- read_csv("expert_raw.csv", show_col_types = FALSE)
|
||||
lr_data_raw <- read_csv("lr_data_raw.csv", show_col_types = FALSE)
|
||||
cat(sprintf(" Expert: %d rows, LR: %d rows\n\n", nrow(expert_raw), nrow(lr_data_raw)))
|
||||
|
||||
# ============================================================
|
||||
# Step 3b: Morgan (1976) Historical Expert Data
|
||||
# ============================================================
|
||||
|
||||
cat("Step 3b: Morgan (1976) historical L-R data\n")
|
||||
|
||||
# First run to generate morgan_data.csv if needed
|
||||
if (!file.exists("morgan_data.csv") || FORCE_RERUN_MORGAN) {
|
||||
cat(" Running process_morgan.R (initial processing)...\n")
|
||||
source(file.path(script_dir, "process_morgan.R"))
|
||||
}
|
||||
|
||||
# morgan_lr.csv depends on text_data.csv, so we need to check if it needs regeneration
|
||||
# It will be generated/regenerated below after text_data is created
|
||||
|
||||
# ============================================================
|
||||
# Step 4: Combine Text Data Sources
|
||||
# ============================================================
|
||||
|
||||
cat("Step 4: Combining text data sources\n")
|
||||
text_data <- bind_rows(manifesto, poldem_data)
|
||||
cat(sprintf(" Combined text_data: %d rows\n", nrow(text_data)))
|
||||
|
||||
# Save unfiltered text_data for reproducible mismatch diagnosis
|
||||
write_csv(text_data, "text_data_unfiltered.csv")
|
||||
cat(sprintf(" Saved unfiltered text_data: %d rows, %d parties\n", nrow(text_data), n_distinct(text_data$party)))
|
||||
|
||||
# ============================================================
|
||||
# Step 4b: Party Renames (applied before filtering)
|
||||
# ============================================================
|
||||
# Renames must happen BEFORE the relevance filter so that party IDs
|
||||
# match across text_data and expert_raw when computing expert coverage.
|
||||
|
||||
# Simple renames only (organizational continuity: same leadership/members)
|
||||
simple_renames <- c(
|
||||
`10` = 1816L, # DE: Greens -> Bündnis90/Grüne
|
||||
`276` = 120L, # RO: FDSN/PDSR -> PSD (renamed 2001)
|
||||
`8054` = 878L, # IT: PDS -> DS (renamed 1998)
|
||||
`1696` = 813L, # IT: MSI -> AN (refounded 1995)
|
||||
`553` = 1968L, # BE: Vlaams Blok -> Vlaams Belang (refounded 2004)
|
||||
`8058` = 1626L # IT: Forza Italia (refounded 2013) -> Forza Italia (same party, Berlusconi)
|
||||
)
|
||||
|
||||
apply_simple_renames <- function(df) {
|
||||
for (old_id in names(simple_renames)) {
|
||||
df <- df %>%
|
||||
mutate(party = ifelse(party == as.integer(old_id), simple_renames[[old_id]], party))
|
||||
}
|
||||
df
|
||||
}
|
||||
|
||||
cat("\nStep 4b: Party renames\n")
|
||||
text_data <- apply_simple_renames(text_data)
|
||||
cat(sprintf(" Applied %d renames to text_data\n", length(simple_renames)))
|
||||
|
||||
# ============================================================
|
||||
# Step 4c: Relevance Filter
|
||||
# ============================================================
|
||||
# Design: R pipeline filters for RELEVANCE (is this party worth modeling?).
|
||||
# Julia pipeline handles INTERPOLATION QUALITY (MAX_GAP=7 segment splitting, MIN_OBS=2).
|
||||
# Expert survey coverage is a relevance signal: CHES only covers parties with >1% vote share.
|
||||
|
||||
cat("\nStep 4c: Relevance filter\n")
|
||||
parties_before <- n_distinct(text_data$party)
|
||||
|
||||
# Compute expert coverage per party (with renames applied for consistent matching)
|
||||
expert_year_counts <- bind_rows(
|
||||
expert_raw %>% select(party, year),
|
||||
lr_data_raw %>% select(party, year)
|
||||
) %>% distinct() %>%
|
||||
apply_simple_renames() %>%
|
||||
distinct() %>%
|
||||
count(party, name = "expert_years")
|
||||
|
||||
expert_party_ids <- unique(expert_year_counts$party)
|
||||
cat(sprintf(" Parties with expert data: %d\n", length(expert_party_ids)))
|
||||
|
||||
# Three-tier relevance filter:
|
||||
# Tier 1: 3+ text data years (always include, regardless of expert data)
|
||||
# Tier 2: 2 text years + any expert data (major newer parties like M5S, ANO, LREM)
|
||||
# Tier 3: 1 text year + 3+ expert survey years (parties with rich expert coverage)
|
||||
text_data <- text_data %>%
|
||||
group_by(country, party) %>%
|
||||
mutate(n_years = n_distinct(year)) %>%
|
||||
ungroup() %>%
|
||||
left_join(expert_year_counts, by = "party") %>%
|
||||
mutate(expert_years = replace_na(expert_years, 0L)) %>%
|
||||
mutate(
|
||||
tier = case_when(
|
||||
n_years >= 3 ~ 1L,
|
||||
n_years >= 2 & party %in% expert_party_ids ~ 2L,
|
||||
n_years >= 1 & expert_years >= 3 ~ 3L,
|
||||
TRUE ~ 0L
|
||||
)
|
||||
) %>%
|
||||
filter(tier > 0) %>%
|
||||
select(-n_years, -expert_years, -tier)
|
||||
|
||||
parties_after <- n_distinct(text_data$party)
|
||||
cat(sprintf(" Parties before filter: %d\n", parties_before))
|
||||
cat(sprintf(" Parties after filter: %d\n", parties_after))
|
||||
cat(sprintf(" Parties removed: %d\n\n", parties_before - parties_after))
|
||||
|
||||
# ============================================================
|
||||
# Step 5: Party Harmonization
|
||||
# ============================================================
|
||||
|
||||
cat("Step 5: Party harmonization (union-aware)\n")
|
||||
|
||||
# Load union mapping to identify constituent parties
|
||||
union_map <- read_csv("union_mapping.csv", show_col_types = FALSE)
|
||||
|
||||
# Build set of constituent parties whose union is in text_data
|
||||
constituent_parties <- union_map %>%
|
||||
filter(manifesto_pf_id %in% unique(text_data$party)) %>%
|
||||
pull(expert_pf_id)
|
||||
|
||||
cat(sprintf(" Union mappings loaded: %d rows covering %d unions\n",
|
||||
nrow(union_map), n_distinct(union_map$manifesto_pf_id)))
|
||||
cat(sprintf(" Constituent parties with unions in text_data: %d\n",
|
||||
length(unique(constituent_parties))))
|
||||
|
||||
# Deduplicate union manifesto rows: where multiple CMP codes map to the same
|
||||
# union PF ID with identical content, keep only one set per (party, year, var)
|
||||
text_data_before_dedup <- nrow(text_data)
|
||||
text_data <- text_data %>%
|
||||
distinct(country, party, year, var, .keep_all = TRUE)
|
||||
cat(sprintf(" Text data: %d unique parties after harmonization\n", n_distinct(text_data$party)))
|
||||
cat(sprintf(" Text data: deduplicated %d -> %d rows\n", text_data_before_dedup, nrow(text_data)))
|
||||
|
||||
# Filter expert data: keep parties in text_data OR constituent parties of unions in text_data
|
||||
expert <- expert_raw %>%
|
||||
apply_simple_renames() %>%
|
||||
group_by(country, party, var, year) %>%
|
||||
summarise(
|
||||
val = mean(val, na.rm = TRUE),
|
||||
val_int = first(val_int),
|
||||
n_scale = first(n_scale),
|
||||
n_experts = first(n_experts),
|
||||
project = first(project),
|
||||
type_low = first(type_low),
|
||||
type_high = first(type_high),
|
||||
.groups = "drop"
|
||||
) %>%
|
||||
filter(party %in% unique(text_data$party) | party %in% constituent_parties)
|
||||
|
||||
lr_data <- lr_data_raw %>%
|
||||
apply_simple_renames() %>%
|
||||
group_by(country, party, var, year) %>%
|
||||
summarise(
|
||||
val = mean(val, na.rm = TRUE),
|
||||
val_int = first(val_int),
|
||||
n_scale = first(n_scale),
|
||||
n_experts = first(n_experts),
|
||||
project = first(project),
|
||||
.groups = "drop"
|
||||
) %>%
|
||||
filter(party %in% unique(text_data$party) | party %in% constituent_parties)
|
||||
|
||||
cat(sprintf(" Expert data: %d rows (filtered to text_data parties)\n", nrow(expert)))
|
||||
cat(sprintf(" LR data (CHES/POPPA): %d rows (filtered to text_data parties)\n", nrow(lr_data)))
|
||||
|
||||
# ============================================================
|
||||
# Step 5b: Integrate Morgan L-R Data
|
||||
# ============================================================
|
||||
|
||||
cat("\nStep 5b: Morgan L-R data integration\n")
|
||||
|
||||
# Generate morgan_lr.csv (requires text_data.csv to exist)
|
||||
# We need to regenerate it if text_data changed or if forced
|
||||
if (!file.exists("morgan_lr.csv") || FORCE_RERUN_MORGAN) {
|
||||
cat(" Generating morgan_lr.csv...\n")
|
||||
# Write text_data first so morgan script can use it
|
||||
write_csv(text_data, "text_data.csv")
|
||||
source(file.path(script_dir, "process_morgan.R"))
|
||||
}
|
||||
|
||||
# Load and integrate Morgan L-R data
|
||||
if (file.exists("morgan_lr.csv")) {
|
||||
morgan_lr <- read_csv("morgan_lr.csv", show_col_types = FALSE) %>%
|
||||
apply_simple_renames() %>%
|
||||
filter(party %in% unique(text_data$party) | party %in% constituent_parties)
|
||||
|
||||
cat(sprintf(" Morgan L-R: %d rows (filtered to text_data parties)\n", nrow(morgan_lr)))
|
||||
cat(sprintf(" Morgan parties: %d\n", n_distinct(morgan_lr$party)))
|
||||
cat(sprintf(" Morgan year range: %d-%d\n", min(morgan_lr$year), max(morgan_lr$year)))
|
||||
|
||||
# Combine with existing lr_data
|
||||
lr_data_before <- nrow(lr_data)
|
||||
lr_data <- bind_rows(lr_data, morgan_lr) %>%
|
||||
arrange(country, party, year, var)
|
||||
|
||||
cat(sprintf(" Combined LR data: %d rows (+%d from Morgan)\n",
|
||||
nrow(lr_data), nrow(lr_data) - lr_data_before))
|
||||
} else {
|
||||
cat(" Warning: morgan_lr.csv not found, skipping Morgan integration\n")
|
||||
}
|
||||
|
||||
cat("\n")
|
||||
|
||||
# ============================================================
|
||||
# Step 6: Write Final Outputs
|
||||
# ============================================================
|
||||
|
||||
cat("Step 6: Writing final outputs\n")
|
||||
|
||||
write_csv(text_data, "text_data.csv")
|
||||
write_csv(expert, "expert.csv")
|
||||
write_csv(lr_data, "lr_data.csv")
|
||||
|
||||
for (final_file in c("text_data.csv", "expert.csv", "lr_data.csv", "union_mapping.csv", "party_families.csv")) {
|
||||
file.copy(file.path(build_dir, final_file), file.path(generated_input_dir, final_file), overwrite = TRUE)
|
||||
}
|
||||
|
||||
cat("\n============================================================\n")
|
||||
cat("Pipeline Complete!\n")
|
||||
cat("============================================================\n\n")
|
||||
|
||||
cat("Output files written:\n")
|
||||
cat(sprintf(" local generated input dir: %s\n", generated_input_dir))
|
||||
cat(sprintf(" text_data.csv: %d rows\n", nrow(text_data)))
|
||||
cat(sprintf(" - Manifesto: %d rows\n", sum(grepl("_manifesto", text_data$var))))
|
||||
cat(sprintf(" - PolDem: %d rows\n", sum(grepl("_poldem", text_data$var))))
|
||||
cat(sprintf(" expert.csv: %d rows\n", nrow(expert)))
|
||||
cat(sprintf(" lr_data.csv: %d rows\n", nrow(lr_data)))
|
||||
cat(sprintf(" - CHES: %d rows\n", sum(lr_data$var == "lr_ches")))
|
||||
cat(sprintf(" - POPPA: %d rows\n", sum(lr_data$var == "lr_poppa")))
|
||||
cat(sprintf(" - Morgan: %d rows\n", sum(lr_data$var == "lr_morgan")))
|
||||
|
||||
cat("\nUnique parties in text_data:", n_distinct(text_data$party), "\n")
|
||||
cat("Countries:", paste(sort(unique(text_data$country)), collapse = ", "), "\n")
|
||||
cat("Year range:", min(text_data$year, na.rm = TRUE), "-", max(text_data$year, na.rm = TRUE), "\n")
|
||||
@@ -0,0 +1,53 @@
|
||||
#!/usr/bin/env Rscript
|
||||
|
||||
args <- commandArgs(trailingOnly = FALSE)
|
||||
file_arg <- args[grepl("^--file=", args)][1]
|
||||
if (!is.na(file_arg)) {
|
||||
script_path <- sub("^--file=", "", file_arg)
|
||||
repo_root <- normalizePath(file.path(dirname(script_path), "..", ".."), mustWork = FALSE)
|
||||
} else {
|
||||
repo_root <- normalizePath(getwd(), mustWork = TRUE)
|
||||
}
|
||||
if (!dir.exists(file.path(repo_root, "data"))) repo_root <- normalizePath(getwd(), mustWork = TRUE)
|
||||
|
||||
generated_dir <- Sys.getenv("PARTY2D_GENERATED_INPUT_DIR", file.path(repo_root, "_local", "generated-inputs"))
|
||||
report_dir <- Sys.getenv("PARTY2D_REPORT_DIR", file.path(repo_root, "_local", "reports"))
|
||||
dir.create(report_dir, recursive = TRUE, showWarnings = FALSE)
|
||||
|
||||
files <- c("text_data.csv", "expert.csv", "lr_data.csv", "union_mapping.csv", "party_families.csv")
|
||||
|
||||
file_info <- lapply(files, function(file) {
|
||||
committed <- file.path(repo_root, "data", file)
|
||||
generated <- file.path(generated_dir, file)
|
||||
committed_exists <- file.exists(committed)
|
||||
generated_exists <- file.exists(generated)
|
||||
committed_size <- if (committed_exists) file.info(committed)$size else NA_real_
|
||||
generated_size <- if (generated_exists) file.info(generated)$size else NA_real_
|
||||
identical_bytes <- committed_exists && generated_exists && isTRUE(tools::md5sum(committed) == tools::md5sum(generated))
|
||||
data.frame(
|
||||
file = file,
|
||||
committed_exists = committed_exists,
|
||||
generated_exists = generated_exists,
|
||||
committed_size = committed_size,
|
||||
generated_size = generated_size,
|
||||
identical_bytes = identical_bytes,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
summary <- do.call(rbind, file_info)
|
||||
report <- file.path(report_dir, "input_comparison.md")
|
||||
lines <- c(
|
||||
"# Model input comparison",
|
||||
"",
|
||||
paste0("Generated: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S %Z")),
|
||||
"",
|
||||
"| File | Committed exists | Generated exists | Committed bytes | Generated bytes | Identical bytes |",
|
||||
"| --- | --- | --- | ---: | ---: | --- |",
|
||||
apply(summary, 1, function(row) {
|
||||
paste0("| ", row[["file"]], " | ", row[["committed_exists"]], " | ", row[["generated_exists"]], " | ", row[["committed_size"]], " | ", row[["generated_size"]], " | ", row[["identical_bytes"]], " |")
|
||||
})
|
||||
)
|
||||
writeLines(lines, report)
|
||||
print(summary, row.names = FALSE)
|
||||
message("Comparison report written to ", report)
|
||||
@@ -0,0 +1,620 @@
|
||||
# ============================================================
|
||||
# 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)))
|
||||
@@ -0,0 +1,179 @@
|
||||
# ============================================================
|
||||
# process_manifesto.R - Manifesto Project Data Processing
|
||||
# ============================================================
|
||||
# Processes Manifesto Project data for the two-dimensional party-position model
|
||||
# Input: $PARTY2D_RAW_DATA_DIR/manifesto/MPDataset_MPDS2025a.csv
|
||||
# Output: manifesto_data.csv
|
||||
# ============================================================
|
||||
|
||||
library(tidyverse)
|
||||
library(countrycode)
|
||||
library(purrr)
|
||||
|
||||
# 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 Manifesto Project data...\n")
|
||||
|
||||
raw_data_dir <- Sys.getenv(
|
||||
"PARTY2D_RAW_DATA_DIR",
|
||||
unset = file.path("..", "..", "_local", "raw")
|
||||
)
|
||||
manifesto_raw_path <- file.path(raw_data_dir, "manifesto", "MPDataset_MPDS2025a.csv")
|
||||
partyfacts_path <- file.path(raw_data_dir, "partyfacts", "partyfacts-external-parties.csv")
|
||||
|
||||
# ============================================================
|
||||
# PartyFacts Linkage
|
||||
# ============================================================
|
||||
|
||||
partyfacts_raw <- read_csv(partyfacts_path, show_col_types = FALSE)
|
||||
manifesto_link <- partyfacts_raw %>%
|
||||
filter(dataset_key == "manifesto") %>%
|
||||
transmute(id = dataset_party_id,
|
||||
country = countrycode(country, origin = 'iso3c', destination = "iso2c"),
|
||||
party = partyfacts_id,
|
||||
party = ifelse(party == 622, 604, party))
|
||||
|
||||
# ============================================================
|
||||
# Load Manifesto Data
|
||||
# ============================================================
|
||||
|
||||
manifesto_data <- read_csv(manifesto_raw_path, show_col_types = FALSE)
|
||||
|
||||
# ============================================================
|
||||
# CMP Code Mapping to 4 Dimensions
|
||||
# ============================================================
|
||||
|
||||
vars <- tribble(
|
||||
~type, ~subtype, ~per_var, ~stance, ~label,
|
||||
# pro_market
|
||||
"pro_market", "Market Regulation", "per401", "Positive", "Free Market Economy",
|
||||
"pro_market", "Economic Liberalization","per402", "Positive", "Incentives: Positive",
|
||||
"pro_market", "Market Regulation", "per407", "Positive", "Protectionism: Negative",
|
||||
"pro_market", "Economic Liberalization","per414", "Positive", "Economic Orthodoxy",
|
||||
"pro_market", "Economic Liberalization","per505", "Positive", "Welfare State Limitation",
|
||||
"pro_market", "Economic Liberalization","per507", "Positive", "Education Limitation",
|
||||
"pro_market", "Economic Liberalization","per702", "Positive", "Labour Groups: Negative",
|
||||
"pro_market", "Market Regulation", "per406", "Negative", "Protectionism: Positive",
|
||||
"pro_market", "Market Regulation", "per412", "Negative", "Controlled Economy",
|
||||
"pro_market", "Economic Liberalization","per504", "Negative", "Welfare State Expansion",
|
||||
# pro_welfare
|
||||
"pro_welfare", "Economic Intervention", "per403", "Positive", "Market Regulation",
|
||||
"pro_welfare", "Economic Intervention", "per404", "Positive", "Economic Planning",
|
||||
"pro_welfare", "Economic Intervention", "per412", "Positive", "Controlled Economy",
|
||||
"pro_welfare", "Economic Intervention", "per413", "Positive", "Nationalisation",
|
||||
"pro_welfare", "Social Services", "per504", "Positive", "Welfare State Expansion",
|
||||
"pro_welfare", "Social Services", "per506", "Positive", "Education Expansion",
|
||||
"pro_welfare", "Economic Intervention", "per701", "Positive", "Labour Groups: Positive",
|
||||
"pro_welfare", "Economic Intervention", "per401", "Negative", "Free Market Economy",
|
||||
"pro_welfare", "Social Services", "per505", "Negative", "Welfare State Limitation",
|
||||
# cosmopolitan
|
||||
"cosmopolitan", "Internationalism", "per107", "Positive", "Internationalism: Positive",
|
||||
"cosmopolitan", "Internationalism", "per108", "Positive", "European Community/Union: Positive",
|
||||
"cosmopolitan", "Multiculturalism", "per607", "Positive", "Multiculturalism: Positive",
|
||||
"cosmopolitan", "Multiculturalism", "per201", "Positive", "Freedom and Human Rights",
|
||||
"cosmopolitan", "Multiculturalism", "per604", "Positive", "traditional Morality: Negative",
|
||||
"cosmopolitan", "Internationalism", "per109", "Negative", "Internationalism: Negative",
|
||||
"cosmopolitan", "Multiculturalism", "per601", "Negative", "National Way of Life: Positive",
|
||||
# traditional
|
||||
"traditional", "National Identity", "per109", "Positive", "Internationalism: Negative",
|
||||
"traditional", "Conservative Morality", "per110", "Positive", "European Community/Union: Negative",
|
||||
"traditional", "National Identity", "per601", "Positive", "National Way of Life: Positive",
|
||||
"traditional", "Conservative Morality", "per603", "Positive", "traditional Morality: Positive",
|
||||
"traditional", "Conservative Morality", "per608", "Positive", "Multiculturalism: Negative",
|
||||
"traditional", "Conservative Morality", "per605", "Positive", "Law and Order: Positive",
|
||||
"traditional", "National Identity", "per107", "Negative", "Internationalism: Positive",
|
||||
"traditional", "Conservative Morality", "per607", "Negative", "Multiculturalism: Positive"
|
||||
)
|
||||
|
||||
# ============================================================
|
||||
# Process Manifesto Data
|
||||
# ============================================================
|
||||
|
||||
manifesto <- vars %>%
|
||||
pmap_dfr(~ manifesto_data %>%
|
||||
transmute(country = countrycode(countryname, origin = 'country.name', destination = 'iso2c'),
|
||||
year = as.numeric(format(as.Date(edate, format = "%d/%m/%Y"), "%Y")),
|
||||
id = as.character(party),
|
||||
count = round(.data[[..3]]),
|
||||
var = ..3,
|
||||
label = ..5,
|
||||
type = ..1,
|
||||
subtype = ..2,
|
||||
stance = ..4,
|
||||
project = 'Manifesto Project') %>%
|
||||
left_join(manifesto_link, by = c("id", "country")) %>%
|
||||
select(-id)) %>%
|
||||
group_by(party, country, year, subtype) %>%
|
||||
summarise(
|
||||
positive = sum(count[stance == "Positive"], na.rm = TRUE),
|
||||
sample = sum(count, na.rm = TRUE),
|
||||
type = first(type),
|
||||
project = first(project),
|
||||
.groups = "drop"
|
||||
) %>%
|
||||
na.omit() %>%
|
||||
rename(var = subtype) %>%
|
||||
# Convert to bipolar bridge structure (type_high/type_low)
|
||||
mutate(
|
||||
type_high = case_when(
|
||||
type == "pro_welfare" ~ "pro_welfare",
|
||||
type == "pro_market" ~ "pro_market",
|
||||
type == "cosmopolitan" ~ "cosmopolitan",
|
||||
type == "traditional" ~ "traditional"
|
||||
),
|
||||
type_low = case_when(
|
||||
type %in% c("pro_welfare", "pro_market") ~ ifelse(type == "pro_welfare", "pro_market", "pro_welfare"),
|
||||
type %in% c("cosmopolitan", "traditional") ~ ifelse(type == "cosmopolitan", "traditional", "cosmopolitan")
|
||||
)
|
||||
) %>%
|
||||
select(-type) %>%
|
||||
# Add _manifesto suffix to variable names
|
||||
mutate(var = paste0(tolower(gsub(" ", "_", var)), "_manifesto"))
|
||||
|
||||
# ============================================================
|
||||
# NOTE: Temporal continuity filter moved to the data setup orchestrator.
|
||||
# This allows exempting parties that appear in parliamentary data
|
||||
# (parties in parliament are by definition not fringe parties)
|
||||
# ============================================================
|
||||
|
||||
cat("Skipping temporal filter (applied in 02_build_model_inputs.R after combining with other text data)\n")
|
||||
cat(sprintf(" Parties: %d\n", n_distinct(manifesto$party)))
|
||||
|
||||
# ============================================================
|
||||
# Write Output
|
||||
# ============================================================
|
||||
|
||||
write_csv(manifesto, "manifesto_data.csv")
|
||||
cat(sprintf("Output: manifesto_data.csv (%d rows, %d parties)\n",
|
||||
nrow(manifesto), n_distinct(manifesto$party)))
|
||||
|
||||
# ============================================================
|
||||
# Election Data Extraction (vote shares)
|
||||
# ============================================================
|
||||
|
||||
cat("\nExtracting election data (pervote)...\n")
|
||||
|
||||
election_data <- manifesto_data %>%
|
||||
transmute(
|
||||
country = countrycode(countryname, origin = 'country.name', destination = 'iso2c'),
|
||||
year = as.numeric(format(as.Date(edate, format = "%d/%m/%Y"), "%Y")),
|
||||
id = as.character(party),
|
||||
pervote = pervote
|
||||
) %>%
|
||||
left_join(manifesto_link, by = c("id", "country")) %>%
|
||||
select(-id) %>%
|
||||
filter(!is.na(party), !is.na(pervote)) %>%
|
||||
# Keep one row per (party, country, year) — take max pervote if duplicates
|
||||
group_by(party, country, year) %>%
|
||||
summarise(pervote = max(pervote, na.rm = TRUE), .groups = "drop") %>%
|
||||
arrange(country, party, year)
|
||||
|
||||
write_csv(election_data, "election_data.csv")
|
||||
cat(sprintf("Output: election_data.csv (%d rows, %d parties)\n",
|
||||
nrow(election_data), n_distinct(election_data$party)))
|
||||
|
||||
# Export manifesto_link for use by other scripts
|
||||
# (poldem also needs it for CMP linkage)
|
||||
@@ -0,0 +1,399 @@
|
||||
# process_morgan.R
|
||||
# Process Morgan (1976) expert party position data
|
||||
#
|
||||
# Source: Morgan, Michael-John (1976). "The Modelling of Governmental
|
||||
# Coalition Formation: A Policy-Based Approach with Interval Measurement."
|
||||
# PhD dissertation, University of Michigan.
|
||||
#
|
||||
# Data extracted from Appendix B.3 (Tables B.3.1-B.3.12) via OCR.
|
||||
# Position scores are 25%-truncated means (midmeans) from expert surveys.
|
||||
# Scale: 0-100 (left-right)
|
||||
|
||||
library(tidyverse)
|
||||
|
||||
cat("Processing Morgan (1976) expert party position data...\n")
|
||||
|
||||
raw_data_dir <- Sys.getenv(
|
||||
"PARTY2D_RAW_DATA_DIR",
|
||||
unset = file.path("..", "..", "_local", "raw")
|
||||
)
|
||||
morgan_raw_path <- file.path(raw_data_dir, "morgan", "morgan_positions_raw.csv")
|
||||
partyfacts_path <- file.path(raw_data_dir, "partyfacts", "partyfacts-external-parties.csv")
|
||||
|
||||
# Load raw extracted data
|
||||
morgan_raw <- read_csv(morgan_raw_path, show_col_types = FALSE)
|
||||
|
||||
cat(sprintf("Loaded %d party-period observations from %d countries\n",
|
||||
nrow(morgan_raw), n_distinct(morgan_raw$country)))
|
||||
|
||||
# Load PartyFacts linkage data
|
||||
partyfacts <- read_csv(partyfacts_path, show_col_types = FALSE)
|
||||
|
||||
# Filter to Morgan dataset entries
|
||||
morgan_pf <- partyfacts %>%
|
||||
filter(dataset_key == "morgan") %>%
|
||||
select(country, name_short, name_english, year_first, year_last,
|
||||
external_id, partyfacts_id) %>%
|
||||
rename(party_abbrev_pf = name_short)
|
||||
|
||||
cat(sprintf("Found %d Morgan parties in PartyFacts\n", nrow(morgan_pf)))
|
||||
|
||||
# Map extracted abbreviations to PartyFacts abbreviations
|
||||
# Some adjustments needed due to OCR/transcription differences
|
||||
abbrev_map <- tribble(
|
||||
~country, ~party_abbrev, ~party_abbrev_pf,
|
||||
# Denmark
|
||||
"DNK", "SOCd", "SOCD",
|
||||
"DNK", "SOCL", "SOCL",
|
||||
"DNK", "COMM", "COMM",
|
||||
"DNK", "RAD", "RAD",
|
||||
"DNK", "LIB", "LIB",
|
||||
"DNK", "CONS", "CONS",
|
||||
"DNK", "LS", "LS",
|
||||
"DNK", "LC", "LC",
|
||||
"DNK", "JUST", "JUST",
|
||||
# Finland
|
||||
"FIN", "SKDL", "SKDL",
|
||||
"FIN", "SOCd", "SOCD",
|
||||
"FIN", "PROG", "PROG",
|
||||
"FIN", "AGR", "AGR",
|
||||
"FIN", "SWPP", "SWPP",
|
||||
"FIN", "CONS", "CONS",
|
||||
"FIN", "NPF", "NPF",
|
||||
"FIN", "PDEM", "PDEM",
|
||||
"FIN", "SDWS", "SDWS",
|
||||
"FIN", "CENT", "CENT",
|
||||
"FIN", "FRP", "FRP",
|
||||
"FIN", "LIB", "LIB",
|
||||
# Iceland
|
||||
"ISL", "COMM", "COMM",
|
||||
"ISL", "SOCd", "SOCD",
|
||||
"ISL", "PROG", "PROG",
|
||||
"ISL", "LIB", "LIB",
|
||||
"ISL", "INDP", "INDP",
|
||||
"ISL", "CONS", "CONS",
|
||||
"ISL", "LLIB", "LLIB",
|
||||
# Norway
|
||||
"NOR", "LAB", "LAB",
|
||||
"NOR", "LIB", "LIB",
|
||||
"NOR", "AGR", "AGR",
|
||||
"NOR", "CONS", "CONS",
|
||||
"NOR", "COMM", "COMM",
|
||||
"NOR", "SOCL", "SOCL",
|
||||
"NOR", "CHPP", "CHPP",
|
||||
"NOR", "CENT", "CENT",
|
||||
# Sweden
|
||||
"SWE", "COMM", "COMM",
|
||||
"SWE", "SOCd", "SOCD",
|
||||
"SWE", "AGR", "AGR",
|
||||
"SWE", "LIB", "LIB",
|
||||
"SWE", "CONS", "CONS",
|
||||
"SWE", "CENT", "CENT",
|
||||
# Netherlands
|
||||
"NLD", "CPN", "CPN",
|
||||
"NLD", "SOCd", "SOCD",
|
||||
"NLD", "RAD", "RAD",
|
||||
"NLD", "KVP", "KVP",
|
||||
"NLD", "CHU", "CHU",
|
||||
"NLD", "LIB", "LIB",
|
||||
"NLD", "ARP", "ARP",
|
||||
"NLD", "SGP", "SGP",
|
||||
"NLD", "NSB", "NSB",
|
||||
"NLD", "PVDA", "PVDA",
|
||||
"NLD", "VVD", "VVD",
|
||||
"NLD", "PSP", "PSP",
|
||||
"NLD", "PPR", "PPR",
|
||||
"NLD", "D66", "D66",
|
||||
"NLD", "DS70", "DS70",
|
||||
"NLD", "GPV", "GPV",
|
||||
"NLD", "BP", "BP",
|
||||
# Belgium
|
||||
"BEL", "COMM", "COMM",
|
||||
"BEL", "POB", "POB",
|
||||
"BEL", "CATH", "CATH",
|
||||
"BEL", "LIB", "LIB",
|
||||
"BEL", "FNAT", "FNAT",
|
||||
"BEL", "REX", "REX",
|
||||
"BEL", "PSB", "PSB",
|
||||
"BEL", "RW", "RW",
|
||||
"BEL", "PSC", "PSC",
|
||||
"BEL", "FDF", "FDF",
|
||||
"BEL", "VOLK", "VOLK",
|
||||
"BEL", "PLP", "PLP",
|
||||
# France (Fourth Republic)
|
||||
"FRA", "PCF", "PCF",
|
||||
"FRA", "SFIO", "SFIO",
|
||||
"FRA", "MRP", "MRP",
|
||||
"FRA", "RDA", "RDA",
|
||||
"FRA", "UDSR", "UDSR",
|
||||
"FRA", "RAD", "RAD",
|
||||
"FRA", "RS", "RS",
|
||||
"FRA", "RPF", "RPF",
|
||||
"FRA", "AR", "AR",
|
||||
"FRA", "ARS", "ARS",
|
||||
"FRA", "RI", "RI",
|
||||
"FRA", "CNIP", "CNIP",
|
||||
"FRA", "PUS", "PUS",
|
||||
"FRA", "PAYS", "PAYS",
|
||||
"FRA", "AP", "AP",
|
||||
"FRA", "PRL", "PRL",
|
||||
"FRA", "POUJ", "POUJ",
|
||||
# Weimar Germany
|
||||
"DEU", "KPD", "KPD",
|
||||
"DEU", "SDAP", "SDAP",
|
||||
"DEU", "DDP", "DDP",
|
||||
"DEU", "DZP", "DZP",
|
||||
"DEU", "BVP", "BVP",
|
||||
"DEU", "DVP", "DVP",
|
||||
"DEU", "RDMW", "RDMW",
|
||||
"DEU", "LVP", "LVP",
|
||||
"DEU", "DNVP", "DNVP",
|
||||
"DEU", "NAZI", "NAZI",
|
||||
# Italy
|
||||
"ITA", "PCI", "PCI",
|
||||
"ITA", "PSIU", "PSIU",
|
||||
"ITA", "PSI", "PSI",
|
||||
"ITA", "PSDI", "PSDI",
|
||||
"ITA", "PRI", "PRI",
|
||||
"ITA", "DC", "DC",
|
||||
"ITA", "PLI", "PLI",
|
||||
"ITA", "MON", "MON",
|
||||
"ITA", "MSI", "MSI",
|
||||
# Luxembourg
|
||||
"LUX", "COMM", "COMM",
|
||||
"LUX", "SOCd", "SOCD",
|
||||
"LUX", "CSOC", "CSOC",
|
||||
"LUX", "GRPD", "GRPD",
|
||||
# Israel
|
||||
"ISR", "RAKA", "RAKA",
|
||||
"ISR", "MAKI", "MAKI",
|
||||
"ISR", "MAPM", "MAPM",
|
||||
"ISR", "MADT", "MADT",
|
||||
"ISR", "ADUT", "ADUT",
|
||||
"ISR", "MAAR", "MAAR",
|
||||
"ISR", "LAB", "LAB",
|
||||
"ISR", "MAPI", "MAPI",
|
||||
"ISR", "PAUG", "PAUG",
|
||||
"ISR", "RAFI", "RAFI",
|
||||
"ISR", "PROG", "PROG",
|
||||
"ISR", "ILIB", "ILIB",
|
||||
"ISR", "NRP", "NRP",
|
||||
"ISR", "URF", "URF",
|
||||
"ISR", "LIB", "LIB",
|
||||
"ISR", "NATL", "NATL",
|
||||
"ISR", "TORA", "TORA",
|
||||
"ISR", "LIKD", "LIKD",
|
||||
"ISR", "ZION", "ZION",
|
||||
"ISR", "GHAL", "GHAL",
|
||||
"ISR", "AGDT", "AGDT",
|
||||
"ISR", "HRUT", "HRUT"
|
||||
)
|
||||
|
||||
# Some parties in raw data that don't have exact matches - need special handling
|
||||
# (e.g., parties that only exist in one period in PartyFacts but appear in both)
|
||||
# We'll join using the period-based matching
|
||||
|
||||
# Expand periods to years for matching
|
||||
morgan_expanded <- morgan_raw %>%
|
||||
mutate(
|
||||
year_start = as.integer(str_extract(period, "^\\d{4}")),
|
||||
year_end = as.integer(str_extract(period, "\\d{4}$"))
|
||||
)
|
||||
|
||||
# Join with abbreviation map
|
||||
morgan_mapped <- morgan_expanded %>%
|
||||
left_join(abbrev_map, by = c("country", "party_abbrev"))
|
||||
|
||||
# Check for unmatched abbreviations
|
||||
unmatched_abbrev <- morgan_mapped %>%
|
||||
filter(is.na(party_abbrev_pf)) %>%
|
||||
distinct(country, party_abbrev)
|
||||
|
||||
if (nrow(unmatched_abbrev) > 0) {
|
||||
cat("\nWarning: Unmatched abbreviations:\n")
|
||||
print(unmatched_abbrev)
|
||||
}
|
||||
|
||||
# Join with PartyFacts
|
||||
morgan_joined <- morgan_mapped %>%
|
||||
left_join(morgan_pf, by = c("country", "party_abbrev_pf")) %>%
|
||||
# For parties with overlapping periods, use period overlap
|
||||
mutate(
|
||||
period_overlap = pmax(0,
|
||||
pmin(year_end, year_last) - pmax(year_start, year_first) + 1)
|
||||
) %>%
|
||||
# Keep best match per party-period (max overlap)
|
||||
group_by(country, party_abbrev, period) %>%
|
||||
slice_max(period_overlap, n = 1, with_ties = FALSE) %>%
|
||||
ungroup()
|
||||
|
||||
# Check for unmatched parties
|
||||
unmatched <- morgan_joined %>%
|
||||
filter(is.na(partyfacts_id)) %>%
|
||||
distinct(country, party_abbrev, party_name, period)
|
||||
|
||||
if (nrow(unmatched) > 0) {
|
||||
cat(sprintf("\n%d party-periods without PartyFacts match:\n", nrow(unmatched)))
|
||||
print(unmatched)
|
||||
}
|
||||
|
||||
# Dedup: when multiple abbreviations map to the same PF ID, keep only one
|
||||
matched <- morgan_joined %>%
|
||||
filter(!is.na(partyfacts_id)) %>%
|
||||
group_by(country, partyfacts_id, period) %>%
|
||||
slice(1) %>%
|
||||
ungroup()
|
||||
|
||||
cat(sprintf("\nMatched %d of %d party-period observations (%.1f%%)\n",
|
||||
nrow(matched), nrow(morgan_raw),
|
||||
100 * nrow(matched) / nrow(morgan_raw)))
|
||||
|
||||
# Normalize position to [0,1] scale
|
||||
# Original scale: 0-100
|
||||
# Apply boundary adjustments like other expert data
|
||||
eps <- 0.005
|
||||
morgan_processed <- matched %>%
|
||||
mutate(
|
||||
# Normalize to [0,1]
|
||||
lr_morgan = position / 100,
|
||||
# Apply boundary adjustments
|
||||
lr_morgan = case_when(
|
||||
lr_morgan <= 0 ~ eps,
|
||||
lr_morgan >= 1 ~ 1 - eps,
|
||||
TRUE ~ lr_morgan
|
||||
),
|
||||
# Calculate standard error (sd / sqrt(n))
|
||||
lr_morgan_se = (sd / 100) / sqrt(n_surveys),
|
||||
# Set minimum SE for extreme parties (sd=0)
|
||||
lr_morgan_se = pmax(lr_morgan_se, 0.01)
|
||||
) %>%
|
||||
select(
|
||||
country,
|
||||
partyfacts_id,
|
||||
period,
|
||||
year_start,
|
||||
year_end,
|
||||
party_abbrev,
|
||||
party_name,
|
||||
lr_morgan,
|
||||
lr_morgan_se,
|
||||
n_surveys
|
||||
) %>%
|
||||
arrange(country, year_start, lr_morgan)
|
||||
|
||||
# Summary statistics
|
||||
cat("\nSummary of processed Morgan data:\n")
|
||||
cat(sprintf(" Countries: %d\n", n_distinct(morgan_processed$country)))
|
||||
cat(sprintf(" Parties: %d\n", n_distinct(morgan_processed$partyfacts_id)))
|
||||
cat(sprintf(" Observations: %d\n", nrow(morgan_processed)))
|
||||
|
||||
# Distribution of positions
|
||||
cat("\nPosition distribution:\n")
|
||||
print(summary(morgan_processed$lr_morgan))
|
||||
|
||||
# Write output
|
||||
write_csv(morgan_processed, "morgan_data.csv")
|
||||
cat(sprintf("\nWrote morgan_data.csv with %d rows\n", nrow(morgan_processed)))
|
||||
|
||||
# Also provide a summary by country and period
|
||||
summary_by_country <- morgan_processed %>%
|
||||
group_by(country, period) %>%
|
||||
summarise(
|
||||
n_parties = n(),
|
||||
mean_pos = mean(lr_morgan),
|
||||
sd_pos = sd(lr_morgan),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
cat("\nSummary by country and period:\n")
|
||||
print(summary_by_country, n = 50)
|
||||
|
||||
# ============================================================
|
||||
# Generate lr_data-compatible output for pipeline integration
|
||||
# ============================================================
|
||||
|
||||
cat("\n============================================================\n")
|
||||
cat("Generating lr_data-compatible output (postwar only)\n")
|
||||
cat("============================================================\n")
|
||||
|
||||
# Load text_data to get party-years with manifesto/PolDem coverage
|
||||
if (!file.exists("text_data.csv")) {
|
||||
cat("text_data.csv not present yet; skipping morgan_lr.csv generation on this pass.\n")
|
||||
} else {
|
||||
text_data <- read_csv("text_data.csv", show_col_types = FALSE)
|
||||
|
||||
# Convert Morgan ISO3 country codes to ISO2 (matching text_data format)
|
||||
iso3_to_iso2 <- c(
|
||||
"DNK" = "DK", "FIN" = "FI", "ISL" = "IS", "NOR" = "NO", "SWE" = "SE",
|
||||
"NLD" = "NL", "BEL" = "BE", "DEU" = "DE", "FRA" = "FR", "ITA" = "IT",
|
||||
"LUX" = "LU", "ISR" = "IL"
|
||||
)
|
||||
|
||||
# Filter to postwar periods only (1945+)
|
||||
morgan_postwar <- morgan_processed %>%
|
||||
filter(year_end >= 1945) %>%
|
||||
mutate(country_iso2 = iso3_to_iso2[country])
|
||||
|
||||
cat(sprintf("Postwar Morgan observations: %d party-periods\n", nrow(morgan_postwar)))
|
||||
cat(sprintf("Countries: %s\n", paste(unique(morgan_postwar$country_iso2), collapse = ", ")))
|
||||
|
||||
# Get unique party-years from text_data
|
||||
text_party_years <- text_data %>%
|
||||
select(party, country, year) %>%
|
||||
distinct()
|
||||
|
||||
cat(sprintf("Unique party-years in text_data: %d\n", nrow(text_party_years)))
|
||||
|
||||
# For each Morgan party-period, expand to all years where that party has text data
|
||||
# within the Morgan period range (1945-1973 for postwar)
|
||||
morgan_lr <- morgan_postwar %>%
|
||||
# Join with text_data party-years
|
||||
# Many-to-many is expected: one Morgan party-period maps to multiple years
|
||||
inner_join(
|
||||
text_party_years,
|
||||
by = c("partyfacts_id" = "party", "country_iso2" = "country"),
|
||||
relationship = "many-to-many"
|
||||
) %>%
|
||||
# Keep only years within the Morgan period
|
||||
filter(year >= year_start & year <= year_end) %>%
|
||||
# Format for lr_data.csv compatibility
|
||||
transmute(
|
||||
country = country_iso2,
|
||||
party = partyfacts_id,
|
||||
var = "lr_morgan",
|
||||
year = year,
|
||||
val = lr_morgan,
|
||||
project = "Morgan",
|
||||
# Morgan's continuous 0-100 scale is discretized to 10 points (matching CHES
|
||||
# resolution) with the actual number of experts. The reconstructed sum
|
||||
# round(mean × K × 10) is analogous to how CHES means are handled.
|
||||
# See docs/k_scaling_validation.md Section 4.
|
||||
n_scale = 10L,
|
||||
val_int = as.integer(round(lr_morgan * 10)),
|
||||
n_experts = as.integer(n_surveys)
|
||||
) %>%
|
||||
distinct() %>%
|
||||
arrange(country, party, year)
|
||||
|
||||
cat(sprintf("\nGenerated %d lr_morgan observations\n", nrow(morgan_lr)))
|
||||
cat(sprintf(" Unique parties: %d\n", n_distinct(morgan_lr$party)))
|
||||
cat(sprintf(" Year range: %d-%d\n", min(morgan_lr$year), max(morgan_lr$year)))
|
||||
|
||||
# Summary by country
|
||||
morgan_lr_summary <- morgan_lr %>%
|
||||
group_by(country) %>%
|
||||
summarise(
|
||||
n_parties = n_distinct(party),
|
||||
n_obs = n(),
|
||||
year_min = min(year),
|
||||
year_max = max(year),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
cat("\nMorgan L-R data by country:\n")
|
||||
print(morgan_lr_summary, n = 20)
|
||||
|
||||
# Write morgan_lr.csv
|
||||
write_csv(morgan_lr, "morgan_lr.csv")
|
||||
cat(sprintf("\nWrote morgan_lr.csv with %d rows\n", nrow(morgan_lr)))
|
||||
}
|
||||
@@ -0,0 +1,162 @@
|
||||
# ============================================================
|
||||
# process_poldem.R - PolDem Media Data Processing
|
||||
# ============================================================
|
||||
# Processes PolDem (Political Deliberation in the Media) data
|
||||
# for the two-dimensional party-position model
|
||||
#
|
||||
# Input: $PARTY2D_RAW_DATA_DIR/poldem/poldem-election_all.csv (sentence-level)
|
||||
# Output: poldem_data.csv (party-year-var aggregates)
|
||||
# ============================================================
|
||||
|
||||
library(tidyverse)
|
||||
library(countrycode)
|
||||
|
||||
# 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 PolDem media data...\n")
|
||||
|
||||
raw_data_dir <- Sys.getenv(
|
||||
"PARTY2D_RAW_DATA_DIR",
|
||||
unset = file.path("..", "..", "_local", "raw")
|
||||
)
|
||||
poldem_raw_path <- file.path(raw_data_dir, "poldem", "poldem-election_all.csv")
|
||||
partyfacts_path <- file.path(raw_data_dir, "partyfacts", "partyfacts-external-parties.csv")
|
||||
|
||||
# ============================================================
|
||||
# PartyFacts Linkage (via CMP party IDs)
|
||||
# ============================================================
|
||||
|
||||
partyfacts_raw <- read_csv(partyfacts_path, show_col_types = FALSE)
|
||||
manifesto_link <- partyfacts_raw %>%
|
||||
filter(dataset_key == "manifesto") %>%
|
||||
transmute(cmp = as.numeric(dataset_party_id), # Convert to numeric for join
|
||||
country_pf = countrycode(country, origin = 'iso3c', destination = "iso2c"),
|
||||
party = partyfacts_id,
|
||||
party = ifelse(party == 622, 604, party))
|
||||
|
||||
# ============================================================
|
||||
# Issue Category Mapping to 4 Dimensions
|
||||
# ============================================================
|
||||
# For positive direction: type_high is the active trait
|
||||
# For negative direction: we flip (same data, just contributes to the opposite trait)
|
||||
|
||||
poldem_mapping <- tribble(
|
||||
~issue_cat, ~dimension, ~type_high, ~type_low,
|
||||
# Economic dimension
|
||||
"ecolib", "economic", "pro_market", "pro_welfare", # Economic liberalization
|
||||
"welfare", "economic", "pro_welfare", "pro_market", # Welfare state
|
||||
# Final exclusion: the PolDem economic-reform category is intentionally
|
||||
# omitted because item-response diagnostics showed that it did not load
|
||||
# substantively onto the economic latent trait.
|
||||
# Cultural dimension
|
||||
"immig", "cultural", "cosmopolitan", "traditional", # Immigration (pro = cosmopolitan)
|
||||
"cultlib", "cultural", "cosmopolitan", "traditional", # Cultural liberalism
|
||||
"nationalism", "cultural", "traditional", "cosmopolitan", # Nationalism (pro = traditional)
|
||||
"europe", "cultural", "cosmopolitan", "traditional", # EU integration (pro = cosmopolitan)
|
||||
"euro", "cultural", "cosmopolitan", "traditional", # Euro currency (pro = cosmopolitan)
|
||||
"defense", "cultural", "traditional", "cosmopolitan", # Defense (pro = traditional)
|
||||
"security", "cultural", "traditional", "cosmopolitan" # Security/law-order (pro = traditional)
|
||||
)
|
||||
|
||||
cat(sprintf(" Using %d issue categories\n", nrow(poldem_mapping)))
|
||||
|
||||
# ============================================================
|
||||
# Load and Clean PolDem Data
|
||||
# ============================================================
|
||||
|
||||
poldem_raw <- read_csv(poldem_raw_path, show_col_types = FALSE)
|
||||
cat(sprintf(" Raw PolDem data: %d rows\n", nrow(poldem_raw)))
|
||||
|
||||
poldem <- poldem_raw %>%
|
||||
# Fix country codes
|
||||
mutate(country = case_when(
|
||||
iso2code == "AU" ~ "AT", # Austria (PolDem uses AU instead of AT)
|
||||
iso2code == "UK" ~ "GB", # United Kingdom
|
||||
TRUE ~ iso2code
|
||||
)) %>%
|
||||
# Extract year from article date (format: YYYY-MM-DD)
|
||||
mutate(year = suppressWarnings(as.numeric(substr(date_art, 1, 4)))) %>%
|
||||
# Filter to valid issue categories only
|
||||
filter(issue_cat %in% poldem_mapping$issue_cat) %>%
|
||||
# Convert direction to numeric and filter out neutral/NA
|
||||
mutate(direction = as.numeric(direction)) %>%
|
||||
filter(!is.na(direction) & direction != 0) %>%
|
||||
# Remove rows with invalid years
|
||||
filter(!is.na(year))
|
||||
|
||||
cat(sprintf(" After filtering: %d rows (valid issues, non-neutral)\n", nrow(poldem)))
|
||||
|
||||
# ============================================================
|
||||
# Link to PartyFacts via CMP codes
|
||||
# ============================================================
|
||||
|
||||
poldem <- poldem %>%
|
||||
mutate(cmp = as.numeric(cmp)) %>%
|
||||
left_join(manifesto_link, by = "cmp") %>%
|
||||
filter(!is.na(party))
|
||||
|
||||
# Report linkage
|
||||
n_linked <- nrow(poldem)
|
||||
n_unlinked <- nrow(poldem_raw %>%
|
||||
filter(issue_cat %in% poldem_mapping$issue_cat) %>%
|
||||
mutate(direction = as.numeric(direction)) %>%
|
||||
filter(!is.na(direction) & direction != 0)) - n_linked
|
||||
|
||||
cat(sprintf(" Linked to PartyFacts: %d rows\n", n_linked))
|
||||
if (n_unlinked > 0) {
|
||||
cat(sprintf(" Warning: %d rows could not be linked (missing CMP mapping)\n", n_unlinked))
|
||||
}
|
||||
|
||||
# ============================================================
|
||||
# Aggregate to Party-Year-Issue Level
|
||||
# Using round(sum()) for weak direction values (0.5, -0.5)
|
||||
# ============================================================
|
||||
|
||||
poldem_agg <- poldem %>%
|
||||
left_join(poldem_mapping, by = "issue_cat") %>%
|
||||
group_by(party, country, year, issue_cat, type_high, type_low) %>%
|
||||
summarise(
|
||||
# Sum positive directions (0.5 and 1), then round
|
||||
positive = round(sum(direction[direction > 0])),
|
||||
# Sum absolute directions for sample (all non-neutral), then round
|
||||
sample = round(sum(abs(direction))),
|
||||
n_obs = n(),
|
||||
.groups = "drop"
|
||||
) %>%
|
||||
# Minimum 3 observations per group
|
||||
filter(n_obs >= 3) %>%
|
||||
select(-n_obs)
|
||||
|
||||
cat(sprintf(" After aggregation: %d party-year-issue observations\n", nrow(poldem_agg)))
|
||||
|
||||
# ============================================================
|
||||
# Format Output (matching manifesto structure)
|
||||
# ============================================================
|
||||
|
||||
poldem_data <- poldem_agg %>%
|
||||
mutate(
|
||||
var = paste0(issue_cat, "_poldem"),
|
||||
project = "PolDem"
|
||||
) %>%
|
||||
select(party, country, year, var, positive, sample, type_high, type_low, project)
|
||||
|
||||
# ============================================================
|
||||
# Write Output
|
||||
# ============================================================
|
||||
|
||||
write_csv(poldem_data, "poldem_data.csv")
|
||||
|
||||
cat(sprintf("\nOutput: poldem_data.csv\n"))
|
||||
cat(sprintf(" Total rows: %d\n", nrow(poldem_data)))
|
||||
cat(sprintf(" Unique parties: %d\n", n_distinct(poldem_data$party)))
|
||||
cat(sprintf(" Countries: %s\n", paste(sort(unique(poldem_data$country)), collapse = ", ")))
|
||||
cat(sprintf(" Year range: %d-%d\n", min(poldem_data$year, na.rm = TRUE), max(poldem_data$year, na.rm = TRUE)))
|
||||
cat("\n Rows by issue category:\n")
|
||||
poldem_data %>%
|
||||
group_by(var) %>%
|
||||
summarise(n = n(), .groups = "drop") %>%
|
||||
arrange(desc(n)) %>%
|
||||
print()
|
||||
@@ -0,0 +1,86 @@
|
||||
# Data setup
|
||||
|
||||
This directory exists because the public repository cannot redistribute the original raw/source files. It downloads script-accessible sources, checks user-provided source files, rebuilds model-ready inputs, and compares them with the committed files in `../data/`.
|
||||
|
||||
The main estimation workflow does not run these scripts. Once the five model-ready CSVs exist in `data/`, fitting and post-estimation are Julia/Stan-only.
|
||||
|
||||
The setup workflow never overwrites committed files in `data/`.
|
||||
|
||||
Put raw source files in `_local/raw/` or set `PARTY2D_RAW_DATA_DIR` to another local directory. See `source_manifest.csv` and the source notes below for source-specific access requirements.
|
||||
|
||||
## What downloads automatically?
|
||||
|
||||
`data-setup/R/01_download_sources.R` downloads source files that are script-accessible under the providers' terms and reports sources that require credentials or manual local files.
|
||||
|
||||
| Source | Automatic? | Requirement |
|
||||
| --- | --- | --- |
|
||||
| PolDem | Yes | none |
|
||||
| PartyFacts crosswalk | Yes | none |
|
||||
| CHES family files | Yes | none where provider links are live |
|
||||
| POPPA | Yes | none; downloaded from Harvard Dataverse |
|
||||
| Global Party Survey 2019 | Yes | none; downloaded from Harvard Dataverse |
|
||||
| V-Party | Yes, with provider form details | set `PARTY2D_VDEM_EMAIL`; optionally set `PARTY2D_VDEM_GENDER` |
|
||||
| Manifesto Project | Yes, with credentials | set your own `MANIFESTO_API_KEY` or `PARTY2D_MANIFESTO_API_KEY` |
|
||||
| Morgan historical expert data | No | place `morgan_positions_raw.csv` locally; available on request |
|
||||
|
||||
Do not commit downloaded or user-provided source files.
|
||||
|
||||
Recommended local layout:
|
||||
|
||||
```text
|
||||
_local/raw/
|
||||
manifesto/MPDataset_MPDS2025a.csv
|
||||
poldem/poldem-election_all.csv
|
||||
ches/...
|
||||
vparty/...
|
||||
poppa/...
|
||||
gps/...
|
||||
morgan/...
|
||||
partyfacts/partyfacts-external-parties.csv
|
||||
```
|
||||
|
||||
Local output layout:
|
||||
|
||||
```text
|
||||
_local/build/ # intermediate processing files
|
||||
_local/generated-inputs/ # regenerated final model-input CSVs
|
||||
_local/reports/ # comparison reports
|
||||
```
|
||||
|
||||
## Commands
|
||||
|
||||
Run the full source-data setup workflow with:
|
||||
|
||||
```bash
|
||||
bash data-setup/run_data_setup.sh
|
||||
```
|
||||
|
||||
The command downloads script-accessible sources, checks required local files,
|
||||
rebuilds model-ready inputs under `_local/generated-inputs/`, and writes a
|
||||
comparison report under `_local/reports/`. It never replaces committed files in
|
||||
`data/`.
|
||||
|
||||
V-Party:
|
||||
|
||||
```bash
|
||||
export PARTY2D_VDEM_EMAIL='you@example.org'
|
||||
export PARTY2D_VDEM_GENDER='' # blank means prefer not to say
|
||||
```
|
||||
|
||||
Manifesto Project:
|
||||
|
||||
```bash
|
||||
export MANIFESTO_API_KEY='...'
|
||||
# or
|
||||
export PARTY2D_MANIFESTO_API_KEY='...'
|
||||
```
|
||||
|
||||
Morgan is not a public provider download. The local OCR/transcription file can be provided on request and should be placed at:
|
||||
|
||||
```text
|
||||
_local/raw/morgan/morgan_positions_raw.csv
|
||||
```
|
||||
|
||||
The comparison writes `_local/reports/input_comparison.md`. Replacing committed inputs, if ever needed, is a separate manual decision and is not done by these scripts.
|
||||
|
||||
Known behavior: the current public/rebuilt sources run through the workflow successfully, but regenerated `text_data.csv`, `expert.csv`, and `lr_data.csv` are not byte-identical to the committed model-ready inputs because of source-version and linkage differences. The comparison report records those differences explicitly.
|
||||
@@ -0,0 +1,58 @@
|
||||
#!/usr/bin/env bash
|
||||
set -euo pipefail
|
||||
|
||||
repo_root="$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd -P)"
|
||||
raw_data_dir="${PARTY2D_RAW_DATA_DIR:-$repo_root/_local/raw}"
|
||||
report_dir="${PARTY2D_REPORT_DIR:-$repo_root/_local/reports}"
|
||||
mkdir -p "$report_dir"
|
||||
missing_report="$report_dir/raw_data_preflight_missing.txt"
|
||||
: > "$missing_report"
|
||||
|
||||
required_files=(
|
||||
"manifesto/MPDataset_MPDS2025a.csv"
|
||||
"poldem/poldem-election_all.csv"
|
||||
"partyfacts/partyfacts-external-parties.csv"
|
||||
"ches/1999-2019_CHES_dataset_means(v3).csv"
|
||||
"ches/CHES_2024_final_v2.csv"
|
||||
"ches/CHES_2024_expert_level.csv"
|
||||
"ches/CHES_CA2023.csv"
|
||||
"ches/CHES_CA2023_expert_level.csv"
|
||||
"ches/ches_la_2020_aggregate_level_v01.csv"
|
||||
"ches/CHES_LA2020_expert_level.csv"
|
||||
"ches/CHES_ISRAEL_means_2021_2022.csv"
|
||||
"ches/CHES_IL_expert_level.csv"
|
||||
"vparty/V-Dem-CPD-Party-V2.rds"
|
||||
"poppa/poppa_integrated_v2.rds"
|
||||
"gps/Global Party Survey by Party SPSS V2_1_Apr_2020-2.tab"
|
||||
"morgan/morgan_positions_raw.csv"
|
||||
)
|
||||
|
||||
echo "Raw data directory: $raw_data_dir"
|
||||
echo
|
||||
echo "Required raw inputs for regeneration:"
|
||||
|
||||
missing=0
|
||||
for rel in "${required_files[@]}"; do
|
||||
path="$raw_data_dir/$rel"
|
||||
if [ -s "$path" ]; then
|
||||
bytes="$(wc -c < "$path")"
|
||||
read -r sha _ < <(sha256sum "$path")
|
||||
echo " OK $rel ($bytes bytes, sha256=$sha)"
|
||||
else
|
||||
echo " MISSING $rel"
|
||||
printf '%s\n' "$rel" >> "$missing_report"
|
||||
missing=1
|
||||
fi
|
||||
done
|
||||
|
||||
if [ "$missing" -ne 0 ]; then
|
||||
echo
|
||||
echo "At least one required raw input is missing." >&2
|
||||
echo "Missing-file report: $missing_report" >&2
|
||||
echo "See data-setup/README.md and docs/RAW_DATA_SOURCES.md for instructions." >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
echo
|
||||
echo "Required raw data preflight passed."
|
||||
rm -f "$missing_report"
|
||||
@@ -0,0 +1,34 @@
|
||||
#!/usr/bin/env bash
|
||||
set -euo pipefail
|
||||
|
||||
usage() {
|
||||
cat >&2 <<'EOF'
|
||||
Usage: bash data-setup/run_data_setup.sh
|
||||
EOF
|
||||
}
|
||||
|
||||
if [ "$#" -ne 0 ]; then
|
||||
usage
|
||||
exit 1
|
||||
fi
|
||||
|
||||
repo_root="$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd -P)"
|
||||
cd "$repo_root"
|
||||
|
||||
export PARTY2D_RAW_DATA_DIR="${PARTY2D_RAW_DATA_DIR:-$repo_root/_local/raw}"
|
||||
export PARTY2D_BUILD_DIR="${PARTY2D_BUILD_DIR:-$repo_root/_local/build}"
|
||||
export PARTY2D_GENERATED_INPUT_DIR="${PARTY2D_GENERATED_INPUT_DIR:-$repo_root/_local/generated-inputs}"
|
||||
export PARTY2D_REPORT_DIR="${PARTY2D_REPORT_DIR:-$repo_root/_local/reports}"
|
||||
export R_LIBS_USER="${R_LIBS_USER:-$repo_root/_local/R/library}"
|
||||
mkdir -p "$R_LIBS_USER"
|
||||
|
||||
command -v bash >/dev/null
|
||||
command -v Rscript >/dev/null
|
||||
bash -n data-setup/check_raw_data.sh
|
||||
Rscript data-setup/R/00_install_dependencies.R
|
||||
Rscript data-setup/R/01_download_sources.R || true
|
||||
bash data-setup/check_raw_data.sh
|
||||
rm -rf "$PARTY2D_BUILD_DIR" "$PARTY2D_GENERATED_INPUT_DIR"
|
||||
mkdir -p "$PARTY2D_BUILD_DIR" "$PARTY2D_GENERATED_INPUT_DIR"
|
||||
Rscript data-setup/R/02_build_model_inputs.R
|
||||
Rscript data-setup/R/03_compare_generated_inputs.R
|
||||
@@ -0,0 +1,17 @@
|
||||
source,scope,local_path,access,automatic_download,notes
|
||||
Manifesto Project,manifesto text/coding,manifesto/MPDataset_MPDS2025a.csv,API key/login required,yes with MANIFESTO_API_KEY,Use the MPDS 2025a CSV export; raw file is not redistributed.
|
||||
PolDem Election Campaigns,media campaign issue statements,poldem/poldem-election_all.csv,public download,yes,CSV URL https://poldem.eui.eu/downloads/cosa/poldem-election_all.csv; observed sha256 2cd8c9108b1b0b9c1b6594bb21acee709c70259cd02f450bc69fc09b505fc9fb.
|
||||
CHES 1999-2019,expert party placements,ches/1999-2019_CHES_dataset_means(v3).csv,public archived download,yes,Downloaded from archived CHES URL at chesdata.eu.
|
||||
CHES 2024,expert party placements,ches/CHES_2024_final_v2.csv,CHES terms,no,Requires matching expert-level file for expert counts.
|
||||
CHES 2024 expert level,expert counts,ches/CHES_2024_expert_level.csv,CHES terms,no,Required for expert counts.
|
||||
CHES Canada 2023 aggregate,expert party placements,ches/CHES_CA2023.csv,CHES terms,no,Required for Canada extension.
|
||||
CHES Canada 2023,expert party placements,ches/CHES_CA2023_expert_level.csv,CHES terms,no,Used by expert-source processing where available.
|
||||
CHES Latin America aggregate,expert party placements,ches/ches_la_2020_aggregate_level_v01.csv,CHES terms,no,Required for Latin America extension.
|
||||
CHES Latin America 2020,expert party placements,ches/CHES_LA2020_expert_level.csv,CHES terms,no,Used by expert-source processing where available.
|
||||
CHES Israel aggregate,expert party placements,ches/CHES_ISRAEL_means_2021_2022.csv,CHES terms,no,Required for Israel extension.
|
||||
CHES Israel,expert party placements,ches/CHES_IL_expert_level.csv,CHES terms,no,Used by expert-source processing where available.
|
||||
V-Party,expert-coded party variables,vparty/V-Dem-CPD-Party-V2.rds,V-Dem form terms,yes with PARTY2D_VDEM_EMAIL,Downloader submits provider form and extracts R data from ZIP.
|
||||
POPPA,expert party placements,poppa/poppa_integrated_v2.rds,public Dataverse,yes,Downloaded from Harvard Dataverse DOI 10.7910/DVN/RMQREQ.
|
||||
Global Party Survey 2019,expert party placements,gps/Global Party Survey by Party SPSS V2_1_Apr_2020-2.tab,public Dataverse,yes,Downloaded from Harvard Dataverse DOI 10.7910/DVN/WMGTNS.
|
||||
Morgan historical expert data,historical left-right placements,morgan/morgan_positions_raw.csv,derived local transcription/no redistribution,no public URL,Local OCR/transcription source used for historical anchoring.
|
||||
PartyFacts crosswalk,party ID harmonization,partyfacts/partyfacts-external-parties.csv,public download,yes,Support crosswalk required by source-processing scripts.
|
||||
|
Reference in New Issue
Block a user