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

A tak to widzą w FT. Mniej poezji więcej konkretów. Co bardziej kuriozalne tezy wytłuściłem

The intervention of two big EU powers underscores the bloc's internal divisions over the rise of illiberal parties to government in central Europe and elsewhere. = Problemem nie jest są zatem Europejskie Wartości tylko to że nie ci rządzą co trzeba

We hope that Poland acts constructively and does not take actions which cannot be changed afterwards = nie twój zasrany interes Teutonie (zwłaszcza w kontekście poprzedniego zdania)

Tuesday's hearing in Brussels ended inconclusively = kogo zatem to oświadczenie dotyczy? No wygląda że nie PL tylko tych co nie dość entuzjastycznie chcą się dołączyć

Cały (prawie) tekst brzmi jak następuje:

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