| DescriptionOpinion polling for the 1999 Russian legislative election.svg |
English: Opinion polling for the 2016 Russian legislative election using local regressions (LOESS)
| ggplot.R
|
Sys.setlocale("LC_TIME", "English")
library(ggplot2)
library(anytime)
library(tidyverse)
library(svglite)
library(Rcpp)
polls <- read.table("DE.csv", header=T, sep=",", fileEncoding="UTF-8", stringsAsFactor=F)
polls$polldate <- as.Date(anydate(polls$polldate))
spansize <- 0.5 # general smoothing parameter for trend line
nnum <- 600 # number of points used for trendline (resolution)
startdate <- '1995-12-17' # date of previous election
enddate <- '1999-12-19' # (latest) date of next election
# retrieve party names from CSV
party1 <- colnames(polls)[2]
party2 <- colnames(polls)[3]
party3 <- colnames(polls)[4]
party4 <- colnames(polls)[5]
party5 <- colnames(polls)[6]
party6 <- colnames(polls)[7]
party7 <- colnames(polls)[8]
party8 <- colnames(polls)[9]
party9 <- colnames(polls)[10]
party10 <- colnames(polls)[11]
# define party colors (taken from https://en.wikipedia.org/wiki/Category:Germany_political_party_colour_templates)
col1 <- '#CC1111'
col2 <- '#28166F'
col3 <- '#4488CC'
col4 <- '#00A23D'
col5 <- '#EED23C'
col6 <- '#5AB5CE'
col7 <- '#02AFFF'
col8 <- '#024A9E'
col9 <- '#867257'
col10 <- '#227FCF'
transp <-'55' # transparency level of points
graph <- ggplot(polls)+
geom_vline(xintercept = as.Date(startdate), color='#aaaaaabb')+ # vertical line (last election)
geom_vline(xintercept = as.Date(enddate), color='#aaaaaabb')+ # vertical line (next election)
geom_segment(aes(x=as.Date(startdate), xend=as.Date(enddate), y=5, yend=5), color='#666666bb', linetype='dashed')+ # horizontal line (election threshold 5%)
# add poll points
geom_point(aes_string(x='polldate',y=party1),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col1,transp),fill=paste0(col1,transp))+
geom_point(aes_string(x='polldate',y=party2),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col2,transp),fill=paste0(col2,transp))+
geom_point(aes_string(x='polldate',y=party3),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col3,transp),fill=paste0(col3,transp))+
geom_point(aes_string(x='polldate',y=party4),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col4,transp),fill=paste0(col4,transp))+
geom_point(aes_string(x='polldate',y=party5),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col5,transp),fill=paste0(col5,transp))+
geom_point(aes_string(x='polldate',y=party6),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col6,transp),fill=paste0(col6,transp))+
geom_point(aes_string(x='polldate',y=party7),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col7,transp),fill=paste0(col7,transp))+
geom_point(aes_string(x='polldate',y=party8),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col8,transp),fill=paste0(col8,transp))+
geom_point(aes_string(x='polldate',y=party9),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col9,transp),fill=paste0(col9,transp))+
geom_point(aes_string(x='polldate',y=party10),size=ifelse(polls$polldate==startdate | polls$polldate==enddate,3,1.5),shape=ifelse(polls$polldate==startdate | polls$polldate==enddate,23,21),color=paste0(col10,transp),fill=paste0(col10,transp))+
# add trend lines
# the "span" (smoothing parameter) should be manually changed for individual parties that have less polling data
geom_smooth(aes_string(x='polldate',y=party1,color=shQuote('col1')),method="loess",span=spansize,n=nnum,se=FALSE)+
geom_smooth(aes_string(x='polldate',y=party2,color=shQuote('col2')),method="loess",span=spansize,n=nnum,se=FALSE)+
geom_smooth(aes_string(x='polldate',y=party3,color=shQuote('col3')),method="loess",span=spansize,n=nnum,se=FALSE)+
geom_smooth(aes_string(x='polldate',y=party4,color=shQuote('col4')),method="loess",span=spansize,n=nnum,se=FALSE)+
geom_smooth(aes_string(x='polldate',y=party5,color=shQuote('col5')),method="loess",span=spansize,n=nnum,se=FALSE)+
geom_smooth(aes_string(x='polldate',y=party6,color=shQuote('col6')),method="loess",span=spansize,n=nnum,se=FALSE)+
geom_smooth(aes_string(x='polldate',y=party7,color=shQuote('col7')),method="loess",span=spansize,n=nnum,se=FALSE)+
geom_smooth(aes_string(x='polldate',y=party8,color=shQuote('col8')),method="loess",span=spansize,n=nnum,se=FALSE)+
geom_smooth(aes_string(x='polldate',y=party9,color=shQuote('col9')),method="loess",span=spansize,n=nnum,se=FALSE)+
geom_smooth(aes_string(x='polldate',y=party10,color=shQuote('col10')),method="loess",span=1,n=nnum,se=FALSE)+
scale_y_continuous(labels = function(x) paste0(x, "%"),limits=c(0,34))+ # add %, manual limits on y-axis
scale_x_date(limits = as.Date(c(startdate,enddate)), date_minor_breaks = "1 months", date_breaks = "3 months", date_labels = "%b %Y")+ # grid: 1 month, labels: 3 months
labs(x = "", y = "")+
scale_color_manual(name="",
breaks = c('col1','col2','col3','col4','col5','col6','col7','col8','col9','col10'),
labels = c(party1,party2,party3,party4,party5,party6,party7,party8,party9,party10),
values = c('col1'=col1,'col2'=col2,'col3'=col3,'col4'=col4,'col5'=col5,'col6'=col6,'col7'=col7,'col8'=col8,'col9'=col9,'col10'=col10))+
# legend appearance
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")))
graph + theme()
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")
|
| DE.csv
|
polldate,KPRF,NDR,LDPR,Yabloko,APR,ZhR,OVR,SPS,NRPR,Unity
1999-12-19,24.29,1.19,5.98,5.93,,2.04,13.33,8.52,,23.32
1995-12-17,22.30,10.13,11.18,6.89,3.78,4.61,,,,
1999-12-12,17,,5,7,,,9,7,,17
1999-12-12,20.8,,4.4,9,,,11.6,6.5,,14.7
1999-12-12,21,1,5,7,,,10,5,,16
1999-12-12,24,,4,8,,,12,7,,21
1999-11-18,29,5,6,7,,,17,5,,9
1999-11-21,21,1,4,8,,4,11,5,,8
1999-11-14,22,2,4,8,,3,14,4,,9
1999-11-07,20,3,4,9,,3,16,4,,8
1999-10-31,20,2,4,10,,3,17,3,,7
1999-10-10,30,5,7,19,,,25,,,
1999-09-19,21,2,3,10,1,3,29,2,4,
1999-09-05,20,1,5,12,1,2,23,2,4,
1999-08-22,21,1,5,8,2,2,27,3,4,
1999-07-25,23,2,6,11,2,3,15,6,5,
1999-07-15,22.5,3.9,4.7,13.5,1.4,,13,0.1,2.6,
1999-06-26,22,2,6,11,2,3,15,4,5,
1999-06-15,21.9,3.7,4.9,12.2,1.2,,17.2,0.2,7.6,
1999-05-30,24,2,7,13,1,4,16,3,5,
1999-05-15,23.6,3.2,5.4,13.4,0.7,,13.5,0.1,4,
1999-04-25,23,3,5,15,2,,13,3,4,
1999-04-15,23.4,3.4,6.6,15.7,2.6,,11.3,0.3,6.1,
1999-03-28,24,2,5,14,2,5,13,2,5,
1999-03-15,25.5,2.2,5.2,13.7,1.2,,9.6,0.1,4.4,
1999-02-28,26,2,4,11,3,5,16,3,5,
1999-02-15,23.1,2.3,4.7,11.9,1,,11.9,1,5,
1999-01-31,22,2,5,15,2,2,15,3,7,
1999-01-15,22.8,2.5,3.7,13.3,1,,13.6,0.9,4.5,
1998-12-09,11,1,2,13,2,3,10,1,7,
1998-11-15,25.1,3.6,3.5,12.7,1.8,,,1.1,8.3,
1998-11-01,23,3,4,13,1,3,9,1,11,
1998-08-30,26,8,5,11,1,3,,1,10,
1998-04-19,23,8,5,13,1,4,,1,5,
1999-11-15,29,1,4,9,,2,11,6,,8
1999-11-09,27,1,3,9,,3,14,5,,7
1999-11-01,28,2,4,11,,3,14,4,,4
1999-10-15,26,2,3,11,,3,21,4,,5
1999-09-15,32,4,4,12,,2,22,4,,
1999-08-15,31,4,5,10,,3,16,2,,
1999-07-15,34,3,5,11,,2,16,3,,
1998-12-22,21,2,3,12,,,10,,,
| |
