W 2014 roku Główny Urząd Statystyczny wydał publikację zatytułowaną „Prognoza ludności na lata 2014-2050„. Jak zaznaczono we wstępie czas transformacji ustrojowej rozpoczętej w 1989r przyniósł wiele znaczących zmian w zakresie zachowań demograficznych Polek i Polaków. Korzystnym trendom w poziomie umieralności, towarzyszą zmiany wzorca płodności oraz zachowań związanych z tworzeniem i rozpadem związków małżeńskich, a rosnące znaczenie migracji zagranicznych znacząco pogłębia niepomyślen przeobrażenia struktury populacji. Generalnie zachęcam do zapoznania się z dokumentem, gdyż wnioski jakie z niego płyna dla Polski do optymistycznych nie należą. A to jaki wpływ wywiera demografia choćby na giełdę, gospodarkę i inflację można przeczytać tutaj. Zresztą trudno byłoby znaleźć dziedzinę gdzie demografia nie odgrywa roli.
Wróćmy do opracowanego raportu. Jedną z popularnych metod pokazania struktury demograficznej jest przedstawienie populacji w formie wykresu piramidy. Stąd wykorzystując dane zawarte w publikacji zbudujemy krótki skrypt, dzięki któremu program R taką formę wykresu nam przygotuje. Dane bezpośrednio pobierzemy z pliku Excel, stąd skorzystam z biblioteki readxl oraz zestawu bilbliotek zamkniętych w tidyverse.
library(tidyverse)
library(readxl)
# wczytujemy plik z katalogu roboczego
plik <- paste0("00__Polska.xls")
# określamy zawartość komórek do wczytania
df <- as.data.frame(read_excel(plik, sheet = 1, range = "A5:E840", col_names = FALSE))
# przeprowadzamy uporządkowanie i czyszczenie danych
names(df) <- c("Year","Age","Total","Male","Female")
df$Year <- rep(2013:2050,each=22)
df$Age <- factor(df$Age, levels = df$Age, labels = df$Age)
df$Male <- df$Male*(-1)
df <- df[df$Age != 'Ogółem',-3]
a następnie przekształcam uzyskaną tabele do postaci tzw tabeli wąskiej, po to by za chwilę skorzystać z niej przy wyświetlaniu za pomocą biblioteki ggplot2.
df.melt <- df %>% gather(Gender, Value , -Year, -Age)
Do prezentacji struktury demograficznej wybiorę trzy lata: 2017, 2035 oraz 2050.
rok_baza <- 2017
rok_comp <- 2035
rok_last <- 2050
df.melt %>%
filter(Year == rok_baza | Year == rok_comp | Year == rok_last) %>%
arrange(Year, Age) -> df.melt
ggplot(data=df.melt,aes(x=Age,y=Value,fill=Gender)) +
geom_bar(data = subset(df.melt,Gender == "Female"), stat = "identity") +
geom_bar(data = subset(df.melt,Gender == "Male"), stat = "identity") +
scale_y_continuous(breaks = seq(-2000000, 2000000, 500000),
labels = paste0(as.character(c(4:0, 1:4)), "m")) +
coord_flip() +
scale_fill_brewer(palette = "Set1") +
theme_bw() +
facet_wrap(~Year)+
labs(x="Wiek",y="Populacja") +
theme(legend.title = element_blank(),legend.position = "bottom")
Efekt to:
Wnioski: myślę, że widać wyraźnie jak z każdym oknem początkowe wybrzuszenie dzisiejszych 30-39 latków przesuwa się coraz bardziej w górę, przy zawężającej się populacji młodego pokolenia. Zresztą można to jeszcze pokazać na wykresie słupkowym:
df.total <- df[df$Age != 'Ogółem', -c(4,5)]
df.total %>%
filter(Year == rok_baza | Year == rok_comp | Year == rok_last) %>%
ggplot(aes(x=Age,y=Total)) +
geom_bar(stat="identity",fill="pink",colour="black") +
scale_y_continuous(breaks = seq(0, 4000000, 1000000),
labels = paste0(as.character( c(0:4), "m"))) +
facet_wrap(~Year) +
labs(x="Wiek",y="Populacja") +
theme(axis.text.x = element_text(angle = 90, vjust= 0.4))
A jak nie chcecie się bawić sami w budowę wykresów, a jesteście zainteresowani jak przedstawiają prognozy odnośnie struktury demograficznej na świecie zachęcam do odwiedzenia strony
www.populationpyramid.net/pl/polska/
Można tu znaleźć, tak jak wspomniałem piramidy populacji począwszy od roku 1950 aż z prognozą do 2100 roku.
