Przedstawiciele jakiego zawodu są najczęściej opisywani w Wikipedii? Czy miesiąc urodzenia predysponuje do wykonywania danego zawodu? Czy w polskiej Wiki więcej jest o Polakach czy innych nacjach?
Pomysł
Któregoś dnia, siedzimy w knajpie z J.P. a właściwie z J.A., z okazji jego urodzin. I tak od słowa do słowa pada “a dzisiaj urodziny ma też Putin”. Sprawdzamy w Wikipedii – faktycznie. A oprócz J.A. i Putina urodziny ma cała masa piłkarzy. I aktorów. I to mnie natchnęło – czym zajmują się (albo zajmowali) osoby opisane w Wikipedii? Którego zawodu jest najwięcej? Wydawałoby się, że ludzi kultury, sztuki i polityki – tak by wypadało, bo tak było zawsze w encyklopedii. Sprawdzimy jak jest naprawdę.
Pobranie danych z Wikipedii
Za listę osób posłużą strony poświęcone każdemu z dni roku. Na każdej takiej stronie (pracujemy z polską Wikipedią) mamy sekcje:
- Święta
- Wydarzenia w Polsce
- Wydarzenia na świecie
- Urodzili się
- Zmarli
Nas interesują osoby urodzone danego dnia.
Jeśli technikalia Cię nie interesują – przewiń trochę stronę w dół, do pierwszego wykresu.
Przy pomocy kilku funkcji zawartych w pakietach
1 2 3 4 |
library(tidyverse) library(tidytext) library(stringr) library(lubridate) |
rozpracujemy ten problem. Przygotujemy odpowiednią funkcję, która:
- przygotuje adres strony (na bazie dwóch parametrów – numeru dnia i numeru miesiąca) z Wikipedii
- pobierze tę sronę
- znajdzie odpowiednią sekcję (poświęconą urodzinom)
- wydobędzie z niej listę osób urodzonych, razem z rokiem urodzenia i opisem kim dana osoba jest/była
Funkcja zwróci nam ramkę interesujących nas danych, gotową do dalszej obróbki. Oto i ona, komentarze tłumaczą co i jak:
1 2 3 4 5 6 7 8 9 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 61 |
GetBorn <- function(p_dzien, p_miesiac) { html_offset <- 1 # budujemy urla do wikipedii miesiace <- c("stycznia", "lutego", "marca", "kwietnia", "maja", "czerwca", "lipca", "sierpnia", "września", "października", "listopada", "grudnia") url <- paste0("https://pl.wikipedia.org/wiki/", p_dzien, "_", miesiace[p_miesiac]) # pobieramy odpowiedni kawałek strony page <- read_html(url) page <- page %>% html_node("div.mw-parser-output") # szukamy fragmentu "Urodzili się" urodziny <- page %>% html_children() %>% str_detect("Urodzili się") %>% which(arr.ind = TRUE) %>% .[[length(.)]] # czasem przed listą osób jest coś jeszcze w HTMLu (np. obrazek z Lincolnem 12 lutego) if(page %>% html_children() %>% .[[urodziny + 1]] %>% html_name() != "ul") html_offset <- html_offset + 1 # bierzemy w kolejnych liniach kolejne osoby lista_urodzin <- page %>% html_children() %>% .[[urodziny + html_offset]] %>% html_nodes("li") %>% html_text() # rozdzielamy linie na części składowe: rok, osoba lista_urodzin <- data_frame(opis = lista_urodzin) %>% rowwise() %>% mutate(data = str_sub(opis, 1, 6)) %>% mutate(rok = gsub("[^0-9]", "", data)) %>% mutate(osoba = str_sub(opis, 1 , str_locate(opis, ",")[1]-1)) %>% ungroup() # dla lat gdzie wymienionych jest więcej osób trzeba zrobić wyjątki l_rok <- 0 for(i in 1:nrow(lista_urodzin)) { if(nchar(lista_urodzin[i, "rok"]) == 0) { lista_urodzin[i, "data"] <- "_" # jakiś unikalny znacznik lista_urodzin[i, "rok"] <- l_rok } else { l_rok <- lista_urodzin[i, "rok"] } } # wyczyszczenie zbędnych informacji lista_urodzin2 <- lista_urodzin %>% rowwise() %>% mutate(opis2 = gsub(paste0(osoba, ", "), "", opis, fixed = TRUE)) %>% mutate(opis2 = gsub(" \\(zm. [0-9]*\\)", "", opis2)) %>% mutate(osoba = gsub(data, "", osoba, fixed = TRUE)) %>% mutate(osoba = trimws(gsub("–", "", osoba))) %>% ungroup() %>% filter(!str_detect(data, ":")) %>% mutate(rok = as.numeric(rok)) %>% mutate(dzien = p_dzien, miesiac = p_miesiac) %>% mutate(data = make_date(rok, miesiac, dzien)) %>% select(rok, miesiac, dzien, data, osoba, opis = opis2) return(lista_urodzin2) } |
Teraz trzeba uruchomić ją 366 razy (tyle ile dni w roku, licząc z 29 lutego) i wszystkie wyniki zapisać w jednej tabeli:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
liczba_dni_w_miesiacu <- c(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) tabela <- data_frame() for(miesiac in 1:12) { # dla każdego miesiąca for(dzien in 1:liczba_dni_w_miesiacu[miesiac]) { # i każdego możliwego dnia w tym miesiącu # pobierz dane tabela <- tabela %>% bind_rows(GetBorn(dzien, miesiac)) # progress bar :) - bo trochę to trwa cat(paste("m =", miesiac, "d =", dzien, "\n")) } } rm(dzien, miesiac, liczba_dni_w_miesiacu) |
Przegląd danych
Mamy zgromadzone dane, zobaczmy co w nich jest:
1 2 3 4 |
tabela %>% count(rok) %>% ggplot() + geom_line(aes(rok, n)) |
Wyżej widzimy liczbę osób urodzonych w kolejnych latach. Oczywiście tylko tych wymienionych w Wikipedii.
Widać tutaj pierwszą ciekawostkę: im bliżej teraźniejszości tym więcej osób, o których pisze się na Wiki. To dość naturalne. Postacie historyczne muszą być bardzo interesujące, żeby komuś (szacun dla redaktorów) chciało się tworzyć hasło. Bo czy jakiś burmistrz małego miasteczka z XII wieku jest interesujący? Może wyjątki się znajdą, ale w przeważającej większości raczej nie. A na przykład obecny prezydent Opola już jest – bo człowiek ten występuje gdzieś w przestrzeni publicznej, być może dział PR taki czy inny (z urzędu miasta lub partii, którą reprezentuje) przygotował to hasło. W każdym razie według mnie nie ma nic dziwnego w kształcie powyższej krzywej.
Przybliżmy ją trochę, ograniczając ją od XVIII wieku do teraźniejszości:
1 2 3 4 5 |
tabela %>% filter(rok >= 1700) %>% count(rok) %>% ggplot() + geom_line(aes(rok, n)) |
Im bliżej teraźniejszości tym więcej źródeł informacji. Łatwiej więc przygotować hasło. Ale też rozwój nauki (ogólnopojętej) czy kultury większy – więcej ludzi, tańszy druk, tańszy dostęp do wiedzy (szkoły i uniwersytety, prasa). Wszystko to miało wpływ na szersze grono odbiorców rzeczy, które konkretny człowiek wyprodukował (napisał, namalował, odkrył).
Zobaczmy jak wygląda rozkład liczy urodzonych osób w zależności od dnia i miesiąca urodzenia:
1 2 3 4 5 6 7 8 |
tabela %>% count(miesiac, dzien) %>% ggplot() + geom_tile(aes(miesiac, dzien, fill = n), color = "black", show.legend = FALSE) + scale_y_reverse() + scale_x_continuous(breaks = 1:12) + scale_fill_distiller(palette = "RdYlGn") + theme(legend.position = "bottom") |
Jest stosunkowo równomiernie (przy tej liczbie osób powinno). Pojedyncze czerwone (1 stycznia może być przyczyną złego parsowania wpisów w naszej funkcji pobierającej – napisana jest na szybko, na pewno nie najlepiej jak można) i zielone punkty to być może wyniki błędów przy przekształceniach danych podczas pobierania.
Na razie nie dowiedzieliśmy się niczego ciekawego :) Przejdźmy zatem dalej – spróbujmy wydzielić narodowość i zajęcie poszczególnych osób z ich opisów. Potrzebne będzie
rozbicie opisów na słowa
1 2 3 |
tabela_txt <- tabela %>% unnest_tokens(slowa, opis, token = "words") %>% distinct() |
oraz przygotowanie słowników, bo słowa są różne – przede wszystkim w męskiej i żeńskiej formie (poeta i poetka to to samo zajęcie, dla maszyny jednak inne).
Przygotowanie słownika polegać będzie niestety na obróbce ręcznej. Wybierzemy słowa, które w opisach występują co najmniej sto razy (żeby nie było ich zbyt wiele – możecie wszystkie):
1 |
tabela_slownik <- count(tabela_txt, slowa, sort = TRUE) %>% ungroup() %>% filter(n > 100) |
i zapiszemy je w pliku CSV:
1 |
write_csv2(tabela_slownik, file="slownik.csv") |
Ten słownik przeedytujemy w Excelu. Każde ze słów sprowadzimy do jednego rodzaju (ja sprowadziłem do rodzaju męskiego – więc ze wspomnianej poetki zostaje poeta), a dodatkowo dodałem znacznik czy słowo określa narodowość (literka a) czy zajęcie (literka z).
Teraz można użyć słowników do odpowiedniej zmiany w tabeli z opisami. Najpierw wczytujemy słownik i rozdzielamy na dwa (narodowości i zajęć):
1 2 3 4 5 6 7 8 |
# wczytujemy przeedytowany słownik slownik <- read_csv2("slownik.csv") # słownik zawodów/zajęć zawody <- slownik %>% filter(typ == "z") %>% select(-typ) %>% set_names(c("zawod", "kategoria")) # słownik narodowości narodowosci <- slownik %>% filter(typ == "a") %>% select(-typ) %>% set_names(c("narodowosc", "kraj")) |
a później łączymy je z danymi:
1 2 |
tabela_txt <- left_join(tabela_txt, zawody, by = c("slowa" = "zawod")) tabela_txt <- left_join(tabela_txt, narodowosci, by = c("slowa" = "narodowosc")) |
Dzięki temu zabiegowi możemy zobaczyć o osobach jakich narodowości pisze się najwięcej:
1 2 3 4 5 6 7 |
tabela_txt %>% filter(rok >= 1800) %>% count(rok, kraj) %>% na.omit() %>% ggplot() + geom_line(aes(rok, n, color = kraj), size = 1, show.legend = FALSE) + facet_wrap(~kraj) |
Kliknij w obrazek, żeby zobaczyć go w większej rozdzielczości.
Widać, że wyróżna się oczywiście Polska, Ameryka (w sensie Stany Zjednoczone) oraz europejskie ośrodki kulturalno-naukowo-polityczne (czyli kraje, które mają znaczenie w historii naszej europejskiej cywilizacji): Niemcy, Francja, Włochy czy też Rosja i Anglia (Wielka Brytania). Zobaczmy popularność osób dla tych wybranych narodowości:
1 2 3 4 5 6 7 8 9 10 |
wybrane_kraje <- c("amerykański", "brytyjski", "francuski", "niemiecki", "polski", "rosyjski") tabela_txt %>% filter(rok >= 1800) %>% count(rok, kraj) %>% na.omit() %>% filter(kraj %in% wybrane_kraje) %>% ggplot() + geom_line(aes(rok, n, color = kraj), size = 1) + scale_x_continuous(breaks = seq(1800, 2020, 20)) |
Dominują Polacy i Amerykanie, reszta jest mniej więcej na jednym poziomie. Co ciekawe – młodszych obecnych na Wikipedii mamy więcej Amerykanów niż Polaków. Z czego to wynika? Uprzedzając fakty zdradzę, że z tego jakie zajęcia dominują: aktorzy, piłkarze, osoby znane z pop-kultury. Show bussines w USA jest zdecydowanie większy niż w Polsce, to też tych osób więcej.
Urodzenia według zajęcia
Jak wygląda analogiczny rozkład według zajęcia wykonywanego przez wymienione osoby?
1 2 3 4 5 6 7 8 9 |
tabela_txt %>% filter(rok >= 1800) %>% count(rok, kategoria) %>% na.omit() %>% ggplot() + geom_line(aes(rok, n, color = kategoria), size = 1, show.legend = FALSE) + scale_y_log10() + facet_wrap(~kategoria) + theme(axis.text.x = element_text(angle=90, size = 8)) |
Kliknij w obrazek, żeby zobaczyć go w większej rozdzielczości.
Dla osi pionowej zastosowałem skalę logarytmiczną, dzięki czemu lepiej widać dynamikę zmian. A co widać?
Ano widać to co już wiemy – im bliżej teraźniejszości tym więcej osób. Ale też to, że aktorów przybywa z roku na rok. Mniej więcej stała na przestrzeni lat jest liczba osób zajmujących się naukami ścisłymi (fizyka, matmatyka, biologia, zoolog) czy też humanistycznymi.
W pewnym momencie zaczęły znikać poszczególne zawody: męczennik, jezuita, etnograf, admirał czy święty. To wynika z dwóch rzeczy: po pierwsze już tego typu zajęć się nie praktykuje na skalę która pozwoliłaby znaleźć się w Wikipedii (bo np. wszystko zostało odkryte), a po drugie (co pewnie bardziej prawdopodobnie) – aby dokonać czegoś w danej dziedzinie może potrzeba lat (więc osoby urodzone na przykład w drugiej połowie XX wieku są jeszcze za młode) a może jakiegoś uznania (na przykład tak jest w przypadku świętych).
Z drugiej strony pojawiają się nowe kategorie – szeroko rozumiany sport czy kultura masowa. Taki na przykład model/modelka – ktoś kto pokazuje jak wyglądają ubrania ma swoje hasło w Wikipedii (rozumianej jako nowoczesna encyklopedia) – czujecie to? Dla mnie to jest absurdalne… ale wynika z tego, że ta osoba jest jednoczenie na przykład aktorką (lub aktorem).
Ciekawie widać jeszcze jedną kategorię: zawody, które trwały jakiś czas i się skończyły. Tak jest z kosmonautami, pułkownikami i w dużym uproszczeniu żołnierzami. Ci ostatni wyjdą nam pod koniec tekstu.
Zobaczmy teraz porównanie liczby naukowców, pisarzy, polityków z popkulturą i sportem:
1 2 3 4 5 6 7 8 9 |
wybrane_zawody <- c("aktor", "piłkarz", "pisarz", "polityk", "wolakista", "piosenkarz", "malarz", "fizyk", "matematyk", "filozof") tabela_txt %>% filter(rok >= 1800) %>% count(rok, kategoria) %>% na.omit() %>% filter(kategoria %in% wybrane_zawody) %>% ggplot() + geom_line(aes(rok, n, color = kategoria), size = 1) |
Potwierdzają się wcześniejsze obserwacje i wnioski: liczba przedstawicieli zawodów wymagających wieloletniej pracy i doświadczenia spada im bliżej roku 2017, a ci, którzy osiągają wyniki w młodości (sportowcy, aktorzy i piosenkarze) już są wymieniani w Wikipedii. W długim (sto lat?) terminie teoretycznie może się to wyrównać. Pisarze urodzeni w latach 90-tych nie zdążyli się jeszcze wsławić i pojawić w Wiki. Albo się nie rodzą.
W słownikach warto dodać jeszcze jedną informację, mianowicie dziedzinę danego zajęcia: sport, literatura, polityka, nauki ścisłe, nauki humanistyczne itd. Tak samo można dodać informację o płci. Możecie pobawić się w wolnej chwili.
Najpopularniejsze imiona
Możemy zobaczyć kilka innych przekrojów tych samych danych – na przykład jakie imię występuje naczęściej wśród wymienianych Polaków?
1 2 3 4 5 6 7 8 9 10 |
tabela_txt %>% filter(kraj == "polski") %>% unnest_tokens(txt, osoba) %>% filter(!txt %in% c("de", "von", "van")) %>% count(txt, sort=T) %>% top_n(25, n) %>% mutate(txt = factor(txt, levels = rev(unique(txt)))) %>% ggplot() + geom_col(aes(txt, n), fill = "lightgreen", color = "gray50") + coord_flip() |
Albo to samo dla jednej z najliczniejszych grup – piłkarzy (już globalnie):
1 2 3 4 5 6 7 8 9 10 |
tabela_txt %>% filter(kategoria == "piłkarz") %>% unnest_tokens(txt, osoba) %>% filter(!txt %in% c("de", "von", "van", "el", "al", "da")) %>% count(txt, sort=T) %>% top_n(25, n) %>% mutate(txt = factor(txt, levels = rev(unique(txt)))) %>% ggplot() + geom_col(aes(txt, n), fill = "lightgreen", color = "gray50") + coord_flip() |
W którym miesiącu rodzą się dane zawody?
Wierzycie w horoskopy? Ja nie bardzo, ale sprawdźmy czy znak zodiaku (tutaj w uproszczeniu do miesiąca) w jakiś sposób określa zajęcie wykonywane przez osobę:
1 2 3 4 5 6 7 8 9 10 11 12 13 |
tabela_txt %>% filter(!is.na(kategoria)) %>% count(miesiac, kategoria) %>% group_by(kategoria) %>% mutate(sn = sum(n), p = 100*n/sum(n)) %>% mutate(maxp = max(p)) %>% ungroup() %>% filter(sn > quantile(n, 0.99)) %>% mutate(kategoria = factor(kategoria, levels = rev(unique(kategoria)))) %>% ggplot() + geom_tile(aes(miesiac, kategoria, fill = p), color = "gray50") + scale_x_continuous(breaks = 1:12) + scale_fill_distiller(palette = "RdYlGn") + theme(legend.position = "bottom") |
Wykres powyżej pokazuje tylko 1% najpopularniejszych zawodów. Widać, że duchownymi, biskupami czy arcybiskupami są osoby urodzone głównie w czerwcu. Z kolei prawnicy, premierzy i prezydenci rodzą się w październiku (podobnie jak zapaśnicy). Czy to prowadzi do wniosku, że znak zodiaku określa predyspozycje zawodowe?
Do tej pory korzystaliśmy z danych ułożonych dość specyficznie – w kolumnie kategoria
mamy rozpoznane zawody, w kolumnie kraj
mamy narodowość. Dla przykładu:
1 |
tabela_txt %>% filter(osoba == "Krzysztof Kieślowski") |
Rok | Miesiac | Dzień | Data | Osoba | Słowa | Kategoria | Kraj |
---|---|---|---|---|---|---|---|
1941 | 6 | 27 | 1941-06-27 | Krzysztof Kieślowski | polski | – | polski |
1941 | 6 | 27 | 1941-06-27 | Krzysztof Kieślowski | reżyser | reżyser | – |
1941 | 6 | 27 | 1941-06-27 | Krzysztof Kieślowski | i | – | – |
1941 | 6 | 27 | 1941-06-27 | Krzysztof Kieślowski | scenarzysta | scenarzysta | – |
1941 | 6 | 27 | 1941-06-27 | Krzysztof Kieślowski | filmowy | – | – |
Z takich danych nie jest łatwo wyciągnąć informację czy reżyserów (skoro jesteśmy przy Kieślowskim) jest więcej Polaków czy Amerykanów – nie da się nałożyć filtru kraj == polski
oraz kategoria == reżyser
. A to może być ciekawa obserwacja. Zatem musimy odpowiednio przygotować dane:
1 2 3 4 5 6 7 8 9 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 61 62 63 64 65 |
# unikalne osoby - nie tylko po nazwisku, ale też po dacie urodznia unique_persons <- tabela_txt %>% filter(!is.na(osoba)) %>% select(rok, miesiac, dzien, osoba) %>% distinct() # tutaj będziemy zbierać pełne dane all_persons <- tibble() n <- nrow(unique_persons) # na potrzeby progress bara for(i in 1:n) { # progress bar :) cat(sprintf("\r%d = %.1f%%", i, round(100*i/n, 1))) # tymczasowa tabelka wynik <- tibble() # wybieramy część danych - tylko dla konkretnej osoby tab <- tabela_txt %>% filter(rok == as.numeric(unique_persons[i,"rok"])) %>% filter(miesiac == as.numeric(unique_persons[i,"miesiac"])) %>% filter(dzien == as.numeric(unique_persons[i,"dzien"])) %>% filter(osoba == as.character(unique_persons[i,"osoba"])) if(nrow(tab) > 0) { # unpivot danych tab2 <- tab %>% mutate(kategoria = ifelse(is.na(kategoria), "kategoriaNA", kategoria)) %>% mutate(v = 1) %>% spread(kategoria, v, fill = 0) # jeśli (najczęściej tak, ale nie zawsze) w kategoriach było NA - usuwamy powstałą kolumnę if(sum(colnames(tab2) == "kategoriaNA")) tab2 <- select(tab2, -kategoriaNA) # czy powstały kolumny z unpivotowania? if(ncol(tab2) > 7) { # wyciągamy je z wielu wierszy do jednego wiersza tab2_c <- colSums(tab2[, 8:ncol(tab2)]) %>% as.data.frame() %>% set_names("l") %>% rownames_to_column() %>% spread(rowname, l) # wyciągamy wiersz z wartością w kolumnie kraj tab2 <- tab2 %>% filter(!is.na(kraj)) %>% select(rok, miesiac, dzien, data, osoba, kraj) # jeśli coś zostało - łączymy z kolumnami po unpivocie # (jeden losowy wiersz jeśli do osoby przypisany był więcej niż jeden kraj) if(nrow(tab2) > 0) wynik <- bind_cols(tab2 %>% sample_n(1), tab2_c) } } # łączymy do pełnej tabeli all_persons <- all_persons %>% bind_rows(wynik) # co 1000 iteracji zapisujemy na wszelki wypadek :) if(i %% 1000 == 0) saveRDS(all_persons, file="all_persons_part.RDS") } # zmieniamy NA na 0 w kolumnach określających kategorie all_persons[, 7:ncol(all_persons)][is.na(all_persons[, 7:ncol(all_persons)])] <- 0 # do wykresów potrzebujemy długiej tabeli all_persons_long <- all_persons %>% gather(key = "zawod", value = "Val", -rok, -miesiac, -dzien, -data, -osoba, -kraj) %>% filter(Val != 0) %>% select(-Val) |
Powyższy kod dla każdej unikalnej osoby (zakładamy, że danego dnia urodziła się tylko jedna osoba o danym imieniu i nazwisku) wyciąga kawałek tabelki (taki sam jak wyżej dla Kieślowskiego) i rozkłada wartości kolumny kategoria
w kolejne kolumny. Później wybiera wiersz z niepustą wartością kolumny kraj
i dokłada do niego utworzone kolumny odpowiadające za wykonywane zajęcie. Na pewno da się to zrobić lepiej, a jeśli nie – warto to napisać w C (i wykorzystać pakiet Rcpp
), bo jest straszliwie wolne. Szczególnie w tym przypadku, gdzie mamy informacje o 118869 osobach.
Teraz już możemy sprawdzić z jakiego kraju pochodzą poszczególne zawody:
1 2 3 4 5 6 7 |
all_persons_long %>% count(kraj, zawod) %>% filter(n > quantile(n, 0.97)) %>% ggplot() + geom_tile(aes(kraj, zawod, fill=n), color = "gray50", show.legend = FALSE) + theme(axis.text.x = element_text(angle = 90, vjust = 0, hjust = 1)) + scale_fill_distiller(palette = "YlOrRd", direction = 1) |
Powyżej tylko 3% najpopularniejszych. Widać, że najwięcej narodowości jest wśród polityków i piłkarzy. Widać, że najwięcej mamy amerykańskich aktorów. Wśród Polaków dominują aktorzy, politycy, działacze i pisarze.
Weźmy więc pod lupę Polaków urodzonych w XX i XXI wieku – kogo jest najwięcej?
1 2 3 4 5 6 7 8 9 |
all_persons_long %>% filter(kraj == "polski", rok >= 1900) %>% count(zawod, sort = TRUE) %>% ungroup() %>% top_n(30, n) %>% mutate(zawod = factor(zawod, level=zawod)) %>% ggplot() + geom_col(aes(zawod, n), fill = "lightgreen", color = "gray50") + theme(axis.text.x = element_text(angle = 90, vjust = 0, hjust = 1)) |
Wygrywają aktorzy – w którym roku się urodzili?
1 2 3 4 5 6 |
all_persons_long %>% filter(kraj == "polski", rok >= 1900, zawod == "aktor") %>% count(rok) %>% ggplot() + geom_line(aes(rok, n), color = "blue") + scale_x_continuous(breaks = seq(1900, 2020, 5)) |
Z wykresu wynika, że najwięcej w 1977 roku – kto? Dodajmy od razu opisy bezpośrednio z Wikipedii:
1 2 3 4 5 6 7 |
all_persons_long %>% filter(kraj == "polski", rok == 1977, zawod == "aktor") %>% select(osoba, data) %>% arrange(data) %>% left_join(tabela, by = c("osoba" = "osoba", "data" = "data")) %>% select(osoba, data, opis) %>% arrange(data) |
Imię i nazwisko | Data urodzenia | Opis |
---|---|---|
Grzegorz Stosz | 1977-01-13 | polski aktor |
Tomasz Augustynowicz | 1977-01-22 | polski aktor |
Joanna Litwin | 1977-02-02 | polska aktorka |
Marcin Chochlew | 1977-02-04 | polski aktor |
Anna Sarna | 1977-02-08 | polska aktorka |
Paulina Holtz | 1977-02-23 | polska aktorka |
Piotr Duda | 1977-03-05 | polski aktor, menedżer teatralny |
Piotr Borowski | 1977-03-08 | polski aktor |
Sambor Czarnota | 1977-03-16 | polski aktor |
Katarzyna Glinka | 1977-04-19 | polska aktorka |
Tomasz Kot | 1977-04-21 | polski aktor |
Bodo Kox | 1977-04-22 | polski dziennikarz, reżyser filmowy, aktor |
Daria Widawska | 1977-05-01 | polska aktorka |
Teresa Dzielska | 1977-05-11 | polska aktorka |
Bartłomiej Kasprzykowski | 1977-05-19 | polski aktor |
Patrycja Durska-Mruk | 1977-05-24 | polska aktorka |
Szymon Sędrowski | 1977-06-02 | polski aktor |
Małgorzata Bela | 1977-06-06 | polska aktorka, modelka |
Beata Chruścińska | 1977-06-07 | polska aktorka |
Rafał Drozd | 1977-06-07 | polski aktor, wokalista |
Ewa Andruszkiewicz | 1977-06-09 | polska aktorka |
Sylwia Arnesen | 1977-06-17 | polska aktorka |
Joanna Pokojska | 1977-06-29 | polska aktorka |
Ewelina Serafin | 1977-06-29 | polska aktorka |
Marek Żerański | 1977-07-07 | polski aktor |
Maciej Jachowski | 1977-07-08 | polski aktor, wokalista |
Cezary Jankowski | 1977-07-10 | polski aktor |
Violetta Kołakowska | 1977-07-13 | polska aktorka, modelka, stylistka |
Robert Szykier-Koszucki | 1977-07-18 | polski aktor |
Marcin Piętowski | 1977-07-20 | polski aktor |
Paweł Podgórski | 1977-07-23 | polski aktor, wokalista |
Michał Sitarski | 1977-07-29 | polski aktor |
Roch Poliszczuk | 1977-07-31 | polski wokalista, kompozytor, aktor |
Łukasz Garlicki | 1977-08-05 | polski aktor, reżyser teatralny |
Tomasz Mycan | 1977-08-05 | polski aktor |
Marek Serafin | 1977-08-09 | polski aktor |
Leszek Lichota | 1977-08-17 | polski aktor |
Natasza Urbańska | 1977-08-17 | polska aktorka, piosenkarka, tancerka |
Dominika Łakomska | 1977-09-07 | polska aktorka |
Grzegorz Mielczarek | 1977-09-16 | polski aktor |
Joanna Rossa | 1977-09-17 | polska aktorka |
Ilona Wrońska | 1977-09-17 | polska aktorka |
Dominika Kurdziel | 1977-09-25 | polska perkusistka, kompozytorka, wokalistka, producentka muzyczna, aktorka, reżyserka programów telewizyjnych |
Paweł Gładyś | 1977-09-29 | polski aktor |
Magdalena Emilianowicz | 1977-09-30 | polska aktorka |
Wiktoria Padlewska | 1977-10-04 | polska dziennikarka, pisarka, aktorka |
Gabriela Frycz | 1977-10-15 | polska aktorka |
Dr Yry | 1977-10-18 | polski wokalista, muzyk, kompozytor, aktor |
Mariusz Zaniewski | 1977-10-19 | polski aktor |
Beata Jewiarz | 1977-10-24 | polska aktorka |
Adam Malecki | 1977-11-06 | polski aktor |
Anna Piróg | 1977-12-11 | polska aktorka |
Łukasz Simlat | 1977-12-11 | polski aktor |
Dominik Bąk | 1977-12-19 | polski aktor |
Maja Frykowska | 1977-12-23 | polska prezenterka telewizyjna, aktorka, piosenkarka |
Joanna Banasik | 1977-12-27 | polska aktorka, reżyserka teatralna |
A teraz wrócimy na chwilę do wojskowych (obiecałem to wcześniej). Pojawią się, jeśli poszukamy kto urodził się w kolejnych latach biorąc pod uwagę narodowość radziecką (o ile można tak powiedzieć):
1 2 3 4 5 6 7 8 9 10 11 |
all_persons_long %>% filter(kraj == "radziecki", rok >= 1800) %>% count(rok, zawod) %>% ungroup() %>% group_by(zawod) %>% mutate(key_sum = sum(n)) %>% ungroup() %>% filter(key_sum > quantile(key_sum, 0.5)) %>% ggplot() + geom_tile(aes(rok, zawod, fill = n), color = "gray50", show.legend = FALSE) + scale_fill_distiller(palette = "YlOrRd", direction = 1) |
Sprawdzaliśmy czy miesiąc urodzenia predysponuje do zawodu, ale dane nie były jeszcze gotowe do podziału po narodowościach. Teraz możemy to samo zrobić dla Polaków:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
all_persons_long %>% filter(kraj == "polski") %>% count(miesiac, zawod) %>% ungroup() %>% group_by(zawod) %>% mutate(key_sum = sum(n), p = 100 * n/key_sum) %>% ungroup() %>% filter(key_sum > quantile(key_sum, 0.75)) %>% ggplot() + geom_tile(aes(miesiac, zawod, fill = p), color = "gray50") + scale_x_continuous(breaks = 1:12) + scale_fill_distiller(palette = "YlOrRd", direction = 1) + theme(legend.position = "bottom") |
Senator, samorządowiec, filozof i ekonomista rodzi się najczęściej w czerwcu. Dla danych globalnych w czerwcu były osoby z hierarchii kościelnej (biskupi itd) – u nas biskup i duchowny to raczej październik.
Czy jakieś polskie nazwisko się powtarza?
1 2 3 4 5 6 7 |
all_persons_long %>% filter(kraj == "polski") %>% select(data, osoba) %>% distinct() %>% count(osoba, sort = TRUE) %>% ungroup() %>% filter(n == max(n)) |
Osoba | n |
---|---|
Andrzej Nowak | 5 |
Andrzej Zieliński | 5 |
Jerzy Tomaszewski | 5 |
Spośród tych trzech najczęściej powtarzających się weźmy Andrzeja Nowaka:
1 |
tabela %>% filter(osoba == "Andrzej Nowak") %>% select(osoba, data, opis) %>% arrange(data) |
Osoba | Data urodzenia | Opis |
---|---|---|
Andrzej Nowak | 1935-09-14 | polski lekarz internista |
Andrzej Nowak | 1942-07-04 | polski pianista, członek zespołu Niemen Aerolit |
Andrzej Nowak | 1956-02-07 | polski hokeista |
Andrzej Nowak | 1959-04-09 | polski gitarzysta, członek zespołu TSA |
Andrzej Nowak | 1960-11-12 | polski historyk, publicysta, sowietolog |
W porównaniu z Wikipedią zabrakło nam jeszcze trzech Andrzejów Nowaków: tłumacza, psychologa i lekkoatlety. Dlaczego? Tłumacz urodzony w 1944 roku nie ma podanej dokładnej daty urodzenia (i tym samym nie znajdziemy go zapewne na stronie informującej o wydarzeniach konkretnego dnia), psycholog ma datę urodzenia (12 czerwca), ale nie ma go na stronie poświęconej temu dniu (a to tylko z niej zebraliśmy informacje). Zaś dla lekkoatlety nie ma przygotowanej żadnej strony (więc nie ma jak sprawdzić jakiego dnia się urodził). Pamiętajcie też, że Wikipedia nie uzupełnia automatycznie swoich stron – w przypadku Andrzeja Nowaka psychologa to wyraźnie widać: ktoś przygotował hasło o nim, ale nie wpisał go na listę osób urodzonych 12 czerwca.
A reżyserów w polskiej Wikipedii najwięcej jest polskich, w drugiej kolejności amerykańskich:
1 |
all_persons_long %>% filter(zawod == "reżyser") %>% count(kraj, sort = TRUE) %>% top_n(5, n) |
Narodowość | Liczba osób |
---|---|
polski | 1079 |
amerykański | 861 |
francuski | 234 |
brytyjski | 182 |
niemiecki | 132 |
Z aktorami jest odwtornie (5059 amerykańskich, 3225 polskich).
Na koniec tabelka z najmłodszymi Polakami w każdym z zawodów wymienionych w Wikipedii:
1 2 3 4 5 6 7 8 |
all_persons_long %>% filter(kraj == "polski") %>% group_by(zawod) %>% filter(data == max(data)) %>% ungroup() %>% select(osoba, data, zawod) %>% distinct() %>% arrange(desc(data)) |
Osoba | Data urodzenia | Zawód |
---|---|---|
Mateusz Pawłowski | 2004-06-03 | aktor |
Paweł Teclaf | 2003-06-18 | szachista |
Maja Chwalińska | 2001-10-11 | tenisista |
Martyna Łukasik | 1999-11-26 | siatkarz |
Patryk Wysocki | 1999-09-17 | hokeista |
Karolina Gąsecka | 1999-08-20 | łyżwiarz |
Dawid Jarząbek | 1999-03-03 | narciarz |
Dawid Jarząbek | 1999-03-03 | skoczek |
Dominika Grabowska | 1998-12-26 | piłkarz |
Magdalena Welc | 1998-11-04 | piosenkarz |
Szymon Mazur | 1998-09-02 | lekkoatleta |
Krystian Rempała | 1998-04-01 | żużlowiec |
Alan Banaszek | 1997-10-30 | kolarz |
Julia Kowalczyk | 1997-09-30 | judoka |
Jacek Moczydłowski | 1997-09-19 | producent |
Łukasz Dyczko | 1997-09-15 | saksofonista |
Marcel Ponitka | 1997-08-28 | koszykarz |
Bartłomiej Drągowski | 1997-08-19 | bramkarz |
Natalia Strzałka | 1997-08-04 | zapaśnik |
Ewa Swoboda | 1997-07-26 | sprinter |
Justyna Święs | 1997-04-16 | autor |
Andrzej Rządkowski | 1997-03-04 | florecista |
Sylwia Lipka | 1996-12-12 | prezenter |
Adam Mikołaj Goździewski | 1996-12-05 | pianista |
Rafał Reszelewski | 1996-08-22 | astronom |
Wojciech Wojdak | 1996-03-13 | pływak |
Sofia Ennaoui | 1995-08-30 | biegacz |
Dominik Czaja | 1995-08-12 | wioślarz |
Michał Oleksiejczuk | 1995-02-22 | zawodnik |
Izabella Krzan | 1995-02-14 | model |
Błażej Koza | 1994-07-21 | kompozytor |
Joanna Helena Szymańska | 1994-03-16 | reżyser |
Martyna Buliżańska | 1994-01-06 | poeta |
Zdzisław Pawlik | 1993-08-30 | polityk |
Zdzisław Pawlik | 1993-08-30 | poseł |
Patryk Szymański | 1993-06-05 | bokser |
Dawid Podsiadło | 1993-05-23 | wokalista |
Karolina Owczarz | 1993-02-04 | dziennikarz |
Wojciech Engelking | 1992-10-07 | pisarz |
Wojciech Engelking | 1992-10-07 | publicysta |
Sebastian Szypuła | 1992-09-14 | kajakarz |
Łukasz Rzepecki | 1992-09-05 | samorządowiec |
Piotr Lisek | 1992-08-16 | tyczkarz |
Agnieszka Kaczorowska | 1992-07-16 | tancerz |
Monika Hojnisz | 1991-08-27 | biathlonista |
Quebonafide | 1991-07-07 | raper |
Maciej Marton | 1991-05-01 | pilot |
Tomasz Zieliński | 1990-10-29 | sztangista |
Kinga Gajewska | 1990-07-22 | politolog |
Alexandre Beccuau | 1990-06-05 | rugbysta |
Rafał Kołsut | 1990-05-25 | scenarzysta |
Joanna Linkiewicz | 1990-05-02 | płotkarz |
Mateusz Szeremeta | 1989-04-07 | muzyk |
Jan Mela | 1988-12-30 | działacz |
Zofia Bałdyga | 1987-12-16 | tłumacz |
Piotr Kula | 1987-05-23 | żeglarz |
Radzimir Dębski | 1987-04-30 | dyrygent |
Paweł Oziabło | 1986-10-12 | gitarzysta |
Bartosz Frankowski | 1986-09-23 | sędzia |
Adam Bałdych | 1986-05-18 | skrzypek |
Ajron | 1985-11-09 | operator |
Michał Ligocki | 1985-10-31 | snowboardzista |
Paweł Jaroszewicz | 1985-09-20 | perkusista |
Krzysztof Gonciarz | 1985-06-19 | podróżnik |
Sławomir Archangielski | 1985-04-10 | basista |
Krzysztof Mikołajczak | 1984-10-05 | szpadzista |
Donatan | 1984-09-02 | inżynier |
Dariusz Przybylski | 1984-07-28 | organista |
Marcin Plichta | 1984-07-26 | przedsiębiorca |
Maciej Frączyk | 1984-05-01 | satyryk |
Dorota Masłowska | 1983-07-03 | dramaturg |
Krzysztof Aleksander Janczak | 1983-05-01 | muzykolog |
Łukasz Czapla | 1982-12-08 | strzelec |
Łukasz Śmigiel | 1982-07-01 | wydawca |
Artur Skowronek | 1982-05-22 | trener |
Emade | 1981-12-15 | didżej |
Honza Zamojski | 1981-11-16 | artysta |
Iwona Sobotka | 1981-10-19 | operowy |
Iwona Sobotka | 1981-10-19 | śpiewak |
Władysław Kosiniak-Kamysz | 1981-08-10 | lekarz |
Władysław Kosiniak-Kamysz | 1981-08-10 | minister |
Joanna Roszak | 1981-04-01 | akademicki |
Aleksandra Dziurosz | 1981-01-08 | choreograf |
Karolina Wigura | 1980-10-01 | socjolog |
Paweł Czarnecki | 1980-07-22 | filozof |
Marcin Orliński | 1980-06-06 | krytyk |
Jacek Dehnel | 1980-05-01 | malarz |
Jacek Dehnel | 1980-05-01 | prozaik |
Piotr Zychowicz | 1980-04-27 | historyk |
Dawid Tomaszewski | 1979-11-21 | projektant |
Bartosz Łęczycki | 1979-10-09 | pedagog |
Piotr Ślusarczyk | 1979-08-24 | prawnik |
Mieczysław Kieca | 1979-07-31 | prezydent |
Piotr Nowacki | 1979-06-21 | rysownik |
Łukasz Kurowski | 1979-02-14 | podporucznik |
Adam Orłamowski | 1978-12-26 | ilustrator |
Artur Ziętek | 1978-10-12 | porucznik |
Rafał Wiechecki | 1978-09-25 | ekonomista |
Rafał Wiechecki | 1978-09-25 | adwokat |
Sebastian Kudas | 1978-08-31 | scenograf |
Grzegorz Sudoł | 1978-08-28 | chodziarz |
Przemysław Tarnacki | 1978-05-31 | konstruktor |
Krystyna Beniger | 1978-02-18 | curler |
Andrzej Rzońca | 1977-10-30 | nauczyciel |
Przemysław Dakowicz | 1977-09-21 | eseista |
Przemysław Błaszczyk | 1977-09-11 | senator |
Jan Kaczkowski | 1977-07-19 | duchowny |
Marek Rybiński | 1977-05-11 | misjonarz |
Dawid Kupczyk | 1977-05-10 | bobsleista |
Piotr Piasecki | 1977-04-19 | król |
Piotr Duda | 1977-03-05 | menedżer |
Leszek Blanik | 1977-03-01 | gimnastyk |
Anna Pieńkosz | 1976-12-30 | dyplomata |
Marta Gryniewicz | 1976-12-05 | fotograf |
Tomasz Rożek | 1976-11-30 | fizyk |
Norbert Maliszewski | 1976-06-14 | psycholog |
Tomasz Bagiński | 1976-01-10 | grafik |
Przemysław Owczarek | 1975-10-28 | antropolog |
Tomasz Schreiber | 1975-06-25 | matematyk |
Margareta Budner | 1975-06-11 | chirurg |
Barbara Nowacka | 1975-05-10 | informatyk |
Arkadiusz Protasiuk | 1974-11-13 | wojskowy |
Krzysztof Kaśkos | 1974-10-10 | żołnierz |
Michał Czachowski | 1974-08-22 | architekt |
Jerzy (Mariusz Pańkowski) | 1974-08-04 | biskup |
Paweł Tański | 1974-07-22 | badacz |
Robert Grzywna | 1974-02-08 | major |
Krystian Bala | 1974-01-01 | morderca |
Norbert Wójtowicz | 1972-12-01 | teolog |
Paweł Wojtunik | 1972-06-26 | oficer |
Sławomir Kowal | 1972-04-06 | burmistrz |
Marek Więckowski | 1971-05-11 | geograf |
Iwona Szewczyk | 1970-02-14 | zakonnica |
Agnieszka Kozłowska-Rajewicz | 1969-12-04 | biolog |
Wojciech Lubiński | 1969-10-04 | pułkownik |
Wojciech Grygiel | 1969-04-06 | chemik |
Jerzy Gorbas | 1968-07-31 | rzeźbiarz |
Paweł Wypych | 1968-02-20 | sekretarz |
Grzegorz Gielerak | 1967-10-03 | generał |
Stanisław Ustupski | 1966-11-15 | kombinator |
Katarzyna Szeloch | 1966-04-07 | filolog |
Tomasz Kot | 1966-01-03 | jezuita |
Krzysztof Grzeszczak | 1965-09-17 | teoretyk |
Wojciech Polak | 1964-12-19 | arcybiskup |
Wojciech Polak | 1964-12-19 | metropolita |
Wojciech Polak | 1964-12-19 | prymas |
Beata Szydło | 1963-04-15 | premier |
Radosław Sikorski | 1963-02-23 | marszałek |
Andrzej Depko | 1962-10-24 | neurolog |
Cezary Pazura | 1962-06-13 | komik |
Jerzy Szyłak | 1960-11-08 | naukowiec |
Michał Tomaszek | 1960-09-23 | franciszkanin |
Michał Tomaszek | 1960-09-23 | męczennik |
Bogdan Klich | 1960-05-08 | psychiatra |
Miłosz Martynowicz | 1959-02-27 | taternik |
Wojciech Kajtoch | 1957-04-19 | językoznawca |
Krzysztof Tarnowski | 1956-09-20 | wynalazca |
Witold Zuchiewicz | 1955-12-13 | geolog |
Jerzy Ciechanowicz | 1955-10-09 | archeolog |
Elżbieta Regulska-Chlebowska | 1955-03-16 | etnograf |
Andrzej Ostrowski | 1955-02-04 | kapitan |
Wojciech Kubik | 1953-01-13 | saneczkarz |
Piotr Piasecki | 1952-09-04 | jeździec |
Piotr Naimski | 1951-02-02 | biochemik |
Jerzy Dzik | 1950-02-25 | przyrodnik |
Kazimierz Nycz | 1950-02-01 | kardynał |
Marek Brągoszewski | 1949-06-06 | admirał |
Jerzy Popiełuszko | 1947-09-14 | błogosławiony |
Lech Marchelewski | 1947-02-05 | podpułkownik |
Krzysztof Jędrzejko | 1945-10-10 | botanik |
Czesław Błaszak | 1942-05-05 | zoolog |
Mirosław Hermaszewski | 1941-09-15 | kosmonauta |
Wiesław Barej | 1934-01-22 | fizjolog |
Antoni Sawoniuk | 1921-03-07 | zbrodniarz |
Karol Wojtyła | 1920-05-18 | święty |
Zofia Maria Sapieha-Kodeńska | 1919-10-11 | księżna |
Augustyn Józef Czartoryski | 1907-10-20 | książę |
Ksawery Grocholski | 1903-02-14 | hrabia |
Jan Hołyński | 1890-04-24 | przemysłowiec |
Filip Zaleski | 1836-09-25 | arystokrata |
Maria Augusta Wettyn | 1782-06-21 | księżniczka |
Maria Amalia Wettyn | 1724-11-24 | królowa |
Podobało się? Pokaż znajomym, wrzuć na Wykop czy co tam jeszcze uznasz za stosowne! :)
Można praktykować bycie męczennikiem ;)
The Real Person!
The Real Person!
Słowo wyjaśnienia odnośnie najmłodszego polskiego króla – wzięło się to z linijki:
Piotr Piasecki, polski muzyk, wokalista, kompozytor, autor tekstów, członek zespołów Pogodno i Babu Król