Mini - projekt TGPDS

Przygotowania wstępne

Na początku tego projektu załaduję potrzebne biblioteki wśród których oczywiście główną biblioteką będzie ggplot2 zawarta w tidyverse. Dodatkowo będę korzystał także z bardzo przydatnych w graficznej prezentacji danych bibliotek ggpubr oraz gridExtra.

library(readxl)
library(tidyverse)
library(ggpubr)
library(gridExtra)

Wczytanie danych

Wczytanie danych tym razem nie nastręcza żadnych problemów. Dane, choć zagregowane wczytują się bez większych błędów.

ludnosc <- read_excel("ludnosc.xlsx") %>%
  mutate_at(vars(Nazwa:Rok), fct_inorder)

Liczba ludności w grupach wiekowych

Podział według płci w latach 2015-2018

Przygotowanie danych

Podczas wstępnego przygotowania danych do wizualizacji trzeba było zwrócić szczególną uwagę na poprawność filtrowania tak aby nie mieszać danych z poszczególnych województw z danymi dla całego kraju oraz danych dla poszczególnych płci z danymi ogólnymi. Dodatkowo chcąc przedstawić je w formie udziału procentowego należało dokonać kilku prostych mutacji.

PłećRokProp = ludnosc  %>%
  filter(Nazwa == "POLSKA" & Płeć != "ogółem") %>%
  group_by(Płeć, Rok) %>%
  mutate(prop = Wartość/sum(Wartość)) %>%
  mutate(
    prop = ifelse(Płeć == "kobiety", -prop, prop),
    lab = paste0(round(abs(prop)*100, 1), "%"),
  )

PłećRokPropK = PłećRokProp %>% filter(Płeć == "kobiety")
PłećRokPropM = PłećRokProp %>% filter(Płeć != "kobiety")
scaleLab = c(paste0(seq(20, 0, -5), "%"), paste0(seq(5, 20, 5), "%"))

Wizualizacja danych

Zdecydowałem przedstawić te dane w formie “zdublowanego” histogramu. Na wykresie zaprezentowałem także wartości w formie etykiet tekstowych. Takie przedstawienie danych wymagało jednak uważnego przygotowania osi Y (tutaj oś pozioma).

p = PłećRokProp %>%
  ggplot(aes(Wiek, prop, fill = Płeć)) +
  geom_col() +
  geom_text(aes(label = lab, hjust = -0.3), size = 4, PłećRokPropK) +
  geom_text(aes(label = lab, hjust = 1.2), size = 4, PłećRokPropM) +
  scale_y_continuous(breaks = seq(-.2, .2, .05), labels = scaleLab) +
  coord_flip()+
  facet_wrap(vars(Rok))

p = ggpar(
  p,
  title = paste("Procentowy rozkład ilości kobiet i mężczyzn",
                "w poszczególnych gupach wiekowych w Polce",
                "\nw latach 2015 - 2018"),
  caption = "M. Fiołka",
  xlab = "Grupa wiekowa",
  ylab = "Udział procentowy",
  palette = "jco")
p

Podział według płci w latach 2015-2018 - wartości średnie

Ponieważ dane dla poszczególnych lat były dość zbliżone zdecydowałem się przedstawić wartości średnie na jednym wykresie jednak z uwidocznieniem wilkości zmian dla poszczególnych grup wiekowy w tych czterech latach.

Przygotowanie danych

Tym razem jednak trzeba było wykonać nieco więcej przekształceń danych. Przede wszystkim trzeba było wyliczyć wartości średnie, minimalne i maksymalne dla poszczególnych lat. Szczególną uwagę jednak trzeba było zwrócić na nowy argument .groups funkcji spodsumowującej summarise. Niewłaściwe jego ustawienie może bowiem dać nieoczekiwane wyniki w dalszych mutacjach.

