EU:n lainsäädäntö jakaumana — Osa 3: Implementointiviive täydellä aineistolla

library(tidyverse)
library(here)
library(lubridate)
library(scales)
library(ggtext)
library(patchwork)

col_red    <- "#e63946"
col_green  <- "#2a9d8f"
col_orange <- "#f4a261"
col_navy   <- "#1d3557"
col_blue   <- "#457b9d"

theme_set(
  theme_minimal(base_size = 14) +
    theme(
      plot.title       = element_markdown(face = "bold", size = 15),
      plot.subtitle    = element_markdown(color = "grey40"),
      plot.caption     = element_text(color = "grey55", size = 9),
      axis.title       = element_text(color = "grey30"),
      panel.grid.minor = element_blank()
    )
)

Osassa 2 rakennettiin pohja — tässä osassa syvennetään

Edellisessä osassa osoitimme että kansallisten implementointidokumenttien CELEX-numero sisältää sekä direktiivin tunnisteen että maakodin. Tämä mahdollistaa tarkan viivemittauksen ilman erillisiä linkityshakuja.

Tässä osassa vastataan syvempiin kysymyksiin:

• Mitkä maat ovat johdonmukaisesti myöhässä — ei vain yhtenä vuonna vaan vuosikymmenestä toiseen?
• Onko myöhästyminen pahentunut ajan myötä tietyissä maissa?
• Vaikuttaako direktiiville annettu transposointiaika siihen, miten nopeasti se implementoidaan?

---

Data: ladataan ja yhdistetään

dir_path   <- here("data/eu/eu_dir_raw.rds")
nimpl_path <- here("data/eu/eu_nimpl_raw.rds")

if (!file.exists(dir_path))   stop("Aja ensin osa 1: ", dir_path, " puuttuu.")
if (!file.exists(nimpl_path)) stop("Aja ensin osa 2: ", nimpl_path, " puuttuu.")

raw_dir   <- readRDS(dir_path)
raw_nimpl <- readRDS(nimpl_path)
message("Data ladattu.")

# --- Direktiivit ---
dir_df <- raw_dir |>
  filter(!is.na(celex), !is.na(date)) |>
  mutate(
    date_adopted  = as.Date(date),
    date_transpos = as.Date(datetranspos),
    vuosi_hyvaks  = year(date_adopted),
    transpos_kk   = as.numeric(date_transpos - date_adopted) / 30.44
  ) |>
  filter(vuosi_hyvaks >= 1975, vuosi_hyvaks <= 2023,
         transpos_kk > 0, transpos_kk < 240)

# --- Kansalliset implementoinnit ---
nimpl_df <- raw_nimpl |>
  filter(!is.na(celex), !is.na(date)) |>
  mutate(
    date_impl     = as.Date(date),
    vuosi_impl    = year(date_impl),
    maakoodi      = str_extract(celex, "[A-Z]{2,3}(?=_)"),
    dir_celex_raw = str_extract(celex, "(?<=^7)[0-9]{4}[A-Z][0-9]+"),
    dir_celex     = paste0("3", dir_celex_raw)
  ) |>
  filter(vuosi_impl >= 1986, vuosi_impl <= 2024,
         !is.na(maakoodi), !is.na(dir_celex_raw))

# --- Yhdistäminen ---
viive_df <- nimpl_df |>
  inner_join(
    dir_df |> select(celex, date_adopted, date_transpos,
                     vuosi_hyvaks, transpos_kk),
    by = c("dir_celex" = "celex")
  ) |>
  mutate(
    viive_pv    = as.numeric(date_impl - date_transpos),
    viive_kk    = viive_pv / 30.44,
    myohassa    = viive_pv > 0,
    vuosikymmen = factor(paste0(floor(vuosi_hyvaks / 10) * 10, "-luku")),
    # Transposointiajan ryhmä
    transpos_ryhma = case_when(
      transpos_kk <= 12 ~ "≤12 kk",
      transpos_kk <= 24 ~ "13–24 kk",
      transpos_kk <= 36 ~ "25–36 kk",
      TRUE              ~ ">36 kk"
    ) |> factor(levels = c("≤12 kk", "13–24 kk", "25–36 kk", ">36 kk"))
  ) |>
  filter(!is.na(viive_pv), abs(viive_kk) < 600)

