Armin
180 lines
6.0 KiB
R
180 lines
6.0 KiB
R
#!/usr/bin/env Rscript
|
|
|
|
options(stringsAsFactors = FALSE)
|
|
|
|
if (!requireNamespace("ggplot2", quietly = TRUE)) {
|
|
stop("Required package not installed: ggplot2")
|
|
}
|
|
library(ggplot2)
|
|
|
|
script_args <- commandArgs(trailingOnly = FALSE)
|
|
file_arg <- script_args[grepl("^--file=", script_args)][1]
|
|
if (length(file_arg) && !is.na(file_arg)) {
|
|
script_path <- normalizePath(sub("^--file=", "", file_arg))
|
|
repo_root <- normalizePath(file.path(dirname(script_path), ".."))
|
|
} else if (!exists("repo_root")) {
|
|
repo_root <- normalizePath(".")
|
|
}
|
|
setwd(repo_root)
|
|
|
|
panel_file <- file.path("data", "releases", "party_2d_election_year_panel_v0.csv.gz")
|
|
output_dir <- file.path("validation", "outputs")
|
|
figure_dir <- file.path("validation", "figures")
|
|
|
|
if (!file.exists(panel_file)) stop("Required input not found: ", panel_file)
|
|
dir.create(output_dir, recursive = TRUE, showWarnings = FALSE)
|
|
dir.create(figure_dir, recursive = TRUE, showWarnings = FALSE)
|
|
|
|
panel <- read.csv(panel_file, check.names = FALSE)
|
|
|
|
trajectory_spec <- data.frame(
|
|
party_id = c(1691, 379, 432),
|
|
series = c("Fidesz", "Danish Social Democrats", "US Democrats"),
|
|
start_year = c(1990, 2007, 1944),
|
|
end_year = c(2022, 2019, 2020)
|
|
)
|
|
|
|
trajectory_rows <- lapply(seq_len(nrow(trajectory_spec)), function(i) {
|
|
spec <- trajectory_spec[i, ]
|
|
d <- panel[
|
|
panel$party_id == spec$party_id &
|
|
panel$year >= spec$start_year & panel$year <= spec$end_year,
|
|
]
|
|
if (!nrow(d)) stop("No trajectory rows found for PartyFacts ", spec$party_id)
|
|
d$series <- spec$series
|
|
d$display_role <- "trajectory"
|
|
d$is_labelled <- d$year %in% c(spec$start_year, spec$end_year)
|
|
d$label <- ifelse(d$is_labelled, paste(spec$series, d$year), "")
|
|
d[order(d$year), ]
|
|
})
|
|
trajectories <- do.call(rbind, trajectory_rows)
|
|
|
|
anchor_spec <- data.frame(
|
|
party_id = c(1545, 1375, 1565, 1567, 433, 809),
|
|
year = c(2021, 2021, 2019, 1979, 2022, 2020),
|
|
label = c(
|
|
"The Left 2021", "CDU 2021", "PiS 2019",
|
|
"UK Conservatives 1979", "French National Front 2022",
|
|
"US Republicans 2020"
|
|
)
|
|
)
|
|
|
|
anchors <- merge(anchor_spec, panel, by = c("party_id", "year"), all.x = TRUE, sort = FALSE)
|
|
if (anyNA(anchors$economic_lr) || anyNA(anchors$galtan)) {
|
|
stop("One or more declared scale anchors are absent from the release panel")
|
|
}
|
|
anchors$series <- "Standalone anchors"
|
|
anchors$display_role <- "anchor"
|
|
anchors$is_labelled <- TRUE
|
|
|
|
plot_columns <- c(
|
|
"party_id", "party_name_english", "country", "year", "series",
|
|
"display_role", "is_labelled", "label", "economic_lr",
|
|
"economic_lr_q025", "economic_lr_q975", "galtan", "galtan_q025",
|
|
"galtan_q975", "source_support_class"
|
|
)
|
|
plot_data <- rbind(trajectories[plot_columns], anchors[plot_columns])
|
|
write.csv(
|
|
plot_data,
|
|
file.path(output_dir, "party_scale_example_plot_data.csv"),
|
|
row.names = FALSE,
|
|
na = ""
|
|
)
|
|
|
|
labelled <- plot_data[plot_data$is_labelled, ]
|
|
label_positions <- data.frame(
|
|
label = c(
|
|
"Fidesz 1990", "Fidesz 2022",
|
|
"Danish Social Democrats 2007", "Danish Social Democrats 2019",
|
|
"US Democrats 1944", "US Democrats 2020",
|
|
"The Left 2021", "CDU 2021", "PiS 2019",
|
|
"UK Conservatives 1979", "French National Front 2022",
|
|
"US Republicans 2020"
|
|
),
|
|
plot_label = c(
|
|
"Fidesz\n1990", "Fidesz\n2022",
|
|
"Danish Social Democrats\n2007", "Danish Social Democrats\n2019",
|
|
"US Democrats\n1944", "US Democrats\n2020",
|
|
"The Left\n2021", "CDU\n2021", "PiS\n2019",
|
|
"UK Conservatives\n1979", "French National Front\n2022",
|
|
"US Republicans\n2020"
|
|
),
|
|
label_x = c(.84, .36, .12, .33, .73, .36, .11, .65, .14, .84, .58, .88),
|
|
label_y = c(.36, .93, .32, .49, .33, .27, .16, .48, .93, .51, .91, .78)
|
|
)
|
|
labelled <- merge(labelled, label_positions, by = "label", all.x = TRUE, sort = FALSE)
|
|
if (anyNA(labelled$label_x) || anyNA(labelled$label_y)) {
|
|
stop("Missing manual label position for a displayed scale example")
|
|
}
|
|
|
|
trajectory_levels <- trajectory_spec$series
|
|
trajectories$series <- factor(trajectories$series, levels = trajectory_levels)
|
|
|
|
p <- ggplot() +
|
|
geom_path(
|
|
data = trajectories,
|
|
aes(x = economic_lr, y = galtan, group = series, linetype = series),
|
|
colour = "grey25", linewidth = .7,
|
|
arrow = grid::arrow(type = "closed", length = grid::unit(.065, "inches"))
|
|
) +
|
|
geom_point(
|
|
data = trajectories,
|
|
aes(x = economic_lr, y = galtan),
|
|
colour = "grey35", size = 1.1
|
|
) +
|
|
geom_errorbar(
|
|
data = labelled,
|
|
aes(x = economic_lr, ymin = galtan_q025, ymax = galtan_q975),
|
|
width = 0, colour = "grey45", alpha = .65
|
|
) +
|
|
geom_errorbar(
|
|
data = labelled,
|
|
aes(y = galtan, xmin = economic_lr_q025, xmax = economic_lr_q975),
|
|
orientation = "y", width = 0, colour = "grey45", alpha = .65
|
|
) +
|
|
geom_point(
|
|
data = anchors,
|
|
aes(x = economic_lr, y = galtan),
|
|
shape = 21, fill = "white", colour = "black", size = 2.5, stroke = .7
|
|
) +
|
|
geom_point(
|
|
data = labelled[labelled$display_role == "trajectory", ],
|
|
aes(x = economic_lr, y = galtan),
|
|
shape = 16, colour = "black", size = 2.1
|
|
) +
|
|
geom_segment(
|
|
data = labelled,
|
|
aes(x = economic_lr, y = galtan, xend = label_x, yend = label_y),
|
|
colour = "grey55", linewidth = .25
|
|
) +
|
|
geom_text(
|
|
data = labelled,
|
|
aes(x = label_x, y = label_y, label = plot_label),
|
|
size = 2.6, lineheight = .9
|
|
) +
|
|
scale_linetype_manual(
|
|
values = c("Fidesz" = "solid", "Danish Social Democrats" = "dashed", "US Democrats" = "dotdash")
|
|
) +
|
|
scale_x_continuous(limits = c(0, 1), breaks = c(0, .25, .5, .75, 1)) +
|
|
scale_y_continuous(limits = c(0, 1), breaks = c(0, .25, .5, .75, 1)) +
|
|
labs(
|
|
x = "Economic: left (0) to right (1)",
|
|
y = "Cultural: cosmopolitan (0) to traditionalist (1)",
|
|
linetype = "Election-year path"
|
|
) +
|
|
theme_minimal(base_size = 9) +
|
|
theme(
|
|
panel.grid.minor = element_blank(),
|
|
legend.position = "bottom",
|
|
legend.title = element_text(face = "bold"),
|
|
plot.margin = margin(7, 12, 7, 7)
|
|
)
|
|
|
|
ggsave(
|
|
file.path(figure_dir, "party_scale_examples.pdf"),
|
|
p, width = 8.8, height = 6.0, device = cairo_pdf
|
|
)
|
|
|
|
message("Wrote validation/outputs/party_scale_example_plot_data.csv")
|
|
message("Wrote validation/figures/party_scale_examples.pdf")
|