armin/party2d
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 1 Wiki Activity

Prepare release repository for publication

Browse Source
This commit is contained in:
Armin
2026-06-15 17:27:25 +02:00
parent c53c1e8ba2
commit f59b8645b3
27 changed files with 140 additions and 215702 deletions
Download Patch File Download Diff File Expand all files Collapse all files
diagnostics/generate_diagnostics.R
+72 -14
View File
@@ -22,6 +22,8 @@ if (!grepl("^/", outputs_dir)) outputs_dir <- file.path(repo_root, outputs_dir)
if (!dir.exists(outputs_dir)) {
stop("Model output directory not found: ", outputs_dir, ". Run estimation/validation first or set PARTY2D_OUTPUTS_DIR.")
}
review_package_dir <- Sys.getenv("PARTY2D_REVIEW_PACKAGE_DIR", file.path(dirname(repo_root), "archive", "review_package"))
if (!grepl("^/", review_package_dir)) review_package_dir <- file.path(repo_root, review_package_dir)
generated_dir <- file.path(repo_root, "diagnostics", "generated")
release_dir <- file.path(repo_root, "data", "releases")
@@ -52,6 +54,11 @@ read_if_exists <- function(path) {
readr::read_csv(path, show_col_types = FALSE)
}
review_file <- function(...) {
path <- file.path(review_package_dir, ...)
if (file.exists(path)) path else NA_character_
}
public_dimension <- function(x) {
dplyr::recode(as.character(x),
economic_lr = "economic left-right",
@@ -218,6 +225,16 @@ construct_family_positions <- read_if_exists(construct_families_file) %>%
construct_temporal_stability <- read_if_exists(construct_unstable_file) %>%
mutate(dimension = public_dimension(dimension), source_file = construct_unstable_file) %>%
arrange(desc(annual_change))
source_composition_balance <- read_if_exists(review_file("validation", "source_composition_balance.csv")) %>%
mutate(dimension = public_dimension(dimension))
robustness_sensitivity <- read_if_exists(review_file("validation", "table10_sensitivity.csv")) %>%
mutate(
dimension = public_dimension(dimension),
across(everything(), ~ na_if(as.character(.x), "[INSERT VALUE]"))
) %>%
select(specification, ablated_source, dimension, matched_n, correlation_with_production,
mean_abs_difference, median_abs_difference, p95_abs_difference,
mean_interval_width_production, mean_interval_width_ablation)
posterior_uncertainty <- positions %>%
summarise(
@@ -247,6 +264,8 @@ write_csv(uncertainty_summary, file.path(generated_dir, "posterior_validation_un
write_csv(external_validation_correlations, file.path(generated_dir, "external_validation_correlations.csv"))
write_csv(construct_family_positions, file.path(generated_dir, "construct_family_positions.csv"))
write_csv(construct_temporal_stability, file.path(generated_dir, "construct_temporal_stability_flags.csv"))
write_csv(source_composition_balance, file.path(generated_dir, "source_composition_balance.csv"))
write_csv(robustness_sensitivity, file.path(generated_dir, "robustness_sensitivity.csv"))
write_csv(posterior_uncertainty, file.path(generated_dir, "posterior_uncertainty_summary.csv"))
item_counts <- item_rows %>% count(source_file, dimension, name = "items")
@@ -346,6 +365,18 @@ report_lines <- c(
"",
md_table(external_validation_correlations %>% select(-any_of("source_file")) %>% mutate(across(where(is.numeric), ~ round(.x, 3)))),
"",
"## Evidence-composition balance",
"",
"Evidence-composition balance checks whether estimates informed by different nearby source combinations are systematically shifted relative to rows with both text and expert evidence. The reported differences are adjusted differences on the unit scale relative to the overlapping text-and-expert reference category.",
"",
md_table(source_composition_balance),
"",
"## Robustness and sensitivity checks",
"",
"Sensitivity checks compare the released election-year estimates with source-ablation, segmentation-threshold, and item-screening variants where available. Correlations near one and small absolute differences indicate that the released estimates are stable to the corresponding design choice.",
"",
md_table(robustness_sensitivity),
"",
"## Generated tables",
"",
paste0("- `", list.files(generated_dir, pattern = "\\.csv$"), "`"),
@@ -370,15 +401,24 @@ pdf_lines <- c(
" - \\usepackage{booktabs}",
" - \\usepackage{longtable}",
" - \\usepackage{array}",
" - \\usepackage{pdflscape}",
" - \\setlength{\\tabcolsep}{4pt}",
" - \\renewcommand{\\arraystretch}{1.12}",
"---",
"",
"```{r setup, include=FALSE}",
"knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)",
"print_table <- function(x, n = Inf) {",
"print_table <- function(x, n = Inf, size = 'footnotesize') {",
" if (nrow(x) == 0) { cat('No rows available.\\n'); return(invisible(NULL)) }",
" x <- head(x, n)",
" print(knitr::kable(x, format = 'latex', booktabs = TRUE, longtable = TRUE, digits = 3))",
" x <- mutate(x, across(everything(), as.character))",
" x[is.na(x)] <- ''",
" names(x) <- gsub('_', ' ', names(x), fixed = TRUE)",
" cat(paste0(\"\\n\\\\begingroup\\\\\", size, \"\\n\"))",
" print(knitr::kable(x, format = 'latex', booktabs = TRUE, longtable = FALSE, digits = 3))",
" cat(\"\\n\\\\endgroup\\n\")",
"}",
"short_dim <- function(x) dplyr::recode(as.character(x), 'cultural cosmopolitan--traditionalist' = 'cultural', 'economic left-right' = 'economic', .default = as.character(x))",
"```",
"",
paste0("Generated: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S %Z")),
@@ -400,15 +440,17 @@ pdf_lines <- c(
"The model combines text-coded item counts, dimension-specific expert placements, and general left-right expert placements. Text items enter as positive/sample counts, expert items enter as aggregated ratings with scale and expert-count information, and general left-right ratings anchor the relationship between the two dimensions.",
"",
"```{r item-counts, results='asis'}",
"print_table(item_counts)",
"print_table(item_counts %>% mutate(dimension = short_dim(dimension)))",
"```",
"",
"## Source coverage",
"",
"```{r source-coverage, results='asis'}",
"print_table(source_counts)",
"print_table(source_counts %>% transmute(file = recode(source_file, text_data.csv = 'text', expert.csv = 'expert', lr_data.csv = 'general LR'), source, items, obs = observations, party_years, parties, countries, years = paste0(min_year, '--', max_year)), size = 'scriptsize')",
"```",
"",
"Full item-level coverage and coding-orientation details are provided as generated CSV files listed at the end of this report.",
"",
"# Data coding and item orientation",
"",
"All indicators are oriented toward the two reported dimensions: economic left-right and cultural cosmopolitan--traditionalist. For interpretability, generated diagnostics report whether higher observed values point toward the public high pole or are reversed for reporting. Original source variable names are preserved in the tables.",
@@ -416,7 +458,7 @@ pdf_lines <- c(
"## Reversed items",
"",
"```{r reversed-items, results='asis'}",
"print_table(reversed_items)",
"print_table(reversed_items %>% count(source, dimension = short_dim(dimension), higher_values_indicate, name = 'items'))",
"```",
"",
"# Party unions and electoral coalitions",
@@ -424,7 +466,7 @@ pdf_lines <- c(
"Alliance and union labels are handled through constituent mappings so the released party identifiers represent individual parties. Shared text evidence can inform constituent parties through the union mapping while expert data continue to constrain individual parties directly.",
"",
"```{r union-summary, results='asis'}",
"print_table(alliance_union_harmonization, n = 40)",
"print_table(alliance_union_harmonization %>% transmute(metric, category, value), n = 40)",
"```",
"",
"# Party-family and construct coverage",
@@ -432,7 +474,7 @@ pdf_lines <- c(
"Party-family classifications are used for construct-validity diagnostics and coverage summaries. The table below reports coverage in the completed model output by family code.",
"",
"```{r family-coverage, results='asis'}",
"print_table(party_family_coverage)",
"print_table(party_family_coverage %>% transmute(family, parties, party_years, countries, years = paste0(min_year, '--', max_year)))",
"```",
"",
"## Construct-validity family means",
@@ -440,7 +482,7 @@ pdf_lines <- c(
"Substantive party-family means provide a construct-validity check: families should follow the expected ordering on the economic left-right and cultural cosmopolitan--traditionalist dimensions.",
"",
"```{r construct-family, results='asis'}",
"print_table(construct_family_positions %>% select(family_name, n_parties, n_obs, mean_economic, sd_economic, mean_cultural, sd_cultural) %>% mutate(across(where(is.numeric), ~ round(.x, 3))))",
"print_table(construct_family_positions %>% transmute(family = family_name, parties = n_parties, obs = n_obs, econ_mean = round(mean_economic, 3), econ_sd = round(sd_economic, 3), cult_mean = round(mean_cultural, 3), cult_sd = round(sd_cultural, 3)), size = 'scriptsize')",
"```",
"",
"## Temporal-stability flags",
@@ -448,7 +490,7 @@ pdf_lines <- c(
"The model permits movement through random walks, but unusually large one-year changes are flagged for inspection rather than treated as automatic errors.",
"",
"```{r temporal-stability, results='asis'}",
"print_table(construct_temporal_stability %>% select(party_id, country, dimension, year_from, year_to, val_from, val_to, annual_change) %>% mutate(across(where(is.numeric), ~ round(.x, 3))), n = 20)",
"print_table(construct_temporal_stability %>% transmute(party = party_id, country, dim = short_dim(dimension), from = year_from, to = year_to, start = round(val_from, 3), end = round(val_to, 3), annual_change = round(annual_change, 3)), n = 12, size = 'scriptsize')",
"```",
"",
"# Model convergence diagnostics",
@@ -462,7 +504,7 @@ pdf_lines <- c(
"## Convergence by parameter group",
"",
"```{r convergence-dim, results='asis'}",
"print_table(conv_dim_display)",
"print_table(conv_dim_display %>% mutate(dimension = short_dim(dimension)))",
"```",
"",
"# Posterior uncertainty",
@@ -470,7 +512,7 @@ pdf_lines <- c(
"The completed party-position output reports posterior standard errors and interval endpoints for both dimensions. These summaries describe the typical uncertainty in the release file used by the report.",
"",
"```{r posterior-uncertainty, results='asis'}",
"print_table(posterior_uncertainty %>% mutate(across(where(is.numeric), ~ round(.x, 3))))",
"print_table(posterior_uncertainty %>% transmute(rows, parties, countries, years = paste0(min_year, '--', max_year), mean_econ_se = round(mean_economic_se, 3), median_econ_se = round(median_economic_se, 3), mean_cult_se = round(mean_cultural_se, 3), median_cult_se = round(median_cultural_se, 3)), size = 'scriptsize')",
"```",
"",
"# Validation diagnostics",
@@ -478,19 +520,35 @@ pdf_lines <- c(
"The validation diagnostics combine convergent and discriminant comparisons with expert surveys, posterior predictive coverage, construct checks, and out-of-sample validation when the corresponding outputs are available.",
"",
"```{r validation-summary, results='asis'}",
"print_table(val_display)",
"print_table(val_display %>% mutate(dimension = short_dim(dimension)), size = 'scriptsize')",
"```",
"",
"## Discriminant validity",
"",
"```{r discriminant, results='asis'}",
"print_table(discriminant_summary %>% select(-any_of('source_file')) %>% mutate(across(where(is.numeric), ~ round(.x, 3))))",
"print_table(discriminant_summary %>% transmute(type, model = short_dim(model_dim), expert = expert_dim, n, pearson = round(r_pearson, 3), spearman = round(r_spearman, 3)))",
"```",
"",
"## External validation correlations",
"",
"```{r external-validation, results='asis'}",
"print_table(external_validation_correlations %>% select(-any_of('source_file')) %>% mutate(across(where(is.numeric), ~ round(.x, 3))))",
"print_table(external_validation_correlations %>% transmute(item = var, dim = short_dim(dimension), n, r = round(pearson_r, 3), mae = round(mean_absolute_error, 3), coverage = round(coverage_95, 3)))",
"```",
"",
"# Evidence-composition balance",
"",
"Evidence-composition balance checks whether estimates informed by different nearby source combinations are systematically shifted relative to rows with both text and expert evidence. The reported differences are adjusted differences on the unit scale relative to the overlapping text-and-expert reference category.",
"",
"```{r source-balance, results='asis'}",
"print_table(source_composition_balance %>% transmute(dim = short_dim(dimension), evidence = recode(source_composition_class, both_direct_or_nearby = 'both', text_only_direct_or_nearby = 'text only', expert_only_direct_or_nearby = 'expert only', temporal_propagation = 'temporal'), ref = recode(reference_class, both_direct_or_nearby = 'both'), n, adj_diff = round(adjusted_difference, 3)))",
"```",
"",
"# Robustness and sensitivity checks",
"",
"Sensitivity checks compare the released election-year estimates with source-ablation, segmentation-threshold, and item-screening variants where available. Correlations near one and small absolute differences indicate that the released estimates are stable to the corresponding design choice.",
"",
"```{r robustness-sensitivity, results='asis'}",
"print_table(robustness_sensitivity %>% transmute(spec = specification, source = ablated_source, dim = short_dim(dimension), n = matched_n, r = round(as.numeric(correlation_with_production), 3), mean_abs = round(as.numeric(mean_abs_difference), 3), median_abs = round(as.numeric(median_abs_difference), 3), p95_abs = round(as.numeric(p95_abs_difference), 3)), size = 'scriptsize')",
"```",
"",
"# Generated tables",