User:DimensionalFusion/Opinion poll chart
Here's the file setup I use for the opinion poll chart for the next UK general election, but can easily be modified to fit any graph. Based off this graph tool from User:Gbuvn, with modifications made to use automatic tools for sorting and small efficiency improvements, as well as working on MacOS unlike the original source file.
Installation guide is here
Filename: ggplot.r
Sys.setlocale("LC_TIME", "C")
library(ggplot2)
library(anytime)
library(tidyverse)
library(svglite)
library(Rcpp)
### ---------- Parameters ----------
# Election system parameters
partycolours <- c('#E4003B', '#0087DC', '#12B6CF', '#FAA61A', '#02A95B')
startdate <- as.Date('2024-07-04')
enddate <- as.Date('2029-08-15')
threshold <- 1 # Only used for systems which have a threshold system, eg Germany
# Figure parameters
partyspansize <- 4
transp <- '55'
nnum <- 500
limits <- c(0,39)
### ---------- Plotting Code ----------
polls <- read.table("PollData.csv", header=T, sep=",", fileEncoding="UTF-8", stringsAsFactor=F)
polls$polldate <- as.Date(anydate(polls$polldate))
partynames <- colnames(polls)[2:ncol(polls)]
polls_long <- polls %>%
pivot_longer(cols = -polldate, names_to = "party", values_to = "percentage")
# Ensure factors are ordered correctly to prevent ggplot from sorting alphabetically
polls_long$party <- factor(polls_long$party, levels = partynames)
# Ensure every party has a data point at `startdate`
polls_long <- polls_long %>%
group_by(party) %>%
mutate(has_startdate = any(polldate == startdate)) %>%
ungroup()
# If a party doesn't have polling data on startdate, use the earliest available point as a proxy
start_points <- polls_long %>%
group_by(party) %>%
filter(polldate == min(polldate)) %>%
mutate(polldate = startdate) %>% # Set it to startdate
ungroup()
# Adjust start points to original data
polls_long <- bind_rows(polls_long, start_points) %>%
arrange(party, polldate)
# Define named color mapping (ensures correct colors)
colour_mapping <- setNames(partycolours, partynames)
graph <- ggplot(polls_long, aes(x = polldate, y = percentage, color = party, fill = party)) +
geom_vline(xintercept = startdate, color = '#aaaaaabb') +
geom_vline(xintercept = enddate, color = '#aaaaaabb')
# Add threshold line if threshold > 0
if (threshold > 0) {
graph <- graph + geom_segment(
aes(x = startdate, xend = enddate, y = threshold, yend = threshold),
color = '#666666bb', linetype = 'dashed'
)
}
# Draw threshold if it exists
if (threshold > 0) {
geom_segment(aes(x=as.Date(startdate), xend=as.Date(enddate), y=threshold, yend=threshold), color='#666666bb', linetype='dashed') # horizontal line (election threshold 5%)
}
# Define ggplot
graph <- graph +
geom_vline(xintercept = startdate, color = '#aaaaaabb') +
geom_vline(xintercept = enddate, color = '#aaaaaabb') +
# Add Diamond shapes for Start and End Date
geom_point(aes(shape = factor(polldate %in% c(startdate, enddate))),
size = ifelse(polls_long$polldate %in% c(startdate, enddate), 4, 1.5),
color = paste0(colour_mapping[polls_long$party], transp),
fill = paste0(colour_mapping[polls_long$party], transp)) +
scale_shape_manual(values = c("FALSE" = 21, "TRUE" = 23), guide = "none") + # Circle for normal, diamond for election dates
# Ensure trend lines start at the diamond
geom_smooth(method = "loess", span = partyspansize, se = FALSE) +
scale_y_continuous(labels = function(x) paste0(x, "%"), limits = limits) +
scale_x_date(limits = c(startdate, enddate),
date_minor_breaks = "1 months",
date_breaks = "3 months",
date_labels = "%b %Y") +
scale_color_manual(name = "", values = colour_mapping) + # Correct colour assignment
scale_fill_manual(values = colour_mapping, guide = "none") + # Ensure fill matches colour
labs(x = "", y = "") +
theme(
axis.text.x = element_text(size = 11),
axis.text.y = element_text(size = 12),
axis.title.y = element_text(size = 16),
legend.position = "right",
legend.key.width = unit(24, "pt"),
legend.key.height = unit(24, "pt"),
legend.text = element_text(size = 16, margin = margin(b = 5, t = 5, unit = "pt"))
)
# Save the plot
ggsave(file="polls.svg", plot=graph, width=18, height=8)
# Workaround since svglite doesn't properly work in Wikipedia
aaa = readLines("polls.svg", -1)
bbb <- gsub(".svglite ", "", aaa)
writeLines(bbb, "polls.svg")
# Workaround for a weird generation error
ccc <- gsub("id='(cp[^\"]*?)=='", "id='\\1'", aaa) # Fix the id
ccc <- gsub("clip-path='url\\(#(cp[^\"]*?)==\\)'", "clip-path='url(#\\1)'", ccc) # Fix references
writeLines(ccc, "polls.svg")
Filename: PollData.csv (DE.csv in the installation guide)
polldate,LAB,CON,RFM,LD,GRN
2025-06-16,20,17,30,13,12
2025-06-14,24,20,27,13,9
2025-07-14,22,17,28,16,12
2025-07-11,24,18,29,13,9
2025-07-10,22,18,29,16,9
2025-07-10,21,16,34,11,11
2025-07-09,22,19,31,13,9
2025-07-07,24,16,26,15,11
2025-07-07,24,19,29,14,7
2025-07-07,25,20,28,14,7
2025-07-06,23,19,31,16,6
2025-07-02,22,16,30,15,11
2025-06-30,24,19,29,12,9
2025-06-30,24,17,26,16,10
2025-06-27,26,19,27,12,8
2025-06-27,25,17,30,12,9
2025-06-26,23,18,28,16,8
2025-06-25,22,18,30,13,11
2025-06-25,27,19,30,12,7
2025-06-23,23,20,27,14,9
2025-06-23,23,17,27,16,10
2025-06-18,23,16,31,12,11
2025-06-16,24,17,27,15,10
2025-06-16,21,22,29,13,9
2025-06-13,24,18,30,12,9
2025-06-11,24,16,30,13,11
2025-06-09,24,20,28,14,7
2025-06-09,23,17,29,15,10
2025-06-08,21,21,32,14,8
2025-06-05,23,17,31,15,8
2025-06-04,22,16,31,15,11
2025-06-04,25,15,34,11,9
2025-06-02,23,21,28,14,8
2025-06-02,22,18,28,17,9
2025-06-02,23,18,27,13,13
2025-06-02,24,20,27,13,8
2025-05-30,25,17,31,11,10
2025-05-29,22,16,31,16,9
2025-05-29,24,18,31,13,9
2025-05-28,22,16,32,13,11
2025-05-27,21,19,29,15,11
2025-05-26,22,19,31,14,8
2025-05-22,22,17,30,16,9
2025-05-21,21,16,32,14,11
2025-05-19,22,16,29,17,10
2025-05-16,22,21,30,14,8
2025-05-16,25,18,29,13,10
2025-05-15,22,18,29,15,9
2025-05-14,21,16,33,14,11
2025-05-12,23,18,28,16,9
2025-05-12,25,20,28,14,8
2025-05-11,22,19,32,15,8
2025-05-08,23,19,28,14,8
2025-05-08,23,19,28,14,8
2025-05-07,20,16,33,15,11
2025-05-06,22,17,29,16,10
2025-05-05,25,18,30,13,7
2025-05-04,23,21,27,15,8
2025-05-02,26,19,27,13,9
2025-05-02,26,22,26,12,7
2025-04-30,21,19,29,13,11
2025-04-28,23,20,26,15,9
2025-04-27,24,23,24,15,8
2025-04-25,26,21,26,11,9
2025-04-24,25,21,25,14,8
2025-04-23,20,20,28,14,13
2025-04-22,23,20,25,16,10
2025-04-21,23,23,25,14,8
2025-04-16,22,20,28,14,10
2025-04-14,24,21,23,14,11
2025-04-14,24,23,24,14,8
2025-04-14,24,24,23,13,9
2025-04-11,27,22,26,12,7
2025-04-10,24,22,24,15,8
2025-04-09,22,21,26,14,11
2025-04-07,24,23,24,17,7
2025-04-07,24,22,23,17,9
2025-04-03,24,23,24,13,8
2025-04-02,22,20,28,13,11
2025-03-31,24,21,23,14,11
2025-03-31,21,26,25,13,7
2025-03-26,26,22,26,12,8
2025-03-27,26,24,23,14,8
2025-03-27,25,23,24,14,8
2025-03-26,23,22,26,12,11
2025-03-24,23,22,22,16,10
2025-03-22,24,25,24,12,10
2025-03-21,26,21,26,13,8
2025-03-20,27,23,23,14,7
2025-03-19,22,21,27,14,11
2025-03-14,25,25,23,11,9
2025-03-14,25,24,25,12,7
2025-03-17,26,22,24,14,9
2025-03-13,27,22,24,14,7
2025-03-12,24,21,27,11,10
2025-03-10,25,23,25,14,8
2025-03-10,24,22,23,15,9
2025-03-09,26,24,23,14,7
2025-03-07,28,20,27,12,8
2025-03-06,28,21,25,13,7
2025-03-05,25,21,26,12,10
2025-03-03,26,21,25,14,9
2025-03-03,24,23,27,15,7
2025-03-02,26,24,24,13,7
2025-02-27,26,22,25,13,8
2025-02-26,23,21,28,13,10
2025-02-26,26,22,27,12,8
2025-02-24,24,22,25,16,8
2025-02-24,23,25,24,16,8
2025-02-21,28,21,26,12,8
2025-02-20,25,22,26,12,7
2025-02-19,24,20,28,12,10
2025-02-18,25,23,26,12,7
2025-02-17,25,21,27,14,9
2025-02-17,28,23,23,9,11
2025-02-13,26,22,25,12,8
2025-02-12,23,21,29,12,9
2025-02-10,25,23,25,12,8
2025-02-10,25,21,26,14,9
2025-02-07,27,22,26,11,8
2025-02-06,25,23,25,13,7
2025-02-05,25,18,29,13,10
2025-02-03,24,21,25,14,9
2025-02-03,24,26,24,13,6
2025-01-30,26,23,24,12,7
2025-01-30,23,21,27,11,10
2025-01-29,25,25,24,14,8
2025-01-29,27,22,24,13,8
2025-01-27,27,22,23,14,9
2025-01-27,25,24,25,13,7
2025-01-29,23,23,24,11,8
2025-01-24,28,21,27,11,8
2025-01-23,25,20,24,12,13
2025-01-23,25,24,24,13,7
2025-01-22,22,23,26,12,10
2025-01-19,26,22,24,14,9
2025-01-17,24,25,25,12,7
2025-01-20,29,25,22,11,8
2025-01-16,26,25,23,12,7
2025-01-15,24,25,25,12,10
2025-01-14,26,25,22,13,9
2025-01-13,26,22,25,14,8
2025-01-13,24,25,24,12,8
2025-01-10,29,23,24,10,9
2025-01-08,25,20,25,11,11
2025-01-08,26,26,22,12,7
2025-01-03,30,23,22,12,9
2024-12-23,29,25,21,12,8
2024-12-18,29,23,22,11,10
2024-12-19,27,26,21,12,7
2024-12-12,27,25,22,11,7
2024-12-11,26,23,25,11,9
2024-12-10,26,26,19,13,8
2024-12-06,27,25,21,12,7
2024-12-04,23,26,24,11,9
2024-12-02,26,28,21,13,7
2024-11-29,29,25,21,10,9
2024-11-28,28,27,18,13,6
2024-11-27,25,27,22,12,9
2024-11-27,29,27,20,12,7
2024-11-27,27,30,18,12,8
2024-11-21,29,27,17,12,7
2024-11-21,25,28,19,13,8
2024-11-18,29,27,18,12,8
2024-11-14,27,26,20,12,9
2024-11-14,28,27,17,13,7
2024-11-13,30,24,21,12,8
2024-11-11,27,29,19,11,8
2024-11-07,29,25,18,13,7
2024-11-01,28,26,18,14,8
2024-10-31,31,24,20,10,10
2024-10-31,28,29,17,13,8
2024-10-31,30,24,18,14,7
2024-10-24,29,24,19,13,7
2024-10-18,31,24,20,12,8
2024-10-17,28,25,19,13,7
2024-10-13,29,25,19,14,7
2024-10-10,29,24,19,12,7
2024-10-10,27,27,21,13,7
2024-10-07,29,28,19,11,7
2024-10-07,29,25,18,14,8
2024-10-03,31,24,20,11,8
2024-10-03,30,25,20,13,7
2024-10-03,31,23,18,13,7
2024-09-26,32,22,18,13,7
2024-09-25,30,26,18,13,8
2024-09-19,33,21,18,13,7
2024-09-12,29,25,18,14,8
2024-08-29,30,26,19,12,8
2024-08-08,33,20,21,11,8
2024-08-07,33,24,18,12,8
2024-08-05,34,22,17,12,9
2024-07-26,36,22,17,11,7
2024-07-12,39,20,16,11,9
2024-07-04,34,24,14,12,7