# 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))) }