# Maat joilla riittävästi dataa
top_maat <- viive_df |>
  count(maakoodi, sort = TRUE) |>
  filter(n >= 200) |>
  pull(maakoodi)

cat("Direktiivi–maa-pareja:", nrow(viive_df), "\n")

Direktiivi–maa-pareja: 269712 

cat("Maita analyysissa:", length(top_maat), "\n")

Maita analyysissa: 28 

---

Analyysi 1: Maakohtainen trendi vuosikymmenittäin

Yksittäinen maa voi olla historiallisesti myöhässä mutta parantunut viimeksi — tai päinvastoin. Trendi on yhtä tärkeä kuin taso.

viive_df |>
  filter(maakoodi %in% top_maat) |>
  group_by(maakoodi, vuosikymmen) |>
  summarise(
    mediaani = median(viive_kk, na.rm = TRUE),
    n        = n(),
    .groups  = "drop"
  ) |>
  filter(n >= 10) |>
  ggplot(aes(vuosikymmen, mediaani, group = maakoodi)) +
  geom_hline(yintercept = 0, linetype = "dashed",
             color = "grey70", linewidth = 0.5) +
  geom_line(color = col_navy, linewidth = 0.8) +
  geom_point(aes(color = mediaani > 0), size = 2.5, show.legend = FALSE) +
  scale_color_manual(values = c(col_green, col_red)) +
  scale_y_continuous(labels = function(x) paste0(x, " kk")) +
  facet_wrap(~maakoodi, ncol = 4) +
  labs(
    title    = "**Implementointiviiveen trendi** vuosikymmenittäin",
    subtitle = "Vihreä piste = mediaani ajoissa tai etuajassa. Punainen = myöhässä.",
    x = NULL, y = "Mediaaniviive (kuukausia)",
    caption  = "Lähde: EUR-Lex SPARQL via eurlex (R). Kristian Vepsäläinen / kristianvepsalainen.com"
  ) +
  theme(axis.text.x = element_text(angle = 35, hjust = 1, size = 7))

Maakohtainen mediaaniviive vuosikymmenittäin. Vihreä piste = ajoissa. Punainen = myöhässä.

---

Analyysi 2: Johdonmukaisesti myöhässä olevat maat

Mikä maa on ollut myöhässä jokaisella vuosikymmenellä? Johdonmukaisuus on rakenteellinen piirre — ei satunnainen poikkeama.

johdon_df <- viive_df |>
  filter(maakoodi %in% top_maat) |>
  group_by(maakoodi, vuosikymmen) |>
  summarise(
    myohassa_osuus = mean(myohassa, na.rm = TRUE),
    n              = n(),
    .groups        = "drop"
  ) |>
  filter(n >= 20) |>
  group_by(maakoodi) |>
  summarise(
    n_vuosikymm        = n(),
    n_myohassa_vk      = sum(myohassa_osuus > 0.5),
    johdonmukaisuus    = n_myohassa_vk / n_vuosikymm,
    ka_myohassa_osuus  = mean(myohassa_osuus),
    .groups            = "drop"
  ) |>
  arrange(desc(johdonmukaisuus), desc(ka_myohassa_osuus))

cat("Johdonmukaisesti myöhässä olevat maat:\n")

Johdonmukaisesti myöhässä olevat maat:

print(johdon_df)

