15  Dostęp do internetu

W tej części stworzymy wykres typu “dumbbell” (lub “slope chart”). Znakomicie nadaje się on do pokazywania zmiany wartości między dwoma punktami w czasie dla wielu kategorii (w naszym przypadku - europejskich państw).

Wykorzystamy zbiór danych dotyczący procentu gospodarstw domowych z dostępem do internetu.

library(tidyverse)
library(here)
library(janitor)

# Wczytujemy dedykowany styl z projektu (choć w tym przypadku mocno go nadpiszemy dla efektu)
source(here("R", "theme_course.R"))
theme_set(theme_course())

15.1 Przetwarzanie danych

Na początku wczytamy plik isoc_r_iacc_h_page_linear_2_0.csv. Następnie wyciągniemy kody państw i przefiltrujemy dane, zostawiając jedynie lata 2006 i 2023, tak jak na wzorze.

df_raw <- read_csv(here("datasets", "isoc_r_iacc_h_page_linear_2_0.csv")) |> 
  clean_names()

df_clean <- df_raw |> 
  select(
    geo = geo_geopolitical_entity_reporting, 
    year = time_period_time, 
    value = obs_value_observation_value
  ) |> 
  # Wyciągamy dwuliterowy kod i nazwę państwa (np. z "AT: Austria")
  separate(geo, into = c("code", "country"), sep = ": ") |> 
  # Odrzucamy regiony - zostawiamy tylko dwuliterowe kody (państwa)
  filter(nchar(code) == 2) |> 
  # Odrzucamy unijne agregaty zbiorcze, np. EA (Strefa Euro), EU
  filter(!code %in% c("EA", "EU")) |> 
  # Zostawiamy interesujące nas lata
  filter(year %in% c(2006, 2023)) |> 
  # Zostawiamy tylko te kraje, które mają odnotowane dane w obu latach
  group_by(country) |> 
  filter(n() == 2) |> 
  ungroup() |> 
  # Sortujemy państwa rosnąco według wyniku z 2023, aby na górze były te z najwyższym
  mutate(
    year = as.factor(year),
    country = fct_reorder(country, value, .fun = max)
  )

# Szukamy "najwyższego" państwa na wykresie, aby nad nim narysować etykiety "2006" i "2023"
top_country <- df_clean |> 
  filter(value == max(value)) |> 
  pull(country) |> 
  as.character()

15.2 Gotowy Wykres

Konstruujemy wykres korzystając z geom_line do linii łączącej oraz geom_point do wyróżnienia poszczególnych lat. Kolory i opcje formatowania dopasowane są do obrazka referencyjnego.

ggplot(df_clean, aes(x = value, y = country)) +
  # Gruba linia łącząca punkty
  geom_line(aes(group = country), color = "#e2e2e2", linewidth = 2.5) +
  
  # Punkty (żółte i czerwone)
  geom_point(aes(color = year), size = 3.5) +
  
  # Etykiety z wartościami dla 2006 (z lewej)
  geom_text(
    data = filter(df_clean, year == "2006"),
    aes(label = value, color = year),
    hjust = 1.3, size = 3.5
  ) +
  
  # Etykiety z wartościami dla 2023 (z prawej)
  geom_text(
    data = filter(df_clean, year == "2023"),
    aes(label = value, color = year),
    hjust = -0.3, size = 3.5
  ) +
  
  # Ręczna "legenda" nad najwyższym państwem
  geom_text(
    data = filter(df_clean, country == top_country, year == "2006"),
    aes(x = value, y = country, label = "2006", color = year),
    vjust = -2, size = 4
  ) +
  geom_text(
    data = filter(df_clean, country == top_country, year == "2023"),
    aes(x = value, y = country, label = "2023", color = year),
    vjust = -2, size = 4
  ) +
  
  # Kolory zbliżone do oryginału
  scale_color_manual(values = c("2006" = "#e2c069", "2023" = "#e46959")) +
  # Rozszerzamy oś X, by tekst "wystający" na krawędziach się nie uciął
  scale_x_continuous(limits = c(5, 105), breaks = seq(20, 100, 20)) +
  # Ze względu na etykiety lat rozszerzamy odrobinę układ u góry
  coord_cartesian(clip = "off") +
  
  labs(
    title = "Percentage of households with internet connection",
    subtitle = "2006 vs 2023\n",
    x = NULL,
    y = NULL
  ) +
  
  # Estetyka (theme) pod oryginalny obrazek
  theme_minimal() +
  theme(
    legend.position = "none",
    plot.title = element_text(face = "bold", size = 20, margin = margin(b = 10)),
    plot.subtitle = element_text(color = "#555555", size = 14, margin = margin(b = 20)),
    plot.margin = margin(t = 20, r = 20, b = 20, l = 20),
    
    # Ukrycie siatki poziomej (zbędna przy nazwach państw)
    panel.grid.major.y = element_blank(),
    panel.grid.minor.y = element_blank(),
    
    # Jasnoszara siatka pionowa kropkowana
    panel.grid.major.x = element_line(color = "#f0f0f0", linetype = "dotted", linewidth = 1),
    panel.grid.minor.x = element_blank(),
    
    # Formaty czcionek
    axis.text.y = element_text(size = 11, color = "#222222"),
    axis.text.x = element_text(size = 11, color = "#999999")
  )