PłećProp = ludnosc  %>%
  filter(Nazwa == "POLSKA" & Płeć != "ogółem") %>%
  group_by(Płeć, Wiek) %>%
  summarise(
    min = min(Wartość),
    max = max(Wartość),
    mean = mean(Wartość), 
    .groups = "drop_last") %>%
  mutate(
    pmin = min/sum(mean),
    pmax = max/sum(mean),
    prop = mean/sum(mean)) %>%
  mutate(
    pmin = ifelse(Płeć == "kobiety", -pmin, pmin),
    pmax = ifelse(Płeć == "kobiety", -pmax, pmax),
    prop = ifelse(Płeć == "kobiety", -prop, prop),
    lab = paste0(round(abs(prop)*100, 1), "%"),
  )

PłećPropK = PłećProp %>% filter(Płeć == "kobiety")
PłećPropM = PłećProp %>% filter(Płeć != "kobiety")

Wizualizacja danych

Prezentację rozstępu dla wartości w poszczególnych grupach wiekowych dla dostępnych lat postanowiłem przedstawić w formie słupków błędów. Na wykresie tak jak powyżej zaprezentowałem także wartości w formie etykiet tekstowych.

p = PłećProp %>%
  ggplot(aes(Wiek, prop, fill = Płeć)) +
  geom_col() +
  geom_text(aes(label = lab, hjust = -0.8), size = 4, PłećPropK) +
  geom_text(aes(label = lab, hjust = 1.8), size = 4, PłećPropM) +
  geom_errorbar(aes(Wiek, ymin=pmin, ymax=pmax), width=0.3, size=1.2) +
  scale_y_continuous(breaks = seq(-.2, .2, .05), labels = scaleLab) +
  coord_flip() +
  theme(legend.position = c(0.16, 0.16))

p = ggpar(
  p,
  title = paste("Średni procentowy rozkład ilości kobiet i mężczyzn",
                "w poszczególnych gupach wiekowych w Polce",
                "\nw latach 2015 - 2018"),
  subtitle = paste("Rozstęp dla każdej z grupy wiekowej ",
                   "dla badanego okresu czasu oznaczono słupkami błędu"),
  caption = "M. Fiołka",
  xlab = "Grupa wiekowa",
  ylab = "Udział procentowy",
  palette = "jco")
p

Liczba ludności w województwach

Podział według płci w latach 2015-2018

Przygotowanie danych

Przygotowując dane dotyczące ludności w poszczególnych województwach postanowiłem przedstawić je w w milionach mieszkańców a nie jak poprzednio w wartościach procentowych, szeregując poszczególne województwa od najliczniej zmieszanego województwa do województwa o najmniejszej liczbie mieszkańców. Aby to wykonać skorzystałem z bardzo dogodnej funkcji fct_reorder z pakietu forcats, który również jest składnikiem pakietu tidyverse.

WojRok = ludnosc  %>%
  filter(Nazwa != "POLSKA" & Płeć != "ogółem") %>%
  group_by(Nazwa, Płeć, Rok) %>%
  summarise(Wartość = round(sum(Wartość)/1e6, 2), .groups = "keep") %>%
  group_by(Płeć, Rok) %>%
  mutate(
    Nazwa = Nazwa %>% fct_reorder(Wartość),
    Wartość = ifelse(Płeć == "kobiety", -Wartość, Wartość))

WojRokK = WojRok %>% filter(Płeć == "kobiety")
WojRokM = WojRok %>% filter(Płeć != "kobiety")
scaleLab = c(seq(5, 0, -1), seq(1, 5, 1))

Wizualizacja danych

Przedstawienie danych w formie “zdublowanych” histogramów wymagało tak jak poprzednio odpowiedniego sformatowania osi Y (tu również osi poziomej). Przeliczenie zaś ilości mieszkańców milionach pozwoliło mi na estetyczną prezentację wartości dla poszczególnych województw (a w nich dla obu płci) w formie czytelnych etykiet tekstowych.

p = WojRok %>%
  ggplot(aes(Nazwa, Wartość, fill = Płeć)) +
  geom_col() +
  geom_text(aes(label = -Wartość, hjust = -.2), size = 3, WojRokK) +
  geom_text(aes(label = Wartość, hjust = 1.2), size = 3, WojRokM) +
  scale_y_continuous(breaks = seq(-5, 5, 1), labels = scaleLab) +
  coord_flip() +
  facet_wrap(vars(Rok))