# A tibble: 28 × 5
   maakoodi n_vuosikymm n_myohassa_vk johdonmukaisuus ka_myohassa_osuus
   <chr>          <int>         <int>           <dbl>             <dbl>
 1 CYP                6             6           1                 0.827
 2 HRV                6             5           0.833             0.806
 3 EST                6             5           0.833             0.763
 4 MLT                6             5           0.833             0.748
 5 BGR                6             5           0.833             0.743
 6 GRC                6             5           0.833             0.685
 7 AUT                6             5           0.833             0.620
 8 SWE                5             4           0.8               0.655
 9 POL                6             4           0.667             0.708
10 ITA                6             4           0.667             0.703
# ℹ 18 more rows

johdon_df |>
  mutate(
    etiketti = maakoodi,
    johdonmukainen = johdonmukaisuus >= 0.75 & ka_myohassa_osuus >= 0.5
  ) |>
  ggplot(aes(ka_myohassa_osuus, johdonmukaisuus)) +
  geom_hline(yintercept = 0.75, linetype = "dashed",
             color = "grey60", linewidth = 0.5) +
  geom_vline(xintercept = 0.5, linetype = "dashed",
             color = "grey60", linewidth = 0.5) +
  geom_point(aes(size = n_vuosikymm, color = johdonmukainen),
             alpha = 0.8, show.legend = FALSE) +
  ggrepel::geom_text_repel(aes(label = etiketti), size = 3.2,
                            max.overlaps = 20) +
  scale_color_manual(values = c(col_blue, col_red)) +
  scale_size_continuous(range = c(3, 7)) +
  scale_x_continuous(labels = percent_format()) +
  scale_y_continuous(labels = percent_format()) +
  annotate("text", x = 0.85, y = 0.95,
           label = "Rakenteellinen\nongelma", color = col_red,
           size = 3.5, fontface = "bold") +
  annotate("text", x = 0.15, y = 0.15,
           label = "Johdonmukaisesti\najoissa", color = col_green,
           size = 3.5, fontface = "bold") +
  labs(
    title    = "**Johdonmukaisuus vs. myöhästymisaste** maittain",
    subtitle = "X = keskimääräinen myöhästymisaste. Y = kuinka usein myöhässä eri vuosikymmeninä.",
    x = "Keskimääräinen myöhästymisaste", y = "Johdonmukaisuus (osuus vuosikymmenistä myöhässä)",
    caption  = "Lähde: EUR-Lex SPARQL via eurlex (R). Kristian Vepsäläinen / kristianvepsalainen.com"
  )

Johdonmukaisuus vs. keskimääräinen myöhästymisaste. Oikeassa yläkulmassa = rakenteellinen ongelma.

---

Analyysi 3: Vaikuttaako annettu transposointiaika viiveeseen?

Intuitio sanoo: pidempi transposointiaika → pienempi viive. Mutta onko tämä totta? Voi olla että tiukka aikataulu pakottaa tehokkuuteen, tai että pitkä aika kertoo jo lähtökohtaisesti hankalasta direktiivistä.

viive_df |>
  slice_sample(n = min(5000, nrow(viive_df))) |>
  ggplot(aes(transpos_kk, viive_kk)) +
  geom_point(alpha = 0.12, size = 0.7, color = col_navy) +
  geom_hline(yintercept = 0, linetype = "dashed",
             color = col_red, linewidth = 0.7) +
  geom_smooth(method = "lm", se = TRUE,
              color = col_orange, fill = col_orange,
              alpha = 0.2, linewidth = 1.1) +
  scale_x_continuous(labels = function(x) paste0(x / 12, " v"),
                     breaks = seq(0, 180, 24)) +
  scale_y_continuous(labels = function(x) paste0(x, " kk"),
                     limits = c(-24, 120)) +
  labs(
    title    = "**Annettu transposointiaika vs. toteutunut viive**",
    subtitle = "Oranssi = lineaarinen sovite. Onko pidempi aika yhteydessä pienempään viiveeseen?",
    x = "Direktiiville annettu transposointiaika",
    y = "Toteutunut viive (kuukausia)",
    caption  = "Lähde: EUR-Lex SPARQL via eurlex (R). Kristian Vepsäläinen / kristianvepsalainen.com"
  )