Clean public release repository
This commit is contained in:
Armin
@@ -918,7 +918,7 @@ end
|
||||
|
||||
function main()
|
||||
println("="^60)
|
||||
println("POST-ESTIMATION: 4D Latent Trait Model (V10)")
|
||||
println("POST-ESTIMATION: Party-position model")
|
||||
println("="^60)
|
||||
println("Started: $(Dates.format(now(), "yyyy-mm-dd HH:MM:SS"))")
|
||||
|
||||
|
||||
@@ -95,7 +95,7 @@ const EXPERT_VAR_TO_DIM = Dict(
|
||||
)
|
||||
|
||||
function load_and_preprocess_4dim_data(start_year=1950; data_dir::String=".")
|
||||
println("Loading 4D latent trait data files...")
|
||||
println("Loading party-position data files...")
|
||||
println("Start year filter: $start_year")
|
||||
data_dir != "." && println("Data directory: $data_dir")
|
||||
|
||||
@@ -274,4 +274,4 @@ end
|
||||
if abspath(PROGRAM_FILE) == @__FILE__
|
||||
text_data, expert_dim, expert_lr, year0, u2c, c2u = load_and_preprocess_4dim_data()
|
||||
println("4D data loading test completed successfully")
|
||||
end
|
||||
end
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#!/usr/bin/env julia
|
||||
#############################################################################
|
||||
## 04_model_execution_4dim.jl
|
||||
## Stan model compilation and execution for 4D latent trait model
|
||||
## Stan model compilation and execution for the party-position model
|
||||
## Based on v9 execution but adapted for four dimensions
|
||||
#############################################################################
|
||||
|
||||
@@ -601,7 +601,7 @@ function create_4dim_init_function(dat_4dim, J, P, R, T_year, N_ciy; model_versi
|
||||
# SOLUTION: Use explicit Vector{Vector} to guarantee correct JSON structure
|
||||
# V10: theta_init_raw has S rows (segments), not J rows (parties)
|
||||
base_init = Dict{String, Any}(
|
||||
# 4D latent trait parameters - Vector of Vectors for correct JSON
|
||||
# Four-trait legacy initialization branch - Vector of Vectors for correct JSON
|
||||
"theta_ncp" => [zeros(R) for _ in 1:4], # 4 rows of R elements
|
||||
"theta_init_raw" => [zeros(S) for _ in 1:4], # 4 rows of S elements (V10: segments)
|
||||
"sigma_theta_init" => ones(4), # SD per dimension
|
||||
|
||||
@@ -2,14 +2,14 @@
|
||||
#############################################################################
|
||||
## 05_results_processing.jl
|
||||
## Extract and process 4D model results with diagnostics
|
||||
## Adapted from old_project for latent traits only (no election effects)
|
||||
## Extract and process model results without election effects
|
||||
#############################################################################
|
||||
|
||||
using StanSample, DataFrames, Statistics
|
||||
|
||||
function extract_model_results_4dim(stanmodel)
|
||||
"""
|
||||
Extract model results for 4D latent trait model
|
||||
Extract model results for the party-position model
|
||||
Simplified version - no election effects (pure latent traits)
|
||||
"""
|
||||
println("Extracting 4D model results...")
|
||||
@@ -17,7 +17,7 @@ function extract_model_results_4dim(stanmodel)
|
||||
try
|
||||
println("Model completed successfully - extracting results")
|
||||
|
||||
# For 4D latent trait model, we save the full stanmodel object
|
||||
# Save the full stanmodel object for downstream processing
|
||||
# Post-estimation will extract specific parameters later
|
||||
|
||||
return (
|
||||
|
||||
@@ -294,7 +294,7 @@ function generate_readme(
|
||||
|
||||
open(filepath, "w") do f
|
||||
write(f, "=" ^ 78 * "\n")
|
||||
write(f, "4D LATENT TRAIT MODEL - MODEL RUN RESULTS\n")
|
||||
write(f, "PARTY-POSITION MODEL - MODEL RUN RESULTS\n")
|
||||
write(f, "=" ^ 78 * "\n\n")
|
||||
|
||||
write(f, "Run ID: $run_id\n")
|
||||
|
||||
@@ -1,311 +0,0 @@
|
||||
# ============================================================
|
||||
# 00_data-management.R - Master Data Pipeline Orchestrator
|
||||
# ============================================================
|
||||
# Coordinates all data processing sub-scripts and produces
|
||||
# final output files for the 4D latent trait model.
|
||||
#
|
||||
# Sub-scripts (run conditionally based on intermediate file existence):
|
||||
# 00a_process_manifesto.R -> manifesto_data.csv
|
||||
# 00c_process_poldem.R -> poldem_data.csv
|
||||
# 00d_process_expert.R -> expert_raw.csv, lr_data_raw.csv
|
||||
# 00e_process_morgan.R -> morgan_data.csv, morgan_lr.csv
|
||||
#
|
||||
# Final outputs:
|
||||
# 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)
|
||||
|
||||
# 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("============================================================\n")
|
||||
cat("Data Management Pipeline\n")
|
||||
cat("============================================================\n\n")
|
||||
|
||||
# ============================================================
|
||||
# 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 00a_process_manifesto.R...\n")
|
||||
source("../src/r/00a_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 00c_process_poldem.R...\n")
|
||||
source("../src/r/00c_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 00d_process_expert.R...\n")
|
||||
source("../src/r/00d_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 00e_process_morgan.R (initial processing)...\n")
|
||||
source("../src/r/00e_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("../src/r/00e_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")
|
||||
|
||||
cat("\n============================================================\n")
|
||||
cat("Pipeline Complete!\n")
|
||||
cat("============================================================\n\n")
|
||||
|
||||
cat("Output files written:\n")
|
||||
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")
|
||||
@@ -1,178 +0,0 @@
|
||||
# ============================================================
|
||||
# 00a_process_manifesto.R - Manifesto Project Data Processing
|
||||
# ============================================================
|
||||
# Processes Manifesto Project data for the 4D latent trait 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 Linkage
|
||||
# ============================================================
|
||||
|
||||
partyfacts_raw <- read_csv('partyfacts-external-parties.csv', 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 00_data-management.R
|
||||
# This allows exempting parties that appear in parliamentary data
|
||||
# (parties in parliament are by definition not fringe parties)
|
||||
# ============================================================
|
||||
|
||||
cat("Skipping temporal filter (applied in 00_data-management.R after combining with parl 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)
|
||||
@@ -1,161 +0,0 @@
|
||||
# ============================================================
|
||||
# 00c_process_poldem.R - PolDem Media Data Processing
|
||||
# ============================================================
|
||||
# Processes PolDem (Political Deliberation in the Media) data
|
||||
# for the 4D latent trait 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 Linkage (via CMP party IDs)
|
||||
# ============================================================
|
||||
|
||||
partyfacts_raw <- read_csv('partyfacts-external-parties.csv', 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()
|
||||
@@ -1,580 +0,0 @@
|
||||
# ============================================================
|
||||
# 00d_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")
|
||||
|
||||
# ============================================================
|
||||
# PartyFacts Linkage for CHES
|
||||
# ============================================================
|
||||
|
||||
partyfacts_raw <- read_csv('partyfacts-external-parties.csv', 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('~/data/ches/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('~/data/ches/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('~/data/ches/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('~/data/ches/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('~/data/ches/1999-2019_CHES_dataset_means(v3).csv', show_col_types = FALSE) %>%
|
||||
rename(country_id = country) %>%
|
||||
left_join(readRDS('~/data/ches/link.rds'), by = "country_id") %>%
|
||||
transmute(country = countrycode(country, origin = 'country.name', destination = 'iso2c'),
|
||||
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) {
|
||||
result <- country_lookup[codes]
|
||||
result[is.na(result)] <- codes[is.na(result)]
|
||||
return(unname(result))
|
||||
}
|
||||
|
||||
ches24 <- read_csv('~/data/ches/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('~/data/ches/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 <- read_csv('~/data/ches/ches_la_link.csv', show_col_types = FALSE) %>%
|
||||
transmute(id = as.character(ches_party_id),
|
||||
party = partyfacts_id)
|
||||
|
||||
ches_la <- read_csv('~/data/ches/ches_la_2020_aggregate_level_v01.csv', show_col_types = FALSE) %>%
|
||||
left_join(ches_la_expert_counts, by = "party_id") %>%
|
||||
transmute(country = 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 = "id") %>%
|
||||
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_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 <- read_csv('~/data/ches/ches_israel_link.csv', show_col_types = FALSE) %>%
|
||||
transmute(id = as.character(ches_party_id),
|
||||
party = partyfacts_id)
|
||||
|
||||
ches_il <- read_csv('~/data/ches/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 = "id") %>%
|
||||
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('~/data/ches/1999-2019_CHES_dataset_means(v3).csv', show_col_types = FALSE) %>%
|
||||
rename(country_id = country) %>%
|
||||
left_join(readRDS('~/data/ches/link.rds'), by = "country_id") %>%
|
||||
transmute(country = countrycode(country, origin = 'country.name', destination = 'iso2c'),
|
||||
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('~/data/ches/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('~/data/ches/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('~/data/ches/ches_la_2020_aggregate_level_v01.csv', show_col_types = FALSE) %>%
|
||||
left_join(ches_la_expert_counts, by = "party_id") %>%
|
||||
transmute(country = 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 = "id") %>%
|
||||
filter(!is.na(val), !is.na(party), !is.na(country)) %>%
|
||||
select(-id)
|
||||
|
||||
# CHES Israel LR
|
||||
ches_il_lr <- read_csv('~/data/ches/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 = "id") %>%
|
||||
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('~/data/v-party/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('~/data/POPPA/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('~/data/POPPA/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("~/data/GPS_norris/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)))
|
||||
@@ -1,388 +0,0 @@
|
||||
# 00e_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")
|
||||
|
||||
# Load raw extracted data
|
||||
morgan_raw <- read_csv("morgan_positions_raw.csv", 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-external-parties.csv", 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
|
||||
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)))
|
||||
Reference in New Issue
Block a user