p = ggpar(
  p,
  title = paste("Ilość kobiet i mężczyzn w poszczególnych",
                "województwach w Polce w latach 2015 - 2018"),
  caption = "M. Fiołka",
  xlab = "Województwo",
  ylab = "Ilość [mln]",
  palette = "jco")
p

Średnia liczba mieszkańców latach 2015-2018

Przygotowanie danych

Przygotowując dane do tej wizualizacji postanowiłem pokazać, poza ilością mieszkańców w poszczególnych województwach, także proporcję dla poszczególnych płci. To wymagało przygotowania dwóch ramek danych.

Woj = ludnosc  %>%
  filter(Nazwa != "POLSKA" & Płeć == "ogółem") %>%
  group_by(Nazwa, Rok) %>%
  summarise(Wartość = sum(Wartość)/1e6, .groups = "keep") %>%
  group_by(Nazwa) %>%
  summarise(mean = mean(Wartość)) %>%
  ungroup() %>%
  mutate(
    Nazwa = Nazwa %>% fct_reorder(mean),
    lab = round(mean, 2))

WojK = ludnosc  %>%
  filter(Nazwa != "POLSKA" & Płeć != "ogółem") %>%
  group_by(Nazwa, Płeć, Rok) %>%
  summarise(Wartość = sum(Wartość)/1e6, .groups = "keep") %>%
  group_by(Nazwa, Płeć) %>%
  summarise(mean = mean(Wartość), .groups = "keep") %>%
  group_by(Nazwa) %>%
  mutate(prop = mean/sum(mean)) %>%
  filter(Płeć == "kobiety") %>%
  mutate(lab = paste0(round(abs(prop)*100, 1), "%")) %>%
  ungroup() %>%
  mutate(Nazwa = Nazwa %>% fct_reorder(mean))

Wizualizacja danych

Moim pierwszym pomysłem było aby te dane przedstawić w formie wykresu kołowego. Jednak dość trudno było by na takim wykresie dodać procentowy podział według płci. Ostatecznie więc pozostałem przy klasycznym wykresie słupkowym.

Do prezentacji procentowego podział według płci wykorzystałem mały “wytrych”. Miejsce podziału oznaczyłem, dość nietypowo słupkiem błędu uzupełniając go odpowiednią etykietą tekstową.

p = Woj %>%
  ggplot(aes(Nazwa, mean, fill= Nazwa)) +
  geom_col(color = "black") +
  geom_text(aes(label = lab, vjust = -.8), size = 4) +
  geom_errorbar(aes(Nazwa, ymin=mean, ymax=mean), WojK, width=.8, size=.2) +
  geom_text(aes(label = lab, vjust = - .6), WojK, size = 3)+
  theme(
    legend.position = "none",
    axis.text.x = element_text(angle=-90, hjust=0, vjust=0))


p = ggpar(
  p,
  title = paste("Średnia ilość mieszkańców w poszczególnych",
                "województwach w Polce w latach 2015 - 2018"),
  subtitle = paste("Z dodatkowym zaznczeniem średniej proporcji",
                   "kobiet do ogółu mieszkańców"),
  caption = "M. Fiołka",
  xlab = "Województwo",
  ylab = "Ilość [mln]")
p

Zmiany procentowe w grupach wiekowych

Na koniec tego mini projektu postanowiłem przygotować jeszcze jedną wizualizację. Wizualizację która przedstawiała by zmiany jakie zaszły w poszczególnych grupach wiekowych pomiędzy rokiem 2015 a rokiem 2018.

Przygotowanie danych

Dla tak postawionego zadania trzeba było wyznaczyć wielkość tych zmian wraz z ich wartością procentową w odniesieniu do wartości w roku 2018, dla każdej z poszczególnych grup wiekowych. Udało się to uzyskać jedną prostą mutacją, jednak wcześniej trzeba było zapewnić odpowiednie sortowanie oraz grupowanie danych.

