aseimel
400 lines
12 KiB
R
400 lines
12 KiB
R
# 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)))
|
||
}
|