Powyborczo. Primo: szkoda, że PiSom te kamery nie wyszły byłoby się z czego pośmiać oglądając debili ze świeczkami (innego pożytku z zainstalowania -- przy założeniu #1kamera na jedną komisję -- 27tys kamer nie widzę).
Ale do rzeczy: dane pobrane z PKW (na Wikipedii za 2014 mają dokładnie takie same, za 2018 nie sprawdzałem)
require(ggplot2) #d <- read.csv("mandaty.csv", sep = ';', header=T, na.string="NA"); # Albo po prostu bo danych mało # https://www.datamentor.io/r-programming/data-frame/ x <- data.frame("komitet" = c("PIS", "PO", "PSL", "SLD", "INNI"), "y2018" = c(254,194,70,15,19), "y2014" = c(171,179,157,28,20) ) # różnica w liczbie uzyskanych mandatów d$diff <- d$y2018 - d$y2014 ggplot(d, aes(x= komitet, y=diff, fill=komitet)) + geom_bar(stat="identity") + scale_fill_manual("legend", values = c("PIS" = "#421C52", "PO" = "blue", "PSL" = "green", "SLD" = "red", "INNI" = "pink")) + geom_text(aes(x=komitet, y=diff, label=diff), hjust=0, vjust=-0.25, size=3.5) + ggtitle ("Mandaty sejmików wojewódzkich 2018--2014 (zmiana)")
BTW, jeżeli protokoły komisje obwodowe wysłały (zapewne elektronicznie) do PKW góra w poniedziałek (w mojej już poniedziałek-rano okleili kopią drzwi), to co niezawisłe Hermelińskie robiły we wtorek i środę? Niestety tego prostego pytania żaden z tzw. dziennikarzy (aka specjalistów od pierdołowatych njusów czyli #pierdokontentu) nie zadał.
A mnie ono ciekawi.
BTW2: ten wpis jest 500 w blogu. Wychodzi jakieś 45/rok średnio (z tendencją spadkową).
Znakomita większość publikowanych sondaży pomija szacowanie frekwencji; czasami dodaje się zaklęcie zdecydowani wyborcy. Widziałem jeden sondaż, w którym podano ilu jest tych zdecydowanych -- 80%. Jak się to ma do realiów i jaka jest wartość prognoz opartych na założeniu, że do urn pójdzie 80% uprawnionych, no to poniższa tabela daje pojęcie (P oznacza oczywiście wybory parlamentarne a S samorządowe):
Rok | P2015 S2014 P2011 S2010 P2007 S2006 P2005 P2001 --------------+------------------------------------------------ %Uprawnionych | 50,92 47,21 48,92 47,32 53,88 45,99 40,57 44,23
Analiza eksploracyjna wyborów wójtów/burmistrzów/prezydentów. W PL wybiera się radnych w wyborach do rad powiatów/rad gmin (oba ciała IMO zbędne), radnych sejmików wojewódzkich oraz uwaga: wójtów/burmistrzów/prezydentów (WBP) na poziomie gmin. O ile wybory sejmików kierują się tym samym mechanizmem co wybory sejmowe to wybory WBP są większościowe -- każdy może wystartować i wygrać. Do tego taki WBP ma dużą władzę więc warto być WBP. Takich wyborów w PL jest 2477 -- tyle ile gmin. W zależności od statusu gminy w jednych wybiera się wójta a w innych prezydenta czy burmistrza. Mówiąc konkretnie wójtów jest 1547, burmistrzów 823 a prezydentów 107. Poniższa tabela zestawia dane dotyczące kandydatów w wyborach 2018/2014/2010
Rok N 1KN 1K% 2KN 2K% >4N >4% śr ------------------------------------------------------ 2018 6965 329 13,30 849 34,30 262 10,58 2,81 2014 8019 245 9,90 666 26,90 471 19,00 3,25 2010 7776 303 12,20 683 27.57 430 17,36 3,14
Jak na moje to kandydatów za dużo to się nie zgłasza, do tego (w tym roku/w tych wyborach) w 13,30% gmin jest jeden, a w 34,30% dwóch (co daje co najwyżej dwóch w prawie połowie wyborów WBP). Do tego tendencja jest jakby nie w tę stronę co trzeba: mniej kandydatów ogółem, więcej gmin z małą liczbą kandydatów, mniej gmin z dużą liczbą kandydatów. Można podsumować że demokracja na lokalnym poziomie słabnie...
Ilustruje to wykres krzywych gęstości liczby kandydatów na urząd WBP (dla każdego roku oddzielna krzywa).
## ramka g ma następującą strukturę: razem;teryt;rok g$r <- as.factor(g$rok) p <- ggplot(g, aes(x=razem, color=r)) + geom_density() + labs(title="Krzywa gęstości liczby kandydatów na urząd wójta/burmistrza/prezydenta", x="Liczba kandydatów", y = "Gęstość", color="Rok")
Dane są tutaj
Dobrnąłem w końcu do finału pobierając ostatecznie ze strony PKW dane dotyczące siedmiu wyborów, które odbyły się w latach: 2015, 2014 (samorządowe), 2011, 2010 (samorządowe), 2007, 2006 (samorządowe), 2005.
Wyniki wcześniejszych wyborów nie są już dostępne na poziomie komisji obwodowych (a przynajmniej ja nie potrafię takowych odszukać). Protokoły z wyborów z 2006 roku też nie były dostępne, ale udało się je w części odtworzyć ze stron z wynikami kandydatów (zawierającymi liczbę głosów oddanych na kandydata w poszczególnych komisjach obwodowych).
Dla każdych wyborów wykreśliłem histogram poparcia dla mainstreamowych partii: PSL, PO, PiS oraz SLD. Zgodnie z oczekiwaniami rozkłady poparcia są jednomodalne, prawostronnie symetryczne, ale z dwoma wyjątkami: rozkład poparcia dla PO jest bimodalny i ta tendencja wydaje się stała. Rozkład poparcia dla PSL z roku 2014 (cud nad urną) różni się -- na zasadzie znajdź element niepasujący do pozostałych -- od sześciu pozostałych rozkładów poparcia dla tej partii (czemu to już inna historia).
Dane są tutaj
Co wybory to inaczej oczywiście...
Wyniki wyborów 2010 są na stronie http://wybory2010.pkw.gov.pl/
.
Punktem wyjścia jest zaś strona z wynikami dla województwa
postaci
http://wybory2010.pkw.gov.pl/geo/pl/020000/020000-o-020000-RDA-2.html?wyniki=1
,
w której wiodące 02
z 020000
to kod teryt województwa a 2
przed .html
to numer okręgu wyborczego. Zatem pobranie wszystkich stron
`okręgowych' sprowadza się do:
#!/usr/bin/perl # use LWP::Simple; # my $uribase = 'http://wybory2010.pkw.gov.pl/geo/pl'; @Woj = ("02", "04", "06", "08", "10", "12", "14", "16", "18", "20", "22", "24", "26", "28", "30", "32"); @Okr = (1,2,3,4,5,6,7,8,9,10); ## nadmiarowo (max jest 8 chyba) for $w (@Woj) { for $o (@Okr) { $url = "$uribase/${w}0000/${w}0000-o-${w}0000-RDA-${o}.html?wyniki=1"; $file = "ws2010_woj_${w}_${o}"; getstore($url, $file); print STDERR "$url stored\n"; } }
Teraz się okazuje że każdy taki plik zawiera odnośniki
postaci /owk/pl/020000/2c9682212bcdb46c012bcea96efe0131.html
.
Każdy taki plik opisuje kandydata startującego w wyborach.
Ich pobranie jest równie banalne:
#!/usr/bin/perl # use LWP::Simple; use locale; use utf8; binmode(STDOUT, ":utf8"); use open IN => ":encoding(utf8)", OUT => ":utf8"; $baseURI="http://wybory2010.pkw.gov.pl"; $file = $ARGV[0]; while (<>) { chomp(); if (/(owk\/[^<>"]*)/) { $url= "$baseURI/$1"; if (/(owk\/[^<>"]*)[^<>]*>([^<>]*)/) { $who = "$2"; $who =~ s/ //g; $who =~ tr/ĄĆĘŁŃÓŚŻŹ/ACELNOSZZ/; $who =~ tr/ąćęłńóśżź/acelnoszz/; } else {$who = "XxYyZz"; } $outFile = "owk_${file}__${who}"; getstore($url, $outFile); print STDERR "$url stored ($outFile)\n"; } } ## pobranie wszystkich owk-URLi to: ## for i in ws2010_woj* ; do perl pobierz-owk.pl $i ; done
W plikach `owk' są linki do protokołów z wynikami z poszczególnych komisji.
Są to linki postaci:
/obw/pl/3206/bacbedd03197794e2e1e8e438bff87e1.html
. Należy
je wszystkie pobrać (URLe nie pliki) i posortować usuwając duplikaty.
Powinno być takich URLi około 25--27 tysięcy (tyle ile komisji):
#!/usr/bin/perl # $baseURI="http://wybory2010.pkw.gov.pl"; $file = $ARGV[0]; while (<>) { chomp(); if (/(obw\/[^<>"]*)/) { $url= "$baseURI/$1"; if (/(obw\/[^<>"]*)[^<>]*>([^<>]*)/) { $obwNr = "$2"; } $outFile = "${file};${obwNr}"; print "$url;$outFile\n"; } } ## for i in owk_2010* ; do perl pobierz-obw.pl $i ; done > proto0.csv ## awk -F';' '{print $1";"$3}' proto0.csv | sort -u > protokoly.csv ## wc -l protokoly.csv ## 25464 protokoly.csv
Każdy URL jest postaci /obw/pl/0201/051595429cc31a526f8b2455602ab929.html
.
Te 0201
to pewnie teryt powiatu,
ale reszta wydaje się losowa więc
nie da się ustalić jakiegoś schematu URLi protokołów, bo go nie ma po prostu.
Teraz postaje pobrać te 25464 plików-protokołów z komisji
obwodowych. Na wszelki wypadek będę zapisywał te protokoły wg schematu:
proto_ws_2010_terytPowiatu_nrkomisji
:
#!/usr/bin/perl ## use LWP::Simple; open (O, "protokoly.csv") || die "No protokoly.csv!"; while (<O>) { chomp(); ($url, $nrk) = split /;/, $_; $_ =~ m#http://wybory2010.pkw.gov.pl/obw/pl/([0-9][0-9][0-9][0-9])#; $teryt = $1; $outFile = "proto_ws_2010_${teryt}_$nrk"; getstore($url, $outFile); print STDERR "*** $url stored ($outFile)\n"; } close(O); ## time perl get-proto.pl
Mi się ściągało 62 minuty 30 sekund.
Rozkład odsetka głosów nieważnych (definiowanego jako głosy nieważne / (głosy ważne + nieważne)) w wyborach samorządowych w 2014. Pierwszy histogram dotyczy całej Polski (27455 komisji), drugi województwa pomorskiego (1856) a trzeci Mazowieckiego (3574).
#!/usr/bin/Rscript # Skrypt wykreśla histogramy dla danych z pliku ws2014_komisje.csv # (więcej: https://github.com/hrpunio/Data/tree/master/ws2014_pobranie_2018) # par(ps=6,cex=1,cex.axis=1,cex.lab=1,cex.main=1.2) komisje <- read.csv("ws2014_komisje.csv", sep = ';', header=T, na.string="NA"); komisje$ogn <- komisje$glosyNiewazne / (komisje$glosy + komisje$glosyNiewazne) * 100; summary(komisje$glosyNiewazne); fivenum(komisje$glosyNiewazne); sX <- summary(komisje$ogn); sF <- fivenum(komisje$ogn); sV <- sd(komisje$ogn, na.rm=TRUE) skewness <- 3 * (sX[["Mean"]] - sX[["Median"]])/sV summary_label <- sprintf ("Śr = %.1f\nMe = %.1f\nq1 = %.1f\nq3 = %.1f\nW = %.2f", sX[["Mean"]], sX[["Median"]], sX[["1st Qu."]], sX[["3rd Qu."]], skewness) ## ## kpN <- seq(0, 100, by=2); kpX <- c(0, 10,20,30,40,50,60,70,80,90, 100); nn <- nrow(komisje) h <- hist(komisje$ogn, breaks=kpN, freq=TRUE, col="orange", main=sprintf ("Rozkład odsetka głosów nieważnych\nPolska ogółem %i komisji", nn), ylab="%", xlab="% nieważne", labels=F, xaxt='n' ) axis(side=1, at=kpN, cex.axis=2, cex.lab=2) posX <- .5 * max(h$counts) text(80, posX, summary_label, cex=1.4, adj=c(0,1)) ## ## komisje$woj <- substr(komisje$teryt, start=1, stop=2) komisjeW <- subset (komisje, woj == "22"); ## pomorskie nn <- nrow(komisjeW) sX <- summary(komisjeW$ogn); sF <- fivenum(komisjeW$ogn); sV <- sd(komisjeW$ogn, na.rm=TRUE) skewness <- 3 * (sX[["Mean"]] - sX[["Median"]])/sV summary_label <- sprintf ("Śr = %.1f\nMe = %.1f\nq1 = %.1f\nq3 = %.1f\nW = %.2f", sX[["Mean"]], sX[["Median"]], sX[["1st Qu."]], sX[["3rd Qu."]], skewness) h <- hist(komisjeW$ogn, breaks=kpN, freq=TRUE, col="orange", main=sprintf("Rozkład odsetka głosów nieważnych\nPomorskie %i komisji", nn), ylab="%", xlab="% nieważne", labels=T, xaxt='n' ) axis(side=1, at=kpX, cex.axis=2, cex.lab=2) posX <- .5 * max(h$counts) text(80, posX, summary_label, cex=1.4, adj=c(0,1)) komisjeW <- subset (komisje, woj == "14"); ## mazowieckie nn <- nrow(komisjeW) sX <- summary(komisjeW$ogn); sF <- fivenum(komisjeW$ogn); sV <- sd(komisjeW$ogn, na.rm=TRUE) skewness <- 3 * (sX[["Mean"]] - sX[["Median"]])/sV summary_label <- sprintf ("Śr = %.1f\nMe = %.1f\nq1 = %.1f\nq3 = %.1f\nW = %.2f", sX[["Mean"]], sX[["Median"]], sX[["1st Qu."]], sX[["3rd Qu."]], skewness) h <- hist(komisjeW$ogn, breaks=kpN, freq=TRUE, col="orange", main=sprintf("Rozkład odsetka głosów nieważnych\nMazowieckie %i komisji", nn), ylab="%", xlab="% nieważne", labels=T, xaxt='n' ) axis(side=1, at=kpX, cex.axis=2, cex.lab=2) posX <- .5 * max(h$counts) text(80, posX, summary_label, cex=1.4, adj=c(0,1))
Wyniki są takie oto (indywidualne wykresy tutaj: #01 #02 #03):
Rozkłady odsetka poparcia dla PSL/PiS/PO w wyborach samorządowych w 2014 w całej Polsce, w miastach/poza miastami oraz w poszczególnych województwach. Poniższy skrypt generuje łącznie 60 wykresów słupkowych:
#!/usr/bin/Rscript # Skrypt wykreślna różnego rodzaju histogramy dla danych z pliku ws2014_komitety_by_komisja_T.csv # (więcej: https://github.com/hrpunio/Data/tree/master/ws2014_pobranie_2018) # showVotes <- function(df, x, co, region, N, minN) { ## showVotes = wykreśla histogram dla województwa (region) kN <- nrow(df) sX <- summary(df[[x]], na.rm=TRUE); sV <- sd(df[[x]], na.rm=TRUE) ## współczynnik skośności Pearsona skewness <- 3 * (sX[["Mean"]] - sX[["Median"]])/sV summary_label <- sprintf ("Śr = %.1f\nMe = %.1f\nq1 = %.1f\nq3 = %.1f\nS = %.1f\nW = %.2f", sX[["Mean"]], sX[["Median"]], sX[["1st Qu."]], sX[["3rd Qu."]], sV, skewness) if (minN < 1) { t <- sprintf("Rozkład głosów na %s\n%s ogółem %d komisji", co, region, kN ) } else { t <- sprintf("Rozkład głosów za %s\n%s ogółem %d komisji (N>%d)", co, region, kN, minN ) } h <- hist(df[[x]], breaks=kpN, freq=TRUE, col="orange", main=t, ylab="%", xlab="% poparcia", labels=F, xaxt='n' ) axis(side=1, at=kpN, cex.axis=2, cex.lab=2) ## pozycja tekstu zawierającego statystyki opisowe posX <- .5 * max(h$counts) text(80, posX, summary_label, cex=1.4, adj=c(0,1)) } ## Wczytanie danych; obliczenie podst. statystyk: komisje <- read.csv("ws2014_komitety_by_komisja_T.csv", sep = ';', header=T, na.string="NA"); komisje$ogn <- komisje$glosyNiewazne / (komisje$glosy + komisje$glosyNiewazne) * 100; summary(komisje$PSL); summary(komisje$PiS); summary(komisje$PO); fivenum(komisje$PSLp); fivenum(komisje$PiSp); fivenum(komisje$POp); ## ## ### par(ps=6,cex=1,cex.axis=1,cex.lab=1,cex.main=1.2) kpN <- seq(0, 100, by=2); kpX <- c(0, 10,20,30,40,50,60,70,80,90, 100); kN <- nrow(komisje) region <- "Polska" minTurnout <- 0 ## cała Polska: showVotes(komisje, "PSLp", "PSL", region, kN, minTurnout); showVotes(komisje, "PiSp", "PiS", region, kN, minTurnout); showVotes(komisje, "POp", "PO", region, kN, minTurnout); ## Cała Polska (bez małych komisji): ## ( późniejszych analizach pomijane są małe komisje) minTurnout <- 49 komisje <- subset (komisje, glosyLK > minTurnout); kN <- nrow(komisje) showVotes(komisje, "PSLp", "PSL", region, kN, minTurnout); showVotes(komisje, "PiSp", "PiS", region, kN, minTurnout); showVotes(komisje, "POp", "PO", region, kN, minTurnout); ## Typ gminy U/R (U=gmina miejska ; R=inna niż miejska) komisjeW <- subset (komisje, typ == "U"); kN <- nrow(komisjeW) region <- "Polska/g.miejskie" showVotes(komisjeW, "PSLp", "PSL", region, kN, minTurnout); showVotes(komisjeW, "PiSp", "PiS", region, kN, minTurnout); showVotes(komisjeW, "POp", "PO", region, kN, minTurnout); komisjeW <- subset (komisje, typ == "R"); kN <- nrow(komisjeW) region <- "Polska/g.niemiejskie" showVotes(komisjeW, "PSLp", "PSL", region, kN, minTurnout); showVotes(komisjeW, "PiSp", "PiS", region, kN, minTurnout); showVotes(komisjeW, "POp", "PO", region, kN, minTurnout); ## woj = dwucyfrowy kod teryt województwa: komisje$woj <- substr(komisje$teryt, start=1, stop=2) cN <- c("dolnośląskie", "dolnośląskie", "kujawsko-pomorskie", "lubelskie", "lubuskie", "łódzkie", "małopolskie", "mazowieckie", "opolskie", "podkarpackie", "podlaskie", "pomorskie", "śląskie", "świętokrzyskie", "warmińsko-mazurskie", "wielkopolskie", "zachodniopomorskie"); cW <- c("02", "04", "06", "08", "10", "12", "14", "16", "18", "20", "22", "24", "26", "28", "30", "32"); ## wszystkie województwa po kolei: for (w in 1:16) { wojS <- cW[w] ###region <- cN[w]; region <- sprintf ("%s (%s)", cN[w], wojS); komisjeW <- subset (komisje, woj == wojS); ## showVotes(komisjeW, "PSLp", "PSL", region, kN, minTurnout); showVotes(komisjeW, "PiSp", "PiS", region, kN, minTurnout); showVotes(komisjeW, "POp", "PO", region, kN, minTurnout); } ## ## koniec
Dla całej Polski wyniki są następujące:
Indywidualne wykresy zaś tutaj: #01 #02 #03 #04 #05 #06 #07 #08 #09 #10 #11 #12 #13 #14 #15 #16 #17 #18 #19 #20 #21 #22 #23 #24 #25 #26 #27 #28 #29 #30 #31 #32 #33 #34 #35 #36 #37 #38 #39 #40 #41 #42 #43 #44 #45 #46 #47 #48 #49 #50 #51 #52 #53 #54 #55 #56 #57 #58 #59 #60):
Rozkłady wieku kandydatów (2014/2018) i radnych wybranych do sejmików wojewódzkich 2014.
require(ggplot2) ### ### ### co <- "Wiek kandydatów do sejmików wojewódzkich (2014 / Polska)" ## deklaracja końców klas (hist) wB <- c(18,20,25,30,35,40,45,50,55,60,65,70,75,80,95); wZ <- c(36,38,40,42,44,46,48,50,52,54,56); wD <- seq(18, 92, by=2); komitety <- "DB = Demokracja Bezpośrednia | RN = Ruch Narodowy | NPKM = Nowa Prawica JKM"; k <- read.csv("kandydaci_ws_2014.csv", sep = ';', header=T, na.string="NA", dec=","); with (k, table(komitet)) aggregate (k$wiek, list(Numer = k$komitet), fivenum) ## analiza dotyczy tylko kandydatów z komitetów ogólnopolskich kandydaci <- subset (k, (komitet == "PSL" | komitet == "DB" | komitet == "PiS" | komitet == "PO" | komitet == "RN" | komitet == "NPKM" | komitet == "SLDLR")); kandydaciPL <- kandydaci kNum <- nrow(kandydaciPL) kNum with (kandydaci, table(komitet)) aggregate (kandydaci$wiek, list(Numer = kandydaci$komitet), fivenum) sumS <- summary(kandydaci$wiek) sumV <- sd(kandydaci$wiek) summary_label <- sprintf ("Śr = %.1f\nMe = %.1f\nQ1 = %.1f\nQ3 = %.1f\nS = %.1f", sumS[["Mean"]], sumS[["Median"]], sumS[["1st Qu."]], sumS[["3rd Qu."]], sumV) #par() ## przegląd parametrów # ps = stopień pisma par(ps=11,cex=1,cex.axis=1,cex.lab=1,cex.main=1.2) h <- hist(kandydaci$wiek, breaks=wB, freq=TRUE, col="orange", main=co, ylab="liczba kandydatów", xlab="wiek", labels=T, xaxt='n') axis(side=1, at=wB) text(80, 600, summary_label, cex = .8, adj=c(0,1)) par(ps=6,ce=2,cex.axis=2,cex.lab=2,cex.main=2) h <- hist(kandydaci$wiek, breaks=wD, freq=TRUE, col="orange", main=co, ylab="liczba kandydatów", xlab="wiek", labels=T, xaxt='n' ) axis(side=1, at=wB, cex.axis=2, cex.lab=2) text(80, 600, summary_label, cex=0.4, size=3, pos=3, adj=c(0,1)) ### ### ### aggregate (kandydaci$wiek, list(Numer = kandydaci$nr), fivenum) aggregate (kandydaci$wiek, list(Numer = kandydaci$komitet), fivenum) ### ### ### ggplot(kandydaci, aes(x=komitet, y=wiek, fill=komitet)) + geom_boxplot() + ylab("Wiek") + xlab("Komitet") + annotate(geom="text", x = 1, y = 90, hjust=0, size=3, label = komitety ) + guides(fill=FALSE) ; ### ### ### Pomorskie TERYT=22 ### ### ### co <- "Wiek kandydatów do sejmików wojewódzkich (2014 / Pomorskie)" kandydaci <- subset (kandydaci, (woj == "22" )) aggregate (kandydaci$wiek, list(Numer = kandydaci$komitet), fivenum) ggplot(kandydaci, aes(x=komitet, y=wiek, fill=komitet)) + geom_boxplot() + ylab("Wiek") + xlab("Komitet") + annotate(geom="text", x = 1, y = 90, hjust=0, size=3, label = komitety ) + guides(fill=FALSE) ; sumS <- summary(kandydaci$wiek) summary_label <- sprintf ("Śr = %.1f\nMe = %.1f\nQ1 = %.1f\nQ3 = %.1f", sumS[["Mean"]], sumS[["Median"]], sumS[["1st Qu."]], sumS[["3rd Qu."]]) ## przywrócenie wartości parametrów par(ps=11,cex=1,cex.axis=1,cex.lab=1,cex.main=1.2) h <- hist(kandydaci$wiek, breaks=wB, freq=TRUE, col="orange", main=co, xlab="wiek", ylab="liczba kandydatów", labels=T, xaxt='n') axis(side=1, at=wB) text(80, 40, summary_label, cex = .8, adj=c(0,1)) with (kandydaci, table(komitet)) ### ## ### kandydaciPL$okrN <- paste (kandydaciPL$woj, "o", kandydaciPL$okr) a <- aggregate (kandydaciPL$wiek, list(Numer = kandydaciPL$okrN), fivenum) h <- hist(a$x[,3], breaks=wZ, freq=TRUE, col="orange", main="Mediana wieku kandydatów wg okręgów [Polska 2014]", xlab="wiek", ylab="liczba okręgów", labels=T, xaxt='n') axis(side=1, at=wZ) text(80, 40, summary_label, cex = .8, adj=c(0,1)) ## ## ### radni (czyli wybrani) radni <- read.csv("radni_ws_2014.csv", sep = ';', header=T, na.string="NA", dec=","); sumS <- summary(radni$wiek) sumV <- sd(radni$wiek) summary_label <- sprintf ("Śr = %.1f\nMe = %.1f\nQ1 = %.1f\nQ3 = %.1f\nS = %.1f", sumS[["Mean"]], sumS[["Median"]], sumS[["1st Qu."]], sumS[["3rd Qu."]], sumV) h <- hist(radni$wiek, breaks=wB, freq=TRUE, col="orange", main="Wiek radnych do sejmików wojewódzkich 2014", ylab="liczba radnych", xlab="wiek", labels=T, xaxt='n') axis(side=1, at=wB) text(80, 80, summary_label, cex = .8, adj=c(0,1))
Na stronie
https://wybory2018.pkw.gov.pl/pl/geografia#general_committee_stat
jest informacja, że w wyborach na radnych sejmików wojewódzkich
bierze udział/zostało zarejestrowanych 7076 kandydatów.
Zaczynając od tej strony
można się doklikać do stron dla każdego województwa oraz okręgu. Są to odpowiednio
strony tworzone według schematu:
https://wybory2018.pkw.gov.pl/pl/geografia/220000#geo_committee_stat https://wybory2018.pkw.gov.pl/pl/geografia/220000/voiv_council/1
Strona okręgu zawiera listę kandydatów a jej HTML jest tak nieskomplikowany, że zamiana na na przykład plik CSV jest banalnie prosta.
Po ściągnięciu 85 ,,stron okręgowych'' i ich zamianie na CSV, faktycznie otrzymałem plik składający się z 7076 wierszy, z których każdy jest postaci:
woj;okr;komitet;nr;kandydat;wiek;skad;oswidczenie;uwagi 02;o1;SLD-LR;1;SIKORA Arkadiusz;45;Oleśnica;;
Dalszą analizę przeprowadziłem wykorzystując R:
k <- read.csv("kandydaci_ws_2018_3.csv", sep = ';', header=T, na.string="NA", dec=","); with (k, table(komitet))
Komitet | liczba kandydatów | liczba okręgów |
BS | 447 | 62 |
K15 | 675 | 84 |
KW INICJATYWA OBYWATELSKA POWIATU TARNOGÓRSKIEGO | 31 | 4 |
KW STOWARZYSZENIA LEX NATURALIS | 12 | 2 |
KW STRONNICTWA PRACY | 6 | 1 |
KW ŚLĄSKIEJ PARTII REGIONALNEJ | 85 | 12 |
KW ŚLONZOKI RAZEM | 40 | 5 |
KW WSPÓLNA MAŁOPOLSKA 51 KW WYBORCÓW AKCJA NARODOWA | 27 | 5 |
KW WYBORCÓW ISKRA | 38 | 6 |
KW WYBORCÓW JEDNOŚĆ NARODU -- WSPÓLNOTA | 118 | 18 |
KW WYBORCÓW AGNIESZKI JĘDRZEJEWSKIEJ | 5 | 1 |
KW WYBORCÓW MNIEJSZOŚĆ NIEMIECKA | 31 | 4 |
KW WYBORCÓW POLSKIE RODZINY RAZEM | 28 | 4 |
KW WYBORCÓW PROJEKT ŚWIĘTOKRZYSKIE BOGDANA WENTY | 30 | 4 |
KW WYBORCÓW SPOZA SITWY | 23 | 4 |
KW WYBORCÓW Z DUTKIEWICZEM DLA DOLNEGO ŚLĄSKA | 45 | 5 |
KW ZJEDNOCZENIE CHRZEŚCIJAŃSKICH RODZIN | 40 | 7 |
KW ZWIĄZKU SŁOWIAŃSKIEGO | 17 | 3 |
PiS | 722 | 85 |
PO-N | 722 | 85 |
PSL | 722 | 85 |
RAZEM | 549 | 85 |
RN | 528 | 79 |
SLD-LR | 713 | 85 |
WiS | 448 | 63 |
WwS | 574 | 77 |
ZIELONI | 349 | 57 |
Dalszą analizą objęto 10 komitetów, które zarejestrowały kandydatów w ponad połowie okręgów wyboczych (WsS to Wolność w Samorządzie; WiS to Wolni i Solidarni a BS oznacza Komitet pn Bezpartyjni Samorządowcy):
aggregate (k$wiek, list(Numer = k$komitet), fivenum) wB <- c(18,20,25,30,35,40,45,50,55,60,65,70,75,80,95); summary_label <- paste (sep='', "Średnia = ", sprintf("%.1f", sumS[["Mean"]]), "\nMediana = ", sumS[["Median"]], "\nQ1 = ", sumS[["1st Qu."]], "\nQ3 = ", sumS[["3rd Qu."]] ) ## wykres słupkowy h <- hist(kandydaci$wiek, breaks=wB, freq=TRUE, col="orange", main="Wiek kandydatów do sejmików...", ylab="liczba kandydatów", xlab="wiek", labels=T, xaxt='n') axis(side=1, at=wB) text(80, 600, summary_label, cex = .8, adj=c(0,1)) ## wykres pudełkowy ggplot(kandydaci, aes(x=komitet, y=wiek, fill=komitet)) + geom_boxplot() + ylab("Wiek") + xlab("Komitet") + annotate(geom="text", x = 1, y = 90, hjust=0, size=3, label = "WwS = Wolność w Samorządzie | ...") + guides(fill=FALSE) ;
# | komitet | min | q1 | Me | q3 | max |
1 | BS | 18.0 | 36.0 | 44.0 | 57.0 | 81.0 |
2 | K15 | 18.0 | 32.0 | 42.0 | 53.0 | 82.0 |
3 | PiS | 18.0 | 40.0 | 51.0 | 59.0 | 79.0 |
4 | PO-N | 18.0 | 41.0 | 51.0 | 60.0 | 75.0 |
5 | PSL | 20.0 | 44.0 | 55.0 | 62.0 | 80.0 |
6 | RAZEM | 18.0 | 28.0 | 34.0 | 42.0 | 87.0 |
7 | RN | 18.0 | 27.0 | 34.0 | 48.0 | 81.0 |
8 | SLD-LR | 18.0 | 44.0 | 58.0 | 65.0 | 83.0 |
9 | WiS | 18.0 | 38.0 | 50.0 | 61.5 | 85.0 |
10 | WwS | 18.0 | 24.0 | 31.0 | 43.0 | 83.0 |
11 | ZIELONI | 18.0 | 34.0 | 44.0 | 55.0 | 80.0 |
To samo dla woj. pomorskiego:
kandydaci <- subset (kandydaci, (woj == "22" )) aggregate (kandydaci$wiek, list(Numer = kandydaci$komitet), fivenum) ## itd...
1 | BS | 23.0 | 36.5 | 44.0 | 47.5 | 72.0 |
2 | K15 | 23.0 | 37.0 | 50.0 | 58.0 | 73.0 |
3 | PiS | 21.0 | 42.5 | 49.0 | 63.5 | 71.0 |
4 | PO-N | 22.0 | 39.0 | 50.0 | 60.5 | 75.0 |
5 | PSL | 28.0 | 49.0 | 62.0 | 68.0 | 80.0 |
6 | RAZEM | 19.0 | 29.0 | 33.5 | 38.0 | 87.0 |
7 | RN | 21.0 | 27.0 | 31.5 | 49.0 | 66.0 |
8 | SLD-LR | 18.0 | 50.0 | 59.0 | 62.5 | 75.0 |
9 | WwS | 19.0 | 27.0 | 32.0 | 38.5 | 67.0 |
10 | ZIELONI | 19.0 | 39.0 | 48.0 | 54.0 | 67.0 |
Ściągnąłem protokoły z wyborów do sejmików wojewódzkich
jeszcze raz. Punktem wyjścia były indywidualne pliki dla każdej gminy
pobrane ze strony samorzad2014.pkw.gov.pl
.
Te pliki zawierają
zsumowane wyniki wyborów dla danej gminy, ale także zawierają adresy URL do
plików z wynikami na poziomie poszczególnych komisji (z tej gminy).
Mają one adres URL wg schematu:
http://samorzad2014.pkw.gov.pl/357_rady_woj/0/NR_TERYT_GMINY
Mając zestawienie numerów TERYT gmin pobieram indywidualne pliki za pomocą prostego skryptu:
use LWP::Simple; ## Na wejściu lista 6-cyfrowych numerów gmin while (<>) { $nn++; chomp(); $File{"$_"}++; $url = "http://samorzad2014.pkw.gov.pl/357_Sejmiki_wojewodztw/0/$_"; if ( $File{"$_"} > 1 ) { $file = "./html/$_" . "$File{$_}_" . ".html"; } else { $file = "./html/$_" . ".html"; } getstore($url, $file); print STDERR "$nn = $url => $file... stored\n"; }
Z tych plików wydłubuję numery komisji (które są wartościami
atrybutu href
do pliku z protokołem i mają postać
321_protokol_komisji_obwodowej/NRKOMISJI
)
i zapisuję do pliku o strukturze:
020101;321_protokol_komisji_obwodowej/NRKOMISJI
Teraz z plików komisji odczytuję adresy URL protokołów wyborów do sejmików. Ten URL wygląda następująco:
020101;321_protokol_komisji_obwodowej/NRKOMISJI/rdw_COŚTAM
Przy czym COŚTAM
to cyfra, np. rdw_5
.
Problem, że ta cyfra nie zawsze jest taka sama, stąd konieczność
przeczytania pliku i odszukania w nim odsyłacza do protokołu
wyborów do sejmików. Na szczęście pliki HTML są w miarę proste
i do odszukania tego
co trzeba wystarczy proste wyrażenie regularne. Poniższy skrypt
po odszukaniu odsyłacza pobiera plik protokołu i zapisuje
w katalogu ./protokoly_sw/
:
#!/usr/bin/perl use LWP::Simple; my $log = "protokoly_sw.log"; open (LOG, ">$log") || die ("Nie mogę pisać do $log"); while (<>) { $nn++; chomp(); ($teryt, $postfix, $nrk) = split /[;\/]/, $_; unless ( -f "./protokoly_sw/$nrk" ) { $file = "./protokoly_sw/$nrk"; open (LOGP, "./komisje/$nrk"); while (<LOGP>) { chomp(); if (/([^\/]*protokol_komisji.*)">Sejmik/) {## URL do protokołu $prot_url = $1; print "$1\n"; last } } close (LOGP); $url = "http://samorzad2014.pkw.gov.pl/$prot_url"; getstore($url, $file); print LOG "$nn = $url => $file stored\n"; print STDERR "*** $nn = $url => $file stored\n"; } else { print STDERR "*** $url => $file stored already\n"; } }
Teraz analizuję pobrane protokoły zapisując informacje
do trzech plików .csv
: ws2014_komisje.csv
ws2014_listy.csv
oraz
ws2014_kandydaci.csv
. Pierwszy zawiera informacje
zbiorcze takie jak liczba uprawnionych czy liczba
głosów ważnych dla każdej komisji, drugi informacje zbiorcze
o liczbie głosów oddanych na każdą listę wyborczą w każdej komisji
a trzeci o liczbie głosów
oddanych na każdego kandydata w każdej komisji. W związu z tym:
wc -l ws2014_*csv 3062457 ws2014_kandydaci.csv 301876 ws2014_listy.csv 27393 ws2014_komisje.csv
Tj. ws2014_komisje.csv
ma 27393 wierszy (i tyle jest komisji);
ws2014_listy.csv
ma 301876, a ws2014_kandydaci.csv
ponad 3mln wierszy (wynik kandydata w każdej komisji,
w której był zarejestrowany). Skrypt (nieco uproszczony) wydłubujący potrzebne informacje
z pliku protokołu wygląda następująco:
#!/usr/bin/perl open (LOG, ">>ws2014_log.log"); open (L, ">>ws2014_listy.csv"); open (K, ">>ws2014_kandydaci.csv"); open (X, ">>ws2014_komisje.csv"); $fileName = $ARGV[0]; $fileName =~ s/(\/[^\/]+)$/$1/; while(<>) { chomp(); if (/<h2>/) { $mode = 'I'; while (<>) { chomp(); if (/<div>Kod terytorialny/) { $Teryt = next_line(); } if (/<div>Numer obwodu/) { $IdO = next_line(); } if (/<div>Adres/) { $Addr = next_line(); $IdDataFull = "$fileName;$Teryt;$IdO;$Addr"; $IdData = "$fileName;$Teryt;$IdO"; last; } } } if ($mode eq 'I') { } if (/Wyniki wyborów na Kandydatów/) { $mode = 'C' } if (/ZESTAWIENIE WYNIKÓW/) { $mode = 'S'; while (<>) { chomp(); ## pobieranie informacji nt. komisji ## pominięto kilkanaście wierszy postaci: ## if (/<div>###/) { $xxx = next_line() } ## ... if (/<div>Liczba kart ważnych/) { $N_karty_wazne = next_line(); } if (/<div>Liczba głosów ważnych oddanych/) { $N_glosy_wazne = next_line() ; print X "$IdDataFull;$N_uprawnieni;$N_karty_otrzymane;$N_karty_niewykorzystane;" . "$N_karty_wydane;$N_pelnomocnicy;$N_pakiety;$N_karty_wyjete;$karty_z_kopert;" . "$N_karty_niewazne;$N_karty_wazne;$N_glosy_wazne;$N_glosy_niewazne\n"; last; } } ########## if (/Wyniki wyborów na listy/) { $mode = 'L' ; $colNo=0; %List = (); $start = 0; while (<>) { chomp(); if (/<tbody>/) {$start = 1} if ($start == 1 ) { if (/<td[^<>]*>/ ) { $colNo++; $List{$colNo} = clean($_); } if (/<tr>/) { $colNo=0; %List = (); } if (/<\/tr>/) { $line_ = "$IdData;"; for $x (sort keys %List ) { $line_ .= "$List{$x};" } print L "$line_\n"; } if (/<\/tbody>/ ) {### last; } ##// } } } ########### if ($mode eq 'C' && /<tr>/) { $colNo=0; %Candidate = (); while (<>) { chomp(); if (/<table>/) { next } ## skip this line if (/<\/tr>/ ) { $line_ = "$IdData;"; for $x (sort keys %Candidate ) { $line_ .= "$Candidate{$x};" } print K "$line_\n"; last; } ## //end if (/<td[^<>]*>/ ) { ############# $colNo++; $Candidate{$colNo} = clean($_); } } } } ### ### ### sub clean { my $x = shift; $x =~ s/<[^<>]+>//g; $x =~ s/^[\t ]+|[\t ]+$//g; $x =~ s/"//g; return ($x) } sub next_line { while (<>) { chomp(); return (clean ($_)); } } close(L); close(K); close(X); print LOG "$fileName...\n"; close (LOG);
Kilka minut i po bólu. Teraz sprawdzam czy to co się pobrało i to co było do tej pory z grubsza się zgadza.
#!/usr/bin/perl $pobranie1="komisje-frekwencja-ws2014.csv"; ## z 2015r $pobranie2="ws2014_komisje.csv"; open(WX, $pobranie1) || die "cannot open $pobranie1\n"; while (<WX>) { chomp(); ($teryt, $nrk, $nro, $adres, $lwug, $lkw, $lkwzu, $lgnw, $lgw, $freq, $pgnw) = split /;/, $_; $LWUG1{"$teryt:$nro"} = $lwug; ## liczba wyborców $LGW1{"$teryt:$nro"} = $lgw; ## glosy ważne $ADDR1{"$teryt:$nro"} = $adres; ## } close (WX); ### ### ### open(WY, $pobranie2) || die "cannot open $pobranie2\n"; while (<WY>) { chomp(); ($id, $teryt, $idk, $adres, $uprawnieni, $kartyOtrzymane, $kartyNiewydane, $kartyWydane, $pelnomocnicy, $pakiety, $kartyWyjete, $koperty, $kartyNiewazne, $kartyWazne, $glosy, $glosyNiewazne) = split /;/, $_; $LWUG2{"$teryt:$idk"} = $uprawnieni; $LGW2{"$teryt:$idk"} = $glosy; $ADDR2{"$teryt:$idk"} = $adres; } close (WY); ### LWUG1 ma mniej głosów ## ### ### ### ### for $ik ( sort keys %LWUG1 ) { if ( ( $LWUG1{$ik} != $LWUG2{$ik} ) || ($LGW1{$ik} != $LGW2{$ik} )) { print "$ik $LWUG1{$ik} = $LWUG2{$ik} $LGW1{$ik} = $LGW2{$ik}\n"; } }
Identyfikatorem komisji na stronach PKW jest 6-cyfrowy numer TERYT + numer komisji (w gminie). Porównanie 26477 komisji pobranych 2015r. z 27446 komisjami pobranymi teraz (+969 komisji) daje w rezultacie:
021901:1 2020 = 2020 914 = 913 021901:2 2189 = 2189 742 = 741 026401:112 2039 = 2039 746 = 744 026401:17 2001 = 2001 536 = 534 026401:178 2073 = 2073 765 = 762 026401:18 1600 = 1600 474 = 473 026401:194 1615 = 1615 637 = 628 026401:215 1457 = 1457 528 = 527 026401:245 2058 = 2058 695 = 697 026401:42 1892 = 1892 504 = 503 026401:70 1823 = 1823 597 = 593 026401:78 1918 = 1918 762 = 760 241004:4 994 = 850 350 = 350 241005:13 1736 = 1736 764 = 762 241005:22 1422 = 1422 569 = 567 241005:6 1441 = 1441 732 = 723 241005:7 1668 = 1668 623 = 621
Czyli dane nie były picowane :-) Dobrze wiedzieć
Pobrane dane są tutaj.
Że się zbliżają wybory samorządowe, to ja znowu pochyliłem się nad wynikami
z poprzednich tj. z roku 2014. Piszę znowu, bo dane pobrałem dawno temu
ze strony http://wybory2014.pkw.gov.pl/
. Przypomnę też, że wybory te zakończyły
się nielichym skandalem. Po pierwsze system informatyczny
Państwowej Komisji Wyborczej zawiódł spektakularnie. Po drugie, nie tylko tradycyjnie odnotowano
niską frekwencję, ale dodatkowo i z niewiadomych do końca powodów, doszła niesłychanie
wysoka liczba oddanych głosów nieważnych.
Po trzecie dramatyczna różnica pomiędzy wynikiem prognozy exit pool,
a wynikiem oficjalnym spowodowała, że
ówczesna opozycja oskarżyła ówczesnych rządzących o fałszerstwo wyborcze.
Różnica sama w sobie nie
jest oczywiście czymś niemożliwym, ale też prognozy exit pool są no raczej na tyle
dokładne, że na ich podstawie jedni uznają się za wygranych, a inni za przegranych
w tzw. cywilizowanym świecie. A w PL akurat ktoś się rąbnął o 50%.
BTW wyobraźmy sobie reakcję #SektyPancernejKonsytytucji (aka #OpozycjiTotalnej) na coś takiego dziś.
Wracając do bazy protokołów. Jest ona niekompletna, co było stanem na czas po wyborach kiedy była pobierana i co (według mnie) było spowodowane przez system informatyczny PKW (czytaj chaos w PKW). Teraz widzę, że baza na stronie PKW wygląda inaczej i być może jest kompletna, ale nie chce mi się tego (na razie) jeszcze raz pobierać. Moja baza jest oryginalna, a nie picowana (żart :-)), a zawiera ponad 96% tego co powinna zawierać (zakładając, że obwodów jest 27435 ja mam 26495). Ta baza jest dostępna tutaj.
Mówiąc konkretnie i porównując z listą 27435 obwodów braki są następujące: Dolnośląskie = 38; Kujawsko-Pomorskie = 17; Lubelskie = 14; Lubuskie = 12; Łódzkie = 14; Małopolskie = 22; Mazowieckie = 1139; Opolskie = 7; Podkarpackie = 10; Podlaskie = 5; Pomorskie = 20; Śląskie = 28; Świętokrzyskie = 13; Warmińsko-Mazurskie = 12; Wielkopolskie = 14; Zachodniopomorskie = 18. Zatem baza jest w miarę kompletna (za wyjątkiem woj. Mazowieckiego, w przypadku którego protokoły nie były opublikowane nawet kilka miesięcy po wyborach).
Każdy protokół zawiera adres i kod teryt komisji obwodowej, tyle że TERYT jest 6 cyfrowy, a nie pełny. Z tego powodu klasyfikację miasto/wieś dokonałem w taki sposób że gmina jest `miejska' jeżeli wg klasyfikacji teryt ma ona typ `gmina miejska' (U) a w każdym innym przypadku (miejsko-wiejska, wiejska, miasto w gminie miejsko-wiejskiej albo obszar wiejski w gminie miejsko-wiejskiej) gmina jest `wiejska' (R). Jest 9996 gmin typu U, a 16881 gmin jest typu R.
Na początek wykonałem prostą analizę eksploracyjną licząc wartości średnie, korelacje oraz regresje pomiędzy głosami nieważnymi a poparciem dla partii. Stosowny fragment R-skryptu wygląda następująco:
## Korelacje pomiędzy % głosów a % głosów niewaznych cor(d$pgnw14, d$pslp, use = "complete") ## Wykresy rozrzutu ## ### lm <- lm(data=d, pslp ~ pgnw14 ); summary(lm) lmc <- coef(lm); title <- sprintf ("psl = %.2f pgnw + %.1f", lmc[2], lmc[1] ); ggplot(d, aes(x = pgnw14, y=pslp )) + geom_point(colour = 'blue') + ggtitle(title) + theme(plot.title = element_text(hjust = 0.5)) + xlab(label="pgnw") + ylab(label="pslp") + geom_smooth(method = "lm", colour = 'black') lm <- lm(data=d, pisp ~ pgnw14 ); summary(lm)
Wynik są następujące:
## pgnw (procent głosów nieważnych) Min. 1st Qu. Median Mean 3rd Qu. Max. Grupa 0.00 8.20 11.67 12.82 16.05 56.41 Razem 0.00 12.55 18.18 18.75 23.98 100.00 Miasto 0.00 17.05 21.37 22.15 26.38 77.42 Wieś ## poparcie ## Miasto 0.00 6.719 10.12 13.82 16.53 100.00 PSL 0.00 20.83 25.91 27.12 32.35 100.00 PiS 0.00 25.20 32.56 32.90 39.84 85.00 PO ## Wieś 0.00 20.11 32.61 35.86 49.27 100.00 PSL 0.00 15.42 22.60 25.55 32.96 100.00 PiS 0.00 7.748 15.43 18.53 26.44 92.65 PO ## wsp. korelacji (pgnw vs poparcie) ## PSL PiS PO Grupa 0.4053339 -0.1972364 -0.3321558 Razem 0.4333851 -0.2104114 -0.2648886 Miasto 0.0905243 -0.1931745 -0.0370197 Wieś
Liczba głosów nieważnych była wyższa na obszarach wiejskich (średnia 22,15% vs 18,75%). Poparcie dla czołowych partii był na wsi najwyższe dla PSL, potem PiS a na końcu PO; w mieście dokładnie odwrotnie. Wystąpiła dodatnia korelacja pomiędzy liczbą głosów nieważnych, a poparciem w przypadku PSL. Nieoczekiwanie była większa na obszarach większych miast, a mniejsza poza nimi. W przypadku zarówno PiS jak i PO korelacja była ujemna (większy udział głosów nieważnych oznacza mniejsze poparcie). Zależność pomiędzy liczbą głosów nieważnych a poparciem ilustrują także wykresy.
Jest zatem różnica między `miastem' a `wsią'. A czy jest różnica w decyzjach w aspekcie przestrzennym? Obliczyłem średnią wartość współczynnika korelacji pomiędzy liczbą głosów nieważnych, a poparciem w powiatach:
powiat <- substr(d$teryt, 0, 4) d[,"powiat"] <- powiat; p.psl <- d %>% group_by(powiat) %>% summarise(V1=cor(pgnw14,pslp)) p.pis <- d %>% group_by(powiat) %>% summarise(V1=cor(pgnw14,pis)) p.po <- d %>% group_by(powiat) %>% summarise(V1=cor(pgnw14,po)) print(p.psl, n=Inf) print(p.pis, n=Inf) print(p.po, n=Inf) > fivenum(p.psl$V1) [1] -0.5984602 0.1066262 0.2906827 0.4491453 0.8536293 > fivenum(p.pis$V1) [1] -0.7985236 -0.4216242 -0.2965959 -0.1658306 0.1877184 > fivenum(p.po$V1) [1] -0.8092580 -0.4891280 -0.3725242 -0.2420753 0.4726305
Jak widać są znaczące różnice...
Jedyne narzędzie jakie znam/mam/używam do przestrzennej wizualizacji danych.
Protokoły komisji zawierają adresy. Wykonałem geokodowanie tychże adresów za pomocą geocodera Google. Z różnym skutkiem, mianowicie 27435 komisji zgeokodowało się na 21716 różnych adresów. Zdarza się faktycznie, że dwie (a nawet więcej) komisje mają siedzibę w tym samym budynku. Nie mając ani chęci ani czasu na dokładną inspekcję sprawdziłem jak wygląda rozkład siedzib/adresów względem liczby komisji:
perl chk_duplicated_coords.pl | sort -n ... 15 49.9062558 21.7658112 16 51.663189 16.5125886 18 51.2070067 16.1553231 20 49.9953359 21.3075494 28 50.5798603 21.6925451 40 52.6483303 19.0677357 50 54.3520252 18.6466384
Pierwsza kolumna to liczba komisji. Można przyjąć że jeżeli liczba komisji jest większa od 4 to doszło do błędnego geokodowania. Takich wątpliwych adresów jest:
perl chk_duplicated_coords.pl | awk '$1 > 4 {print $0}' | wc -l 142
Zostawiam ten problem na później przy czym z punktu widzenia wizualizacji za pomocą GFT, coś co ma identyczne współrzędne się nałoży na siebie, np. 50 komisji o współrzędnych 54.3520252/18.6466384 będzie pokazane na mapie jako jedna kropka (przy założeniu że zastosujemy kropkę do wizualizacji oczywiście). Żeby wszystkie komisje były widoczne (nawet te które mają prawidłowe ale identyczne współrzędne), to można zastosować losowe drganie (jitter). Tyle na razie.
Plik powiaty_korelacje_pgnw_poparcie.csv
zawiera
m.in. obliczone w R współczynniki korelacji
pomiędzy liczbą głosów nieważnych, a poparciem. Mam też plik zawierający
obrysy powiatów i ich środki (teryt_powiaty_BB.csv
). Na pierwszej mapie
przedstawiono przeciętne wartości pgnw (odsetek głosów nieważnych).
Czerwone i niebieskie kropki oznaczają wysokie wartości pgnw.
Wyraźnie widać, że powiaty na zachodzie / północnym
zachodzie mają wyższe wartości pgnw niż w pozostałej częsci kraju. Takiej przestrzennej
zależności nie widać dla trzech
pozostałych mapek, ilustrujących przeciętną wielkość współczynnika korelacji pomiędzy
poparciem dla partii (PSL, PiS, PO) a odsetkiem głosów nieważnych.
Wniosek: sympatycy wszystkich partii mylili się podobnie, a ich błąd był
korzystny dla PSL.
Dane, skrypty i reszta wykresów są tutaj. Mapy GFT: poparcie/pgnw/powiaty oraz pgnw/obwody.
Po latach wykonałem analizę (z rozpędu, zmotywowany analizowaniem wyników Danuty Hojarskiej). W województwie pomorskim są dwa okręgi wyborcze: 25 (Gdańsk) oraz 26 Gdynia. Zbiorcze wyniki z protokołów, które w swoim czasie pobrałem ze strony PKW są następujące:
Komisje obwodowe wg ROZKŁADU głosów ważnych ** Okręg 26 126707 ważne głosy ** Kandydat Komitet Głosy Komisje Max % Średnia Me ------------------------------------------------------------- Gromadzki Stonoga 1521 795 12 1.20 1,9 1.0 Furgo Petru 14239 795 224 11.23 17,9 10.00 Zwiercan Kukiz 11801 795 65 9.31 14.8 13.0 Miller Zlew 11524 795 72 9.09 14.5 10.0 Lewna Psl 4644 795 213 3.66 5.8 2.0 Wysocki Korwin 9491 795 54 7.49 11.9 10.0 Biernacki Po 42535 795 312 33.56 53.5 38.0 Szczypińska PiS 30952 795 150 24.42 38.9 35.0 ** Okręg 25 130348 ważne głosy ** Kandydat Komitet Głosy Komisje Max % Średnia Me ------------------------------------------------------------- Hojarska Stonoga 1668 656 152 1.27 2.5 1.0 Lieder Petru 23155 656 256 35.76 35.3 22.0 Błeńska Kukiz 9410 656 45 7.21 14.3 14.0 Senyszyn Zlew 13143 656 75 10.08 20.3 17.0 Sarnowski Psl 3457 656 134 2.65 5.3 2.0 Rabenda Korwin 8903 656 65 6.83 13.6 11.0 Krotowska Razem 6995 656 45 5.36 10.7 9.0 Korol PiS 28657 656 252 21.98 43.7 30.0 Sellin PiS 34960 656 213 26.82 53.3 40.0
Te wyniki mogą (ale nie muszą) się ciut-niewiele różnić od oficjalnych--nie porównywałem
Czyli na przykład pani Hojarska dostała 1668 głosów w 656 komisjach co daje średnio 2,5 głosa/komisję (Mediana 1 głos). Rozkłady liczby głosów przedstawione w postaci wykresów słupkowych wyglądają następująco (pierwsze trzy rysunki to okręg 25, następne trzy to okręg 26):
No i wreszcie przedstawienie wyników na mapie z wykorzystanie Google Fusion Tables link do GFT:
Link do danych jest tutaj.
Rozkład frekwencji i odsetka głosów nieważnych (odpowiednio pierwsza i druga kolumna) w wyborach: do Sejmu 2015, do Parlamentu Europejskiego 2014 oraz słynnych wyborach do Sejmików Wojewódzkich 2014 (trzeci wiersz)
![]() |
![]() |
![]() |
![]() |
![]() |
![]() |
Wydaje mi się że baza protokołów z wyborów samorządowych jest niekompletna, w szczególności protokołów z wyborów do Sejmików Wojewódzkich (SW) powinno chyba być tyle ile jest obwodów czyli 27435, a jest 26495 (96,57%). Nie wiem czemu jest mniej, ale na przykład w Szczecinie przy części komisji obwodowych faktycznie nie ma protokołów z głosowania do SW.
Dane z wyborów samorządowych 2014 (na razie dotyczące tylko frekwencji)
pobrane ze strony http://wybory2014.pkw.gov.pl/pl
są dostępne tutaj. W poprzednich wpisach dotyczących wyborów
podano odnośniki do danych z innych głosowań.
W nawiązaniu do poprzedniego wpisu.
861 komisji obwodowych z ze znaczącym odsetkiem głosów nieważnych (przyjąłem 6% jako wartość progową):
Na pierwszy ogląd, to nie wydaje się żeby w jakimś regionie mieszkali szczególnie niekumaci wyborcy, chociaż Dolny Śląsk/Podlaskie wydają się prezentować najkorzystniej:-)
Ze strony pe2014.pkw.gov.pl ściągnąłem szczegółowe wyniki wyborów do parlamentu europejskiego z 2014 r. Pobrałem protokoły ze wszystkich 27664 komisji obwodowych. Takie protokoły są dostępne pod adresem:
http://pe2014.pkw.gov.pl/pl/wyniki/protokoly/<idGminy><idOkręgu>
Rozkład komisji obwodowych według liczby oddanych głosów:
komisje <- read.csv("komisje-frekwencja.csv", sep = ';', header=T, na.string="NA"); str(komisje); fivenum(komisje$lkw); hist(komisje$lkw, breaks=seq(0, 1250, by=10), freq=TRUE,col="orange",main="Wybory2014: komisje wg liczby oddanych głosów ważnych", xlab="# głosów",ylab="# komisji (N = 27664)",yaxs="i",xaxs="i")
Zależność pomiędzy frekwencją w wyborach do PE a frekwencją w wyborach do Sejmu 2015:
require(ggplot2) d <- read.csv("komisje-frekwencja14_15.csv", sep = ';', header=T, na.string="NA"); # Usuń zagraniczne (jako nietypowe): d <- subset (d, ( teryt != 149901 )); ggplot(d, aes(x = freq)) + geom_point(aes(y = freq15), colour = 'blue') + xlab(label="freq 2014") + ylab(label="freq 2015") ## tylko obwody z liczbą głosów > 20 oraz ## frekwencją większą od 60 d <- subset (d, ( lkw > 20 & lkw15 > 20 & freq > 60 & freq15 > 60)) str(d) 'data.frame': 76 obs. of 19 variables:
Komisji z nietypowo dużą frekwencją (arbitralnie przyjąłem 60%), w których głosowało co najmniej 21 wyborców (też arbitralnie) było 76 (0,2% wszystkich komisji). Okazało się, że praktycznie wszystkie te komisje są zlokalizowane w obwodach ,,specjalnych'' (szpitale, domy pomocy społecznej, areszty itp...)
Zależność pomiędzy odsetkiem głosów nieważnych w wyborach do PE a frekwencją w wyborach do Sejmu 2015:
ggplot(d, aes(x = pgnw)) + geom_point(aes(y = pgnw15), colour = 'blue') + xlab(label="nonvalid 2014 (%)") + ylab(label="nonvalid 2015 (%)")
Zwraca uwagę pewna liczba komisji o bardzo dużej liczbie głosów nieważnych:
d <- read.csv("komisje-frekwencja14_15.csv", sep = ';', header=T, na.string="NA"); # Usuń zagraniczne (nietypowe): d <- subset (d, ( teryt != 149901 )); # Usuń krajowe nietypowe tj.areszty/domy pomocy itp: d <- subset (d, !grepl("Dom pomocy|Domu Pomocy|Areszt|Zakład karny", adres, ignore.case = TRUE)); # Tylko komisje gdzie odsetek gł. nieważnych > 6% d <- subset (d, ( pgnw > 6 & pgnw15 > 6 )); str(d); 'data.frame': 861 obs. of 19 variables:
Komisji z ze znacznym odsetkiem głosów nieważnych (przyjąłem 6% jako wartość progową) było zatem 861 (3%). Trzy procent to nie jest aż tak mało, więc warto by się przyjrzeć im bliżej, ale to nie teraz.
Dane pobrane ze strony
http://pe2014.pkw.gov.pl/pl/
są dostępne
tutaj.
Natomiast
tutaj
znajdują się pobrane ze strony PKW protokoły wyborcze:
1) z wyborów do parlamentu europejskiego 2014r.
2) z wyborów prezydenckich 2015r.
3) z wyborów parlamentarnych 2015r.
oraz
4) z wyborów samorządowych 2014r.
Wszelkie komentarze/uwagi/poprawki mile widziane:-)
Jak ktoś jest zainteresowany, to pobrane ze strony PKW protokoły wyborcze, są dostępne tutaj. Na razie są protokoły z wyborów parlamentarnych 2015 r. oraz (słynnych) wyborów samorządowych 2014 r. -- odpowiednio 224 i 553 Mb (po spakowaniu).
Rozkład komisji obwodowych według liczby oddanych głosów (na podstawie szczegółowych wyników wyborów do Sejmu RP, pobranych ze strony PKW -- por. Web scrapping protokołów wyborczych ze strony PKW):
komisje <- read.csv("komisje_glosy_razem.csv", sep = ';', header=T, na.string="NA"); str(komisje); hist(komisje$glosy, breaks=seq(0, 3200, by=25), col="orange", freq=TRUE,main="Komisje wg liczby oddanych głosów", xlab="# głosów",ylab="# komisji (N = 27859)" ) mtext(text="https://github.com/hrpunio/Data/tree/master/sejm", 4, cex=0.7) text(3200,100, "Me = 495\nQ1 = 265\nQ3 = 782...", 2, cex=0.7, adj=c(0,0)); fivenum(komisje$glosy); quantile(komisje$glosy, c(.10)); quantile(komisje$glosy, c(.05)); quantile(komisje$glosy, c(.90));
Na stronie www.sejm.gov.pl
już dziś pojawiły się
strony o nowowybranych posłach 8 kadencji. Strony można ściągnąć na przykład takim
oto prostym skryptem basha:
#!/bin/bash # Przykładowy URL: http://www.sejm.gov.pl/Sejm8.nsf/posel.xsp?id=002&type=A padtowidth=3 for ((i=1;i<=460;i++)) ; do ## parametr id w URLu ma wartość 001--460 ## za pomocą printf/tricku z padtowidth dodajemy wiodące zera: POSEL=`printf "%0*d\n" $padtowidth $i` wget 'http://www.sejm.gov.pl/Sejm8.nsf/posel.xsp?id='$POSEL'&type=A'\ -O $POSEL.html done
Na stronach na razie jest niewiele informacji, ale jest data urodzenia, liczba zdobytych głosów oraz okręg wyborczy z którego poseł został wybrany. Za pomocą prostych skryptów Perla można wydłubać te dane, dodać informacje o wieku/płci i zapisać w pliku CSV:
imnz;rokur;wiek;klub;miejsce;okreg;glosy;plec Adam Abramowicz;1961-03-10;54;PiS;NA;7 Chełm;10500;M Andrzej Adamczyk;1959-01-04;56;PiS;NA;13 Kraków;18514;M ...
Jak wygląda struktura wiekowa w poszczególnych klubach?
(na poniższym wydruku symbole x.1
, x.2
, x.3
,
x.4
oraz x.5
, to odpowiednio:
wartość minimalna, pierwszy kwartyl,
mediana, trzeci kwartyl oraz wartość maksymalna)
p <- read.csv("Sejm_8_u.csv", sep = ';', header=T, na.string="NA"); boxplot (wiek ~ klub, p, xlab="Klub", ylab="Wiek", col='yellow') aggregate (p$wiek, list(Klub = p$klub), fivenum) aggregate (p$wiek, list(Klub = p$klub), na.rm=TRUE, mean)
A jak wyglądała średnia wieku w poszczególnych kadencjach Sejmu?
p <- read.csv("Sejm1-8.csv", sep = ';', header=T, na.string="NA"); boxplot (wiek ~ kadencja, p, xlab = "Kadencja", ylab = "Wiek", col='yellow') aggregate (p$wiek, list(Kadencja = p$kadencja), fivenum) Kadencja x.1 x.2 x.3 x.4 x.5 1 1991 22.0 37.0 43.0 49.0 70.0 2 1993 24.0 39.0 45.0 50.0 74.0 3 1997 23.0 40.5 46.0 51.0 72.0 4 2001 26.0 43.0 49.0 54.0 78.0 5 2005 23.0 41.0 47.0 53.0 67.0 6 2007 22.0 41.0 48.0 54.0 78.0 7 2011 22.0 42.0 50.0 56.0 73.0 8 2015 23.0 41.5 51.0 59.0 77.0 aggregate (p$wiek, list(Kadencja = p$kadencja), na.rm=TRUE, mean) Kadencja x 1 1991 43.19438 2 1993 45.21535 3 1997 46.42500 4 2001 48.28221 5 2005 46.55230 6 2007 47.32948 7 2011 48.86739 8 2015 49.74783
Dane pobrane ze strony
http://www.sejm.gov.pl/Sejm8.nsf/poslowie.xsp?type=A
są dostępne
tutaj.
Ze strony PKW ściągnąłem szczegółowe wyniki wyborów do Sejmu RP. Szczegółowe w tym sensie, że pobrałem protokoły ze wszystkich 27859 komisji obwodowych. Takie protokoły są dostępne pod adresem:
http://parlament2015.pkw.gov.pl/321_protokol_komisji_obwodowej/IdKomisji
Identyfikatory obwodowych komisji da się pobrać ze strony PKW metodą ,,kolejnych przybliżeń'': najpierw okręgi, potem powiaty, potem gminy a na końcu w każdej gminie lista komisji obwodowych. Ponieważ otrzymałem tyle komisji obwodowych ile podaje PKW (por. tutaj), to zakładam że niczego nie pogubiłem.
Sprawdzenie danych zaczynamy od podsumowanie liczby głosów ważnych, które zostały oddane na kandydatów z każdego komitetu:
Komitet | L.kandydatów | L.głosów | L.głosów* | Różnica | Okr19 | Okr19* | Różnica |
KORWIN | 899 | 722921 | 722999 | 78 | 21757 | 21767 | 10 |
KUKIZ | 839 | 1338610 | 1339094 | 484 | 26546 | 26573 | 27 |
Kongres N. Prawicy | 116 | 4852 | 4852 | 0 | x | x | x |
Razem | 571 | 550343 | 550349 | 6 | 9469 | 9475 | 6 |
Samoobrona | 119 | 4266 | 4266 | 0 | x | x | x |
BRAUN | 202 | 13113 | 13113 | 0 | x | x | x |
JOW Bezpartyjni | 138 | 15184 | 15656 | 472 | x | x | x |
Mniejszość Niemiecka | 24 | 27530 | 27530 | 0 | x | x | x |
Obywatele do Parlamentu | 40 | 1964 | 1964 | 0 | 266 | 266 | 0 |
Ruch Społeczny RP | 59 | 3941 | 3941 | 0 | 186 | 186 | 0 |
STONOGA | 299 | 42668 | 42731 | 63 | x | x | x |
Zjed. dla Śląska | 42 | 18668 | 18668 | 0 | x | x | x |
PETRU | 858 | 1155364 | 1155370 | 6 | 15942 | 15948 | 6 |
PiS | 918 | 5711661 | 5711687 | 26 | 58317 | 58343 | 26 |
PO | 914 | 3661455 | 3661474 | 19 | 32240 | 32259 | 19 |
PSL | 916 | 779874 | 779875 | 1 | 796 | 797 | 1 |
ZLEW | 905 | 1146837 | 1147102 | 265 | 7948 | 7956 | 8 |
Jak widać są rozbieżności (kolumny 3--5).
Po podliczeniu głosów w każdym obwodzie osobno okazuje się, że źródłem problemów jest m.in. okręg #19, w którym liczone są głosy za granicą (kolumna 6--8 w tabeli powyżej). W szczególności brak jest protokołu z komisji 97770 (baza Bagram/Afganistan, por. POLSKA-OKRĘGI-OKRĘG NR: 19-Zagranica-Zagranica) co być może wynika z konieczności zachowania tajemnicy wojskowej. Zakładając, że w Bagram PiS/PO/PSL/Petru/Razem dostały odpowiednio 26/19/1/6/6 głosów, to w przypadku 12 z 17 komitetów wynik się zgadza (problem stanowią KUKIZ, ZLEW, KORWIN, Bezpartyjni i Stonoga).
Drążąc temat wyliczyłem liczbę głosów dla komitetu JOW Bezpartyjni, który zarejestrował listy w 8 okręgach wyborczych:
Nr okręgu | L.głosów | L.głosów* | Różnica |
02 | 2068 | 2540 | 472 |
18 | 1045 | 1045 | 0 |
21 | 1772 | 1772 | 0 |
22 | 2289 | 2289 | 0 |
33 | 2344 | 2344 | 0 |
34 | 1426 | 1426 | 0 |
36 | 1973 | 1973 | 0 |
39 | 2267 | 2267 | 0 |
Zatem całe manko jest w okręgu #02. PKW podaje też stosowne dane w rozbiciu na powiaty (por. tutaj). Przykładowo dla powiatu ząbkowickiego (kod teryt 0224) JOW Bezpartyjni mieli otrzymać 237 głosów. W skład tego powiatu wchodzi 7 gmin, m.in. gmina Bardo (teryt 022401), w której to gminie JOW Bezpartyjni miał otrzymać 14 głosów (por. tutaj). Na terenie gminy Bardo działały 4 obwodowe komisje wyborcze (por. tutaj). W komisji #1 (Centrum Kultury i Promocji Bardo, ul. Kolejowa 12, 57-256 Bardo) na komitet JOW Bezpartyjni oddano 3 głosy. PKW udostępnia też szczegółowy protokół z tejże komisji (por. tutaj) -- wystarczy kliknąć w adres na stronie POLSKA-OKRĘGI-OKRĘG NR: 2-ząbkowicki-Bardo dla wyników komitetu JOW Bezpartyjni. No i na tym protokole każdy z kandydatów JOW Bezpartyjni ma w rubryce Liczba oddanych głosów 0 głosów.
Podsumowując powyższy dłuższy wywód: według protokołu JOW Bezpartyjni zdobył w tym obwodzie 0 głosów, ale według informacji zbiorczej na innej stronie 3 głosy.
Zatem się wyjaśniło że sumując informacje z protokołów komisji nie ma szans na otrzymanie poprawnego wyniku (ale to co mam jest wynikiem prawie dokładym--błąd jest niewielki). Pozostaje tajemnicą PKW dlaczego ich system działa tak pokracznie.
Dane pobrane ze strony
http://parlament2015.pkw.gov.pl/
są dostępne
tutaj. Pliki
komisja_84873_protokol-0.png
--komisja_84873_protokol-4.png
to zrzuty ekranu ilustrujące
,,przypadek JOW Bezpartyjni w gminie Bardo'' opisany wyżej.
Wszelkie komentarze/uwagi/poprawki mile widziane:-)
Komisje z rekordowym poparciem wg komitetów w wyborach do Sejmu (2015). Generalnie to są specyficzne komisje i/lub takie komisje, w których frekwencja była bardzo mała. Poniżej po jednym przykładzie dla 8 wybranych komitetów:
Komitet | %głosów ważnych | Ogółem* | Adres | Id komisji |
KORWIN | 50,0 | 14 | Stowarzyszenie MONAR Ośrodek Leczenia... | 102943 |
KUKIZ | 82,86 | 35 | DPS w Osinach | 106282 |
KW Razem | 40,00 | 5 | NZO Dom Sue Ryder Bydgoszcz | 86967 |
KWW Zbigniewa Stonogi | 36,93 | 417 | Świetlica Wiejska w Lubieszewie | 102231 |
PETRU | 50,00 | 2 | Zespół Zakładów Opieki Zdrowotnej w Nowogrodźcu | 83629 |
PO | 100,00 | 1 | Zakład Opieki Zdrowotnej Świnoujście | 111436 |
PSL | 100,00 | 1 | Lokal Szpitala Pomocy Maltańskiej Oddział w Barczewie | 107560 |
PiS | 100,00 | 57 | DPS w Kurozwękach | 106804 |
ZLEW | 61,29 | 31 | DPS w Nakle/Notecią | 86194 |
Pełna lista dla 25 komisji z najwyższym poparcie dla każdego komitetu jest tutaj albo tutaj.
Poparcie dla trzech najpopularniejszych partii politycznych w komisjach zorganizowanych w zakładach karnych i aresztach śledczych (181 komisji). Procent głosów ważnych:
Województwo | PO | Kukiz | PiS | L. głosów |
pomorskie | 62.3 | 11.5 | 9.3 | 2175 |
dolnośląskie | 55.6 | 13.2 | 10.9 | 2891 |
mazowieckie | 55.5 | 13.1 | 9.5 | 3235 |
warmińsko-mazurskie | 55.4 | 13.4 | 11.6 | 1550 |
lubuskie | 54.4 | 12.5 | 10.7 | 894 |
śląskie | 54.4 | 17.6 | 8.6 | 2869 |
zachodniopomorskie | 54.2 | 13.2 | 10.9 | 1943 |
wielkopolskie | 53.8 | 12.8 | 11.8 | 1790 |
kujawsko-pomorskie | 51.4 | 13.8 | 11.3 | 1734 |
łódzkie | 50.3 | 17.0 | 10.7 | 1522 |
opolskie | 48.9 | 18.1 | 12.6 | 1492 |
małopolskie | 47.2 | 18.2 | 14.0 | 1522 |
lubelskie | 43.4 | 21.1 | 13.6 | 1364 |
podlaskie | 45.9 | 19.3 | 12.3 | 826 |
świętokrzyskie | 41.9 | 22.3 | 14.5 | 523 |
podkarpackie | 40.1 | 18.8 | 15.6 | 959 |
POLSKA | 52.5 | 15.3 | 11.2 | 27289 |
Na podstawie danych pobranych ze strony
http://parlament2015.pkw.gov.pl/
metodą webscrappingu.
Dane są dostępne tutaj.