Skip to content

Instantly share code, notes, and snippets.

@psobczyk
Created August 16, 2018 08:40
Show Gist options
  • Save psobczyk/d71a0188129be8a8a400f807854f8117 to your computer and use it in GitHub Desktop.
Save psobczyk/d71a0188129be8a8a400f807854f8117 to your computer and use it in GitHub Desktop.
require(dplyr)
require(magrittr)
require(tidyr)
require(broom)
require(ggplot2)
require(ggthemes)
dane <- read.csv2('dane/Sheet 1-Table 1.csv', stringsAsFactors = F)
glimpse(dane)
remove_space_to_numeric <- function(x){
as.numeric(gsub('[[:blank:]]', '', x))
}
dane %<>%
mutate_at(vars(Ogółem:PSL), funs(remove_space_to_numeric)) %>%
filter(!is.na(Ogółem)) %>%
gather(partia, poparcie, PIS:PSL) %>%
rename(ogolem = Ogółem)
#ordynacja stara, zakładmy jednakową frekwencję we wszystkich województwach i strukturę wieku (dzieci do 18 roku)
#mandatów do zdobycia jest 51
ns <- 1:51
dane %>%
group_by(partia) %>%
summarise(glosy=sum(ogolem*poparcie/100)) %>%
group_by(partia) %>%
do(tidy(t(.$glosy/ns))) %>%
ungroup() %>%
gather(mandat, glosy, -partia) %>%
mutate(mandat = as.numeric(gsub('X', '', mandat))) %>%
top_n(51, glosy) %>%
arrange(desc(glosy)) %>%
group_by(partia) %>%
summarise(liczba_mandatow=max(mandat))
wyniki_stara_ordynacja <- dane %>%
filter(!partia %in% c('SLD', 'PSL')) %>%
group_by(partia) %>%
summarise(glosy=sum(ogolem*poparcie/100)) %>%
group_by(partia) %>%
do(tidy(t(.$glosy/ns))) %>%
ungroup() %>%
gather(mandat, glosy, -partia) %>%
mutate(mandat = as.numeric(gsub('X', '', mandat))) %>%
top_n(51, glosy) %>%
arrange(desc(glosy)) %>%
group_by(partia) %>%
summarise(liczba_mandatow=max(mandat))
#nowa propozycja
nowe_okregi <- read.csv2('dane/Sheet 2-Table 1.csv', stringsAsFactors = F)
nowe_okregi
wyniki_nowa_ordynacja <- dane %>%
inner_join(nowe_okregi, by='Województwo') %>%
group_by(okreg, partia) %>%
summarize(glosy=sum(ogolem*poparcie/100),
mandaty_w_okregu = mandaty[1]) %>%
group_by(okreg, partia) %>%
do(tidy(t(.$glosy/(1:.$mandaty_w_okregu[1])))) %>%
ungroup() %>%
gather(mandat, glosy, -okreg, -partia) %>%
mutate(mandat = as.numeric(gsub('X', '', mandat))) %>%
filter(!is.na(glosy)) %>%
group_by(okreg) %>%
mutate(mandaty_w_okregu = max(mandat)) %>%
arrange(okreg, desc(glosy)) %>%
filter(row_number() <= mandaty_w_okregu) %>%
group_by(partia) %>%
summarise(liczba_mandatow=n())
# propozycja senatu
nowe_okregi_senat <- read.csv2('dane/Sheet 3-Table 1.csv', stringsAsFactors = F)
nowe_okregi_senat
dane %>%
inner_join(nowe_okregi_senat, by='Województwo') %>%
group_by(okreg, partia) %>%
summarize(glosy=sum(ogolem*poparcie/100),
mandaty_w_okregu = mandaty[1]) %>%
group_by(okreg, partia) %>%
do(tidy(t(.$glosy/(1:.$mandaty_w_okregu[1])))) %>%
ungroup() %>%
gather(mandat, glosy, -okreg, -partia) %>%
mutate(mandat = as.numeric(gsub('X', '', mandat))) %>%
filter(!is.na(glosy)) %>%
group_by(okreg) %>%
mutate(mandaty_w_okregu = max(mandat)) %>%
arrange(okreg, desc(glosy)) %>%
filter(row_number() <= mandaty_w_okregu) %>%
group_by(partia) %>%
summarise(liczba_mandatow=n())
wyniki_nowa_ordynacja_senat <- dane %>%
filter(!partia %in% c('SLD', 'PSL')) %>%
inner_join(nowe_okregi_senat, by='Województwo') %>%
group_by(okreg, partia) %>%
summarize(glosy=sum(ogolem*poparcie/100),
mandaty_w_okregu = mandaty[1]) %>%
group_by(okreg, partia) %>%
do(tidy(t(.$glosy/(1:.$mandaty_w_okregu[1])))) %>%
ungroup() %>%
gather(mandat, glosy, -okreg, -partia) %>%
mutate(mandat = as.numeric(gsub('X', '', mandat))) %>%
filter(!is.na(glosy)) %>%
group_by(okreg) %>%
mutate(mandaty_w_okregu = max(mandat)) %>%
arrange(okreg, desc(glosy)) %>%
filter(row_number() <= mandaty_w_okregu) %>%
group_by(partia) %>%
summarise(liczba_mandatow=n())
#plot
wszystkie_propozycje <- mutate(wyniki_nowa_ordynacja, propozycja='Propozycja Sejmu') %>%
bind_rows(mutate(wyniki_nowa_ordynacja_senat, propozycja='Propozycja Biura\nLegislacyjnego Senatu')) %>%
rbind(mutate(wyniki_stara_ordynacja, propozycja='Obecna ordynacja')) %>%
mutate(partia = as.factor(partia))
ggplot(data = wszystkie_propozycje) +
geom_bar(mapping = aes(x=reorder(partia, liczba_mandatow), y=liczba_mandatow, fill=partia), stat='identity') +
facet_wrap(~propozycja) +
scale_fill_viridis_d() +
theme_fivethirtyeight(base_size = 21, base_family = 'Helvetica Neue Light') +
labs(title = 'Podział mandatów w wyborach do Parlamentu Europejskiego',
caption = '@szychtawdanych, dane: www.cbos.pl/SPISKOM.POL/2018/K_007_18.PDF',
y = 'Zdobyte mandaty',
fill = NULL) +
theme(axis.title = element_text(inherit.blank = FALSE),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
panel.grid.major.x = element_blank(),
plot.title = element_text(hjust = 0.85))
ggsave('symulacja_wynikow.png', width = 12, height =6)
# lie factor
proporcje <- dane %>%
filter(!partia %in% c('SLD', 'PSL')) %>%
group_by(partia) %>%
summarise(glosy=sum(ogolem*poparcie/100)) %>%
mutate(ratio = glosy/sum(glosy))
wszystkie_propozycje %>%
group_by(propozycja) %>%
mutate(mandaty_ratio = liczba_mandatow/sum(liczba_mandatow)) %>%
inner_join(proporcje) %>%
mutate(lie_factor = ratio/mandaty_ratio,
lie_factor2 = mandaty_ratio/ratio)
We can make this file beautiful and searchable if this error is corrected: No commas found in this CSV file in line 0.
Województwo;Ogółem;Mężczyźni;Kobiety;PIS;PO;Nowoczesna;Kukiz;SLD;PSL
MAZOWIECKIE;5 349 114;2 559 241;2 789 873;41.7;20.2;7.2;8.1;2.8;4.9
ŚLĄSKIE;4 570 849;2 204 972;2 365 877;37.4;20.0;6.1;10.1;4.3;1.8
WIELKOPOLSKIE;3 475 323;1 690 930;1 784 393;34.3;27.4;6.6;6.7;4.4;5.0
MAŁOPOLSKIE;3 372 618;1 636 707;1 735 911;50.1;12.0;4.3;6.8;3.0;1.7
DOLNOŚLĄSKIE;2 904 207;1 396 318;1 507 889;32.0;26.9;8.4;10.3;7.0;3.3
ŁÓDZKIE;2 493 603;1 188 118;1 305 485;36.4;19.1;6.6;6.9;5.6;3.7
POMORSKIE;2 307 710;1 124 377;1 183 333;30.1;28.5;9.9;5.5;4.1;3.0
LUBELSKIE;2 139 726;1 037 052;1 102 674;45.3;13.2;4.6;7.2;3.2;8.0
PODKARPACKIE;2 127 657;1 041 779;1 085 878;53.5;14.3;3.2;8.5;2.3;4.7
KUJAWSKO-POMORSKIE;2 086 210;1 010 973;1 075 237;34.9;23.8;4.6;8.1;4.6;4.6
ZACHODNIOPOMORSKIE;1 710 482;832 293;878 189;38.5;26.9;6.5;5.4;7.3;3.5
WARMIŃSKO-MAZURSKIE;1 439 675;704 893;734 782;42.1;20.6;7.2;7.2;6.2;6.2
ŚWIĘTOKRZYSKIE;1 257 179;613 217;643 962;39.6;18.4;3.4;10.1;4.8;4.8
PODLASKIE;1 188 800;579 499;609 301;48.8;19.4;3.3;5.2;4.3;4.3
LUBUSKIE;1 018 075;495 674;522 401;29.1;22.0;7.8;12.1;6.4;5.0
OPOLSKIE;996 011;481 948;514 063;35.1;21.4;6.5;16.2;4.5;4.5
;;;;;;;;;
;;;;;;;;;
;;;;;;;;;
;;;;;;;;;
We can make this file beautiful and searchable if this error is corrected: No commas found in this CSV file in line 0.
Województwo;okreg;mandaty;;
MAZOWIECKIE;4;7;;
ŚLĄSKIE;11;6;;
WIELKOPOLSKIE;7;5;;
MAŁOPOLSKIE;10;6;;
DOLNOŚLĄSKIE;12;5;;
ŁÓDZKIE;6;3;;
POMORSKIE;1;3;;
LUBELSKIE;8;3;;
PODKARPACKIE;9;3;;
KUJAWSKO-POMORSKIE;2;3;;
ZACHODNIOPOMORSKIE;13;4;;
WARMIŃSKO-MAZURSKIE;3;3;;
ŚWIĘTOKRZYSKIE;10;6;;
PODLASKIE;3;3;;
LUBUSKIE;13;4;;
OPOLSKIE;12;5;;
We can make this file beautiful and searchable if this error is corrected: No commas found in this CSV file in line 0.
Województwo;okreg;mandaty;;
MAZOWIECKIE;1;16;;
ŚLĄSKIE;2;19;;
WIELKOPOLSKIE;3;16;;
MAŁOPOLSKIE;2;19;;
DOLNOŚLĄSKIE;2;19;;
ŁÓDZKIE;1;16;;
POMORSKIE;3;16;;
LUBELSKIE;1;16;;
PODKARPACKIE;2;19;;
KUJAWSKO-POMORSKIE;3;16;;
ZACHODNIOPOMORSKIE;3;16;;
WARMIŃSKO-MAZURSKIE;3;16;;
ŚWIĘTOKRZYSKIE;1;16;;
PODLASKIE;1;16;;
LUBUSKIE;3;16;;
OPOLSKIE;2;19;;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment