środa, 28 listopada 2018

Podsumowanie listopada

Wizyta w rezerwacie Ptasi Raj (26/10/2018)

Jeszcze formalnie październik, ale warto też wspomnieć w zestawieniu listopadowym, bo byłem pierwszy raz w życiu w rezerwacie PtasiRaj (Sobieszewo w kierunku Górek Zachodnich). Wrażenia pozytywne (przyroda) i negatywne bo coś śmierdziało i hałasowało non stop praktycznie. Ludzi mało, bo zwykły weekday i po sezonie. Hałas był niewielki--bardziej stanowił kontrast pomiędzy pierwotną przyrodą rezerwatu--człowiek myślał że jest w Białowieży a tu coś stuka i wierci w oddali (stocznie a głos po wodzie się niesie). Puściutka-dzika plaża, ale na horyzocie widać Port Północny albo instalacje Lotosu.

Teren zagospodarowany w tym sensie że są wytyczone ścieżki edukacyjne, tablice z opisami flory/fauny, dwie wieże obserwacyjne (lornetkę należy mieć koniecznie) a nawet restauracja (przed rezerwatem oczywiście) Wracając do smrodu, to może dzień był pechowy--też nie tak że jakość strasznie cuchnęło ale było czuć że bynajmniej nie jest to zapach bryzy-od-morza.

Stutthoff -- 1-sza wizyta (27/10/2018)