difto2018 = ludnosc %>%
  filter(Nazwa == "POLSKA") %>%
  group_by(Wiek, Płeć) %>%
  arrange(Wiek, Płeć, desc(Rok)) %>%
  mutate(
    dif_to_2018 = (Wartość[1] - Wartość)/1000,
    prop = 1000*dif_to_2018/Wartość[1],
    labp = paste0(round(abs(prop)*100, 1), "%"),
    labd = round(dif_to_2018, 1)
  ) %>%
  filter(Rok == 2015)

difto2018O = difto2018 %>% filter(Płeć == "ogółem")
difto2018N = difto2018 %>% filter(Płeć != "ogółem")

Wizualizacja danych

Dla tej ostatnie wizualizacji postanowiłem użyć techniki łączenia wykresów możliwej dzięki pakietowi gridExtra. Ponieważ kod przygotowujący odpowiednie wykresy był bardzo mocno zbliżony (różnił się jedynie kilkoma parametrami) całość opakowałem w wygodną własna funkcję o niezbyt wyszukanej nazwie plot1.

Podobnie jak w poprzednich wizualizacjach tu również uzupełniłem wykresy o odpowiednie etykiety tekstowe prezentujące poszczególne wartości.

plot1 = function(df, sizex = 10, sizelab = 3) df %>%
  ggplot(aes(Wiek, prop))+
  geom_col(data=df %>% filter(prop>0), fill = "#336600", alpha = .8)+
  geom_col(data=df %>% filter(prop<0), fill = "#660000", alpha = .8)+
  geom_text(aes(label = labp, vjust = -.6), df %>% filter(prop>0), size = sizelab)+
  geom_text(aes(label = labp, vjust = 1.2), df %>% filter(prop<0), size = sizelab)+
  scale_y_continuous(
    breaks = seq(-.16, .16, .04),
    limits = c(-0.16, .14),
    labels = paste0(seq(-.16, .16, .04)*100, "%"))+
  theme(
    axis.text.x = element_text(size = sizex, angle=-90),
    axis.title.x = element_blank(),
    axis.title.y = element_blank())+
  facet_wrap(vars(Płeć))

pO = difto2018O %>% plot1(10, 4)
pN = difto2018N %>% plot1(8, 3)

fig = ggarrange(pO, pN + font("x.text", size = 10), ncol = 1, nrow = 2)
annotate_figure(
  fig,
  top = text_grob(
    paste("Procentowe różnice ilości osób w poszczególnych grupach",
          "wiekowych pomiędzy rokiem 2015 a rokiem 2018")),
  bottom = text_grob("Grupa wiekowa"),
  left = text_grob("Różnica [%]", rot = 90),
)

Wnioski końcowe

Przygotowując jakąkolwiek wizualizację danych trzeba bardzo dobrze zastanowić się jakie wartości chcemy prezentować i jaka forma tej prezentacji będzie najbardziej odpowiednia. Nie należy jednak zapominać o właściwym przygotowaniu samych danych, które zamieramy wizualizować. Bardzo łatwo bowiem o przeoczenie potrzebnych podsumowań czy zastosowaniu odpowiedniego filtra, co może prowadzić do trudnych do dostrzeżenia na samej wizualizacji błędów. Warto także dokładnie zapoznać się z wszystkimi możliwościami stosowanego przez nas pakietu do wizualizacji danych. Bardzo popularny pakiet ggplot2 daje ogromne możliwości i pozwala na tworzenie bardzo estetycznych i przejrzystych wykresów. Elastyczność ta jest jego największa zaletą, przebijającą jakiekolwiek zamknięte oprogramowanie. Tylko dobre zapoznanie się z tym pakietem, poparte na dodatek własną praktyką przyniesie największe korzyści i pozwoli nam na swobodne prezentowanie tego co dla nas istotne, w takiej formie w jakiej sobie tylko wymyślimy.

Osobiście korzystam z bardzo dobrych opracowań które znaleźć można na stronie STHDA.