Consolidate scale examples into one figure
This commit is contained in:
Armin
@@ -0,0 +1,179 @@
|
||||
#!/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")
|
||||
Reference in New Issue
Block a user