Wire local-only data setup workflow
This commit is contained in:
aseimel
@@ -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)))
|
||||
}
|
||||
Reference in New Issue
Block a user