Consolidate scale examples into one figure

2026-08-14 12:23:28 +00:00
parent 9677612a19
commit 1909da3720
11 changed files with 257 additions and 276 deletions
@@ -290,90 +290,10 @@ ggsave(file.path(figure_dir, "vparty_sensitivity_countries.pdf"), p_vparty,
       width = 7.2, height = 5.8, device = cairo_pdf)

 # ---------------------------------------------------------------------------
-# Illustrative trajectories and landmark cases
+# Historically anchored scale examples
 # ---------------------------------------------------------------------------

-trajectory_ids <- c(383, 1567, 379, 409)
-traj <- panel[panel$party_id %in% trajectory_ids, ]
-traj$party_label <- factor(traj$party_id, levels = trajectory_ids,
-  labels = c("Germany: Social Democrats", "United Kingdom: Conservatives", "Denmark: Social Democrats", "Sweden: Sweden Democrats"))
-traj_long <- rbind(
-  data.frame(traj[c("party_id","party_label","country","year","source_support_class")],
-             dimension="Economic", estimate=traj$economic_lr,
-             lower=traj$economic_lr_q025, upper=traj$economic_lr_q975),
-  data.frame(traj[c("party_id","party_label","country","year","source_support_class")],
-             dimension="Cultural", estimate=traj$galtan,
-             lower=traj$galtan_q025, upper=traj$galtan_q975)
-)
-write_clean_csv(traj_long, file.path(output_dir, "party_trajectory_plot_data.csv"))
-p_traj <- ggplot(traj_long, aes(x = year, y = estimate)) +
-  geom_ribbon(aes(ymin = lower, ymax = upper), fill = "grey85", alpha = 0.5) +
-  geom_line(colour = "black", linewidth = .65) +
-  geom_point(colour = "black", size = .9) +
-  facet_grid(dimension ~ party_label) +
-  scale_y_continuous(limits = c(0, 1), breaks = c(0, .5, 1)) +
-  labs(x = "Election year", y = "Posterior position (0–1)") +
-  theme_revision() +
-  theme(axis.text.x = element_text(angle = 45, hjust = 1))
-ggsave(file.path(figure_dir, "party_trajectories.pdf"), p_traj,
-       width = 10.2, height = 4.9, device = cairo_pdf)
-
-landmark_spec <- data.frame(
-  party_id = c(383,383,1375,1375,1516,1516,1567,1567,487,487,409,409,433,433,1545,432,809),
-  target_year = c(1972,2021,1983,2021,1983,1997,1979,2019,1994,2022,2010,2022,1988,2022,2021,2020,2020),
-  label = c("German Social Democrats 1972","German Social Democrats 2021","German Christian Democrats 1983","German Christian Democrats 2021","Labour 1983","Labour 1997",
-            "Conservatives 1979","Conservatives 2019","Swedish Social Democrats 1994","Swedish Social Democrats 2022",
-            "Sweden Democrats 2010","Sweden Democrats 2022","French National Front 1988","French National Front 2022",
-            "The Left 2021","US Democrats 2020","US Republicans 2020")
-)
-
-landmark_rows <- lapply(seq_len(nrow(landmark_spec)), function(i) {
-  spec <- landmark_spec[i, ]
-  d <- panel[panel$party_id == spec$party_id & abs(panel$year - spec$target_year) <= 3, ]
-  if (!nrow(d)) return(data.frame(spec, status="missing", actual_year=NA, economic_lr=NA, galtan=NA))
-  d <- d[which.min(abs(d$year - spec$target_year)), ]
-  data.frame(spec, status=ifelse(d$year == spec$target_year, "exact", "nearest within 3 years"),
-             actual_year=d$year, party_name=d$party_name_english,
-             country=d$country, economic_lr=d$economic_lr, economic_lower=d$economic_lr_q025,
-             economic_upper=d$economic_lr_q975, galtan=d$galtan,
-             galtan_lower=d$galtan_q025, galtan_upper=d$galtan_q975,
-             source_support_class=d$source_support_class)
-})
-landmarks <- do.call(rbind, landmark_rows)
-landmarks$era <- ifelse(landmarks$target_year < 2000, "Historical & Cold War Era (1970–1999)", "Contemporary Era (2000–2022)")
-landmarks$era <- factor(landmarks$era, levels = c("Historical & Cold War Era (1970–1999)", "Contemporary Era (2000–2022)"))
-
-write_clean_csv(landmarks, file.path(output_dir, "party_landmark_plot_data.csv"))
-plot_landmarks <- landmarks[!is.na(landmarks$economic_lr), ]
-
-label_offsets <- data.frame(
-  label = landmark_spec$label,
-  dx = c(-.060,-.060,-.055,.045,-.040,-.060,.035,-.055,-.005,.080,-.060,.060,.030,-.030,.035,.080,.025),
-  dy = c(.070,.040,.055,-.035,-.070,-.040,-.025,.030,.040,.060,-.035,.035,.035,.050,.035,-.060,.035)
-)
-plot_landmarks <- merge(plot_landmarks, label_offsets, by = "label", all.x = TRUE, sort = FALSE)
-plot_landmarks$label_x <- pmin(.98, pmax(.02, plot_landmarks$economic_lr + plot_landmarks$dx))
-plot_landmarks$label_y <- pmin(.98, pmax(.02, plot_landmarks$galtan + plot_landmarks$dy))
-
-# Country shapes for clear grayscale distinction
-country_shapes <- c(DE = 16, GB = 17, SE = 15, FR = 18, US = 8)
-
-p_land <- ggplot(plot_landmarks, aes(x = economic_lr, y = galtan)) +
-  geom_errorbar(aes(ymin = galtan_lower, ymax = galtan_upper), width = 0, alpha = .35, colour = "grey30") +
-  geom_errorbar(aes(xmin = economic_lower, xmax = economic_upper), orientation = "y", width = 0, alpha = .35, colour = "grey30") +
-  geom_segment(aes(xend = label_x, yend = label_y), linewidth = .2, colour = "grey50") +
-  geom_point(aes(shape = country), size = 2.2, fill = "black", colour = "black") +
-  geom_text(aes(x = label_x, y = label_y, label = label), size = 2.4,
-            check_overlap = TRUE, show.legend = FALSE) +
-  facet_wrap(~era, ncol = 2) +
-  scale_shape_manual(values = country_shapes) +
-  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)", shape = "Country") +
-  theme_revision()
-ggsave(file.path(figure_dir, "party_landmarks.pdf"), p_land,
-       width = 9.2, height = 5.2, device = cairo_pdf)
+source(file.path("validation", "plot_scale_examples.R"), local = TRUE)

 # ---------------------------------------------------------------------------
 # Predictive-interval calibration and concentration of misses