aseimel
349 lines
14 KiB
R
349 lines
14 KiB
R
# ============================================================
|
|
# 02_build_model_inputs.R - Master Data Pipeline Orchestrator
|
|
# ============================================================
|
|
# Coordinates all data processing sub-scripts and produces
|
|
# final output files for the 4D latent trait 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")
|