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))

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) ;

To samo dla woj. pomorskiego:

kandydaci <- subset (kandydaci, (woj == "22" ))
aggregate (kandydaci$wiek, list(Numer = kandydaci$komitet), fivenum)

## itd...

Ś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.

pgnw vs PSL

pgnw vs PiS

pgnw vs PO

Ż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)

pgnw

pgnw vs psl

pgnw vs pis

pgnw vs po

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...

Google Fusion Tables (GFT)

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ą):

duże mapy/dane

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:-)

Rozkład komisji wg. liczby głosów

Frekwencja

Głosy nieważne

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:

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:

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:

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:

Na podstawie danych pobranych ze strony http://parlament2015.pkw.gov.pl/ metodą webscrappingu. Dane są dostępne tutaj.