Close
Photo by Timon Studler on Unsplash

Będzie nas coraz mniej

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.

Dodatkowe materiały

Leave a Reply

Your email address will not be published. Required fields are marked *