Pierwszy raz w Niemieckim KL w ogóle (nigdy nie byłem w Auschwitz/Majdanku itp). Nie lubię takich miejsc oglądać ale się reklamowali że jest wystawa czasowa pn `Prawo i zagłada' o roli Policji w Trzeciej Rzeszy w Zbrodniach (jak mniemam) No więc ponieważ interesuję się historią, a temat wydał się ciekawy to postanowiłem pojechać i obejrzeć. Upewniłem się czy w Sobotę działają. Działają tyle że krócej, bo mają imprezę plenerową później.

Jadę (rowerem). Dojeżdżam o 12:20 (wg info mieli działać do 13:00).
-- Wystawa?--no dziś zamknięta
-- Nosz kurna toż się pytałem
-- No to pracujemy ale wystawa zamknięta wyjątkowo bo mamy koncert o 18:00

Czyli typowe w PL-państwówce. Mieli pretekst to sobie poszli do domu o 12.45 (bo już o tej godzinie zamknęli bramę) bynajmniej nie pomagać przy imprezie (która zaczynała się za 5h). Ale jak już tam byłem, to wlazłem na teren. Niewiele tam jest do oglądania--prawie nic. Chyba że coś pominąłem ale raczej nie, by się w oczy rzucało. Nie ma atmosfery grozy miejsca zbrodni--taka łąka a la ośrodek wypoczynkowy tyle że płot z drutem kolczastym. Krematorium niby jest ale teraz to palenie zmarłych nie jest czymś niezwykły, izby w (bodajże czterech) barakach co zostały niezniszczone/albo je odbudowali -- przerobione na sale muzealne, urządzenia sanitarne nieliczne (jedna łazienka konkretnie).

Wiele instalacji (ogród obozowy) ewidentnie nieoryginalna. To co jest to gabloty z papierami i jakimiś drobnymi przedmiotami typu łyżka czy but...

Kopalino #1 (02/11/2018)

Pierwszy raz w życiu--ciekawe miejsce, zwłaszcza po sezonie.

Tutaj są zdjęcia.

Do Jankowa k/Kowal 03/11/2018

Tam w sklepie rowerowym A. Wojtasa (m.in. masażysta Bora-HansGrohe (B-HG)) fajna impreza była, o której się dowiedziałem z FB. Trwało to 2 godziny, w tym czasie właściciel sklepu (czyli Wojtas) opowiedział (w detalach) jak wyglądało odżywianie kolarzy podczas jednego (6 godzinnego) etapu Tirreno-Adriatico (na którym R. Majka zajął 2-gie miejsce BTW). W przerwach między gadaniem gotował ryż (z owocami--przepis na zdjęciu), z którego potem zrobił kostki po 60--70g (25g suchego ryżu podobno). Masa wskazówek jak uzyskać właściwą konsystencję, jak opakować żeby łatwo odpakować na rowerze itp...

Przy okazji wiele ciekawostek opowiedział na przykład na temat diety Sagana (że misie Haribo lubi i makaron z manufaktury Martelli co kosztuje B-HG całkiem okrągłą kwotę), że B-HG ma autobus restauracyjny, tj. kolarze jedzą w autobusie, a nie w hotelu (szybciej i lulu spać), że B-HG ma samochód meblowy i przed etapem taki samochód jedzie do hotelu i wymienia materace, kołdry, itp w pokoju na swoje. Że B-HG zatrudnia 80 ludzi (do obsługi 30 kolarzy) i ma budżet 22mln EUR z czego 4mln idzie na TdF.

Tutaj są zdjęcia.

Sztutowo #2 06/11/2018

Byłem w Sztuthoffie raz jeszcze. Wykorzystałem okazję bo Elka jechała do Łomży to mnie odstawiła do Nowego Dworu Gdańskiego więc praktycznie miałem w jedną stronę podwózkę. Obleciałem cały obóz. Poprzednio pominąłem parę rzeczy typu komora gazowa. Byłem też na tej wystawie co ją chciałem obejrzeć, ale okazała się w sumie lipą. Takie tam Niemieckie bicie się w piersi (jak już wszyscy potencjalnie do oskarżenia nie żyją)--bo wystawa jest Niemiecka. Ogólnie znane fakty; no i mała--kilkanaście plansz.

Ciekawostkowo: nie było ochrony, wlazłem ot tak. Do tej pory jak tam byłem dwa razy bodajże, to zawsze opiernicz od ochrony, że rower, nie wolno itp. Bo jak już się przejdzie przez bramę, to na terenie obozu nie ma żadnego dozoru, tylko napisy że kamery są...

Wystawa niemiecka była w szklarni. Poprzednio jak byłem, to nie mogłem wejść, bo szklarnia była zamknięta. Komuś kurna nie chciało się pójść i zamka przekręcić--bo reszta obozu była dostępna, a szklarnia -- nie wiedzieć czemu -- nie.

Tutaj są zdjęcia

Otwarcie mostu na W. Sobieszewską 10/11/2018

Przypadek polegał na tym że pojechałem celem zwiedzenia rezerwatu ,,Ptasi Raj'' a nie na otwarcie (o którym nie miałem pojęcia). Nawet chciałem poczekać i obejrzeć uroczystość ale chaos był i nie było wiadomo kiedy się zacznie. Otóż organizatorzy nie pomyśleli i moim zdaniem źle zaplanowali otwarcie. Postawili mikrofony na początku mostu i przewidzieli otwarcie-podniesienie jako gwóźdż programu (bo to zwodzony jest most). Widząc tłum na moście kazali ludziom stanąć przed mostem, co znakomicie pozbawiłoby wielu możliwości obejrzenia czegokolwiek. Więc przez 15 minut trwały targi żeby tłum się cofnął, a że się nie cofał to sobie odpuściłem. Tam z boku był plac było tam zrobić przemówienia a potem otworzyć most (na przykład.)

Co do smrodu, to był mniejszy i w innym miejscu. Las przy plaży pełen śmieci i ludzi (bo to sobota była). Za to nie było hałasu ze stoczni...

Tutaj są zdjęcia. A tutaj jest filmik.

Cmentarz francuski (12/11/2018)

Impreza na 100 lecie rozejmu kończącego 1-szą wojnę światową. Ja sie znam z konsulem honorowym rep. Francuskiej (też rowerzysta) to poszedłem z ciekawości. Miał być ambasador i w ogóle...

Przyjechałem grubo za wcześnie, bo mi się godziny pomyliły, ale nie byłem pierwszy. Młody mężczyzna jakiś chodził między grobami w zielonym berecie, ale ubrany w cywilne łachy. Sylwetka sportowa, ogolony łep na rekruta... Oho myślę ochrona ambasadora. Ale potem przyszedł drugi, starszy, o lasce z całą klatą w medalach w takim samym berecie. A potem następny i jeszcze następny, razem z 10 było, w różnym wieku. Się okazało że to Polacy, bo po polsku gadali. No to się przyjrzałem bliżej bo naszywkę każdy miał na ręce:

Legion Entrangere.

O-żesz. Mówili perfekt polszyzną (do siebie bo jak się ustawili do warty to przeszli na francuski) i bez przekleństw, a nie kurwa-kurwa co drugie słowo jak nie przymierzając b. premier Belka. Czyli selekcja jest i byle kogo do Legii nie biorą.

Ciekawostka #2. Były 2 przemówienia: krótsze ambasadora i dłuższe biskupa Głodzia, który pierdyknął mowę na 10 minut (albo i lepiej), ale o czym mówił to ja nie wiem, bo było po francusku... Szczena nie tylko mi chyba opadała bo generalnie ma on nie najlepszą opinię.

Tutaj są zdjęcia.

13/11/2018 Cmentarz angielski

Podobna impreza, ale w Malborku bo tam jest cmentarz Brytyjskiej Wsp. Narodów. Słabiej wypadło. Liczyłem na kobziarzy, a przyszedł tylko pluton w mundurach polowych + pułkownik z ambasady. Orkiestry nie było, tylko na trąbce sygnały grali. Za to miejscowi się starali (a w GDA nie--z UM/Urzędu Wojewódzkiego to ja w GDA nikogo nie widziałem.)

Był jeden kombatant (na zdjęciu), ksiądz anglikański. Po uroczystości Angole złożyli wieniec (z plastikowych maków) na jednym grobie. Pytam się czy to ktoś z ich jednostki (bo tam tradycja -- oddziały po 300 lat istnieją) ale nie rodzina przysłała/dała wieniec to położyli.

Powrót w ulewnym (miejscami) deszczu. Takie były w sumie prognozy ale miałem nadzieję. Jakoś takoś jednak nie przemarzłem (dobra kurtka przeciw deszczowa) i doturlałem się z Malborka do GDA, a tam do SKM-ki bo już mi się nie chciało przez miasto jechać.

Tutaj są zdjęcia

15/11/2018 Kopalino#2/Mechowo

Drugi raz się kopsnąłem w tym kierunku. Pierwszy raz byłem w Grotach Mechowskich. Atrakcja taka sobie--bilet trzeba kupić żeby nie tyle wejść--bo słowo grota to na wyrost jest -- co podejść do groty... Nie kupiłem:-) Spieszyło mi się, poza tym płot jest 5m od groty i jest ażurowy więc widać co jest za płotem...

Tutaj są zdjęcia.

Upgrade roweru

Cichcem zrobiłem upgrade swojej bryki CX kupując koła Campagnolo Vento (drugie od dołu:-) 1100 PLN nowe). Fajne koła za 400 PLN, używane, ale w dobrym stanie. Jeszcze nawet opony dodał gość, ale te akurat 23mm i dupiate (Hutchinson za 40 PLN nowe) w zasadzie do wywalenia, mimo że w dobrym stanie, m.in. dlatego, że ja definitywnie przeszedłem na 25mm.

Ponadto wymieniłem sztycę, bo w starej już dwa razy złamała się śruba mocująca. Niby firmowa (Amoeba), a miała IMO defekt konstrukcyjny: śruby mocujące siodło to zaledwie #5. No ktoś przesadził. Minimum 6mm i się nie łamią. Tu z kolei kupiłem niby karbonowego Ritcheya, a nieoficjalnie chińską podróbkę tegoż (za 170 PLN nie kupi się Richeya). Że chiński to wskazuje także to, że sztyca ma ciut za małą średnicę i się osuwała w rurze podsiodłowej. Okleiłem ją taką taśmą przeciwogniową z warstwą aluminium (klej ma toto dobry) i jakby teraz nie spada...

Jeszcze dokupiłem pedały jednostronne Kellys za 99 (przecenione z 300 PLN na Allegro). Fajne pedały. Wreszcie przypadkiem nowe siodło 4za za 95 PLN (czyli Ridley--żółte do żółtego roweru!) Kiedyś używałem podobnego siodła i się pałąk łamał--kijowe było, ale tamto to był Stratus a to Cirrus (wizualnie to to samo:-). Ten Cirrus to nawet jest tańszy--ale to może i lepiej, bo tańsze to często są trwalsze

Rower waży teraz 9,9kg (opony 35mm, dętki też niczego sobie) co uważam za b. dobry wynik.

niedziela, 4 listopada 2018

Towarzyszka partyjna Widmann ma pomysł

Pełnomocnik rządu federalnego ds. Integracji, Annette Widmann-Mauz (CDU), wzywa do edukacji seksualnej osób ubiegających się o azyl w Niemczech, po tym jak 7 Syryjczyków zostało aresztowanych i oskarżonych o gwałt we Fryburgu.

Ciekawe czemu tylko osób ubiegających się o azyl w Niemczech a nie wszystkich gwałcicieli? Jak równość to równość.

Nb. i celem przypomnienia: jak nam takie Parteigenossinen Widman rajfurzyły tzw. ,,dzieci-z-Aleppo'' to następujące argumenty podnoszono: że jak nie to xenofobia, że jak nie to strzał w stopę bo ubogacenie kulturowe, że jak nie to bezczelna niewdzięczność (forsa wzięta z UE zobowiązuje do wykonywania poleceń centrali--ex Tusk m.in. mówił takie cóś bez ogródek). No to teraz się wyjaśniło, że to co wzielim to by się teraz zwróciło w formie wydatków na bezpieczeństwo i edukację ,,dzieci-z-Aleppo''. Pan Bóg czuwał tym razem nad Polską i wybory 2015 skończyły się jak się skończyły...

sobota, 27 października 2018

Jeden obraz wart więcej niż tysiąc słów

Dla propagandzistów z Wiertniczej/Czerskiej/PolitrukaPL na pewno. Ale tego tam nie zobaczycie bo wtedy ich wyznawcy by dostali rozdwojenia jaźni.

Brakuje tylko Tuska + Bono.

BTW zdjęcie pochodzi ze spotkania w Stambule 27.10.2018 czyli wczoraj (jedyny element dorysowany to oczywiście kretyńskie badge/odznaki pn. KONSTYTUCJA)

czwartek, 25 października 2018

Wybory 2018. Różnica w liczbie mandatów do Sejmików

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

czwartek, 18 października 2018

Śmieciowe sondaże przedwyborcze

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

Wybory wójtów/burmistrzów/prezydentów

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

poniedziałek, 15 października 2018

Czy Platforma Obywatelska to kryptonaziści?

Po występach przewodniczącego Juliusa Schetyny można było mieć wątpliwości, że to jednorazowy amok. Ale znaleźli się wszakże podwładni Juliusa, którzy postanowi pokazać, że są równie mądrzy jak szef, a nawet dużo mądrzejsi. Naprawdę trzeba nie mieć mózgu w ogóle, żeby przerobić Goebbelsowski plakat z podpisem Pracuj z Niemcami a będziesz uratowany i takie coś publikować z dumą na Twitterze. No a przecież wcześniej był/jest w tej partii ważna figura pn. Protasiewicz co się na bagażowym wyżywała we Franfurcie wrzeszcząc na niego Heil Hitler czy jakoś tak. No już trzech mamy KN (kryptonazistów) -- jeszcze dwóch i będzie tylu co w słynnym reportarzu w #WaffelTV, co taką gównoburzę wywołał w styczniu br.

Znamienne jest tak nawiasem mówiąc milczenie takich opertkowych figur jak pan Bodnar (na przykład), który miał gębę pełną frazesów a nawet listy dramatyczne do premiera i ministra sprawiedliwości pisał, kiedy ww. WaffelTV ujawniła ww. groźny spisek 5 idiotów w lesie (Konieczne wydaje się opracowanie nowej, kompleksowej strategii mającej na celu zwalczanie rasizmu i ksenofobii w Polsce -- uważa Rzecznik Praw Obywatelskich, Adam Bodnar) Teraz nie ma problemu operetkowy pan Bodnar, i nie widzi żadnej potrzeby a to zapewne z tej prostej przyczyny, że skończonym idiotą okazał się chłop z ferajny, a nie żaden tam anonimowy zresztą nacjonalista.

Jeżeli ktoś nie wie czemu Juliusz/Julius a nie Grzegorz. Ano temu że, Dr. Goebbels nie tyle wymyślił co udowodnił empirycznie, że kłamstwo powtórzone 1000 razy staje się prawdą. Mianowicie w tekstach publikowanych w gazecie Der Angriff przekręcał systematycznie i uporczywie imię szefa Berlińskiej Policji, określając go Izydorem (co ma/miało żydowskie konotacje w Niemczech podobno), aż większość Berlińczyków faktycznie uznała w końcu, że Bernhard Weiss ma na imię Izydor.

środa, 10 października 2018

Koniec pobierania danych wyborczych

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

wtorek, 2 października 2018

Pobranie danych z wyborów samorządowych 2010

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.

Wybory 2014 i jeszcze więcej rozkładów

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

poniedziałek, 1 października 2018

Wybory samorządowe 2014/2018. Profil wiekowy kandydatów cd

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