allek <- init |> filter(tyyppi %in% c("LA","TPA"), vpvuosi >= KAUSI_ALKU) |>
  select(id, allekirjoittajat) |>
  mutate(n_allek = map_int(allekirjoittajat, length)) |>
  filter(n_allek >= 2, n_allek <= MAX_ALLEK) |>
  select(id, allekirjoittajat) |> unnest(allekirjoittajat) |>
  filter(!is.na(allekirjoittajat)) |> rename(henkilo_nro = allekirjoittajat)
stopifnot("Allekirjoituksia ei löytynyt kaudelta" = nrow(allek) > 100)

# Parit per aloite -> painotetut reunat
parit <- allek |> group_by(id) |>
  summarise(p = list(as_tibble(t(combn(sort(unique(henkilo_nro)), 2))) |>
                       set_names(c("a","b"))), .groups = "drop") |>
  unnest(p)
reunat <- parit |> count(a, b, name = "paino") |> filter(paino >= KYNNYS)
stopifnot("Kynnyksen jälkeen ei reunoja — laske KYNNYS" = nrow(reunat) > 0)

# Vain solmut, joilla jää reuna; puolue väritietona
kaytetyt <- unique(c(reunat$a, reunat$b))
solmut <- tibble(henkilo_nro = kaytetyt) |>
  left_join(mp |> select(henkilo_nro, nimi, ryhma_nyt), by = "henkilo_nro") |>
#korjataan kaksi nimiea oikeisiin puolueisiin
  mutate(ryhma_nyt = case_when(henkilo_nro == 1387 ~ 'Vihreä eduskuntaryhmä',
                               henkilo_nro == 1400 ~ 'Vasemmistoliiton eduskuntaryhmä',
                               T ~ ryhma_nyt))

g <- tbl_graph(nodes = solmut, edges = reunat |> rename(from = a, to = b),
               directed = FALSE) |>
  activate(nodes) |>
  mutate(yhteiso = as.factor(group_louvain(weights = paino)),
         aste = centrality_degree(weights = paino))

n_yht <- nlevels(pull(g, yhteiso) )
ggraph(g, layout = "kk", weights = paino) +
  geom_edge_link(aes(width = paino), alpha = .10, color = "grey55") +
  geom_node_point(aes(color = yhteiso, size = aste)) +
  scale_edge_width(range = c(.1, 1.5), guide = "none") +
  scale_size(range = c(1.5, 8), guide = "none") +
  scale_color_manual(values = yhteiso_varit(n_yht), guide = "none") +
  labs(title = "Eduskunnan allekirjoitusverkosto (2023–2027)",
       subtitle = "Väri = tiivis yhteistyöryhmä (Louvain), koko = kytkeytyneisyys") +
  theme_graph()

# Sama verkosto, väri puolueen mukaan — vertaa: noudattavatko yhteisöt puoluerajoja?
n_pue <- n_distinct(pull(g, ryhma_nyt))
ggraph(g, layout = "kk", weights = paino) +
  geom_edge_link(alpha = .08, color = "grey60") +
  geom_node_point(aes(color = ryhma_nyt, size = aste)) +
  scale_size(range = c(1.5, 8), guide = "none") +
  scale_color_manual(values = yhteiso_varit(n_pue), na.value = "grey70") +
  labs(title = "Sama verkosto puolueväreillä",
       subtitle = "Jos yhteisöt eivät seuraa värejä, yhteistyö ylittää puoluerajat",
       color = NULL) +
  theme_graph()

e <- reunat |>
  left_join(mp |> select(henkilo_nro, ra = ryhma_nyt), by = c("a"="henkilo_nro")) |>
  left_join(mp |> select(henkilo_nro, rb = ryhma_nyt), by = c("b"="henkilo_nro")) |>
  filter(!is.na(ra), !is.na(rb))
havaittu <- mean(e$ra != e$rb)

puolueet <- mp |> filter(henkilo_nro %in% c(e$a, e$b)) |> distinct(henkilo_nro, ryhma_nyt)
perm <- replicate(1000, {
  sek <- puolueet |> mutate(r = sample(ryhma_nyt))
  e2 <- e |> left_join(sek |> select(henkilo_nro, ra2 = r), by = c("a"="henkilo_nro")) |>
    left_join(sek |> select(henkilo_nro, rb2 = r), by = c("b"="henkilo_nro"))
  mean(e2$ra2 != e2$rb2)
})
tibble(havaittu_ylitys = round(havaittu,3),
       nollamalli_ka = round(mean(perm),3),
       p = round(mean(perm <= havaittu),3),
       tulkinta = if_else(havaittu < mean(perm),
                          "Vähemmän puoluerajan ylityksiä kuin sattumalta (yhteistyö puolueen sisäistä)",
                          "Enemmän puoluerajan ylityksiä kuin sattumalta"))

sahko <- liitokset |>
  left_join(select(afir_asemat, avain, op_id, op_nimi), by = "avain") |>
  mutate(
    # Kolmivaihevirralla teho = jännite × virta × √3
    kerroin = if_else(virta == "AC_3_PHASE", sqrt(3), 1),
    laskettu_kw = volttia * ampeeria * kerroin / 1000,
    suhde = if_else(laskettu_kw > 0, teho_kw / laskettu_kw, NA_real_),
    puuttuva_sahko = is.na(volttia) | is.na(ampeeria) |
                     volttia == 0 | ampeeria == 0
  )

stopifnot(
  "Suhdeluku puuttuu useammalta kuin puolelta riveistä" =
    mean(is.na(sahko$suhde)) < 0.5
)

sahko_op <- sahko |>
  filter(virta == "AC_3_PHASE") |>
  group_by(op_id, op_nimi) |>
  summarise(
    n = n(),
    puuttuvia = mean(puuttuva_sahko),
    mediaanisuhde = median(suhde, na.rm = TRUE),
    .groups = "drop"
  ) |>
  arrange(desc(n))

puuttuvat_taulu <- sahko |>
  group_by(op_id, op_nimi) |>
  summarise(n = n(), nollia = sum(puuttuva_sahko), .groups = "drop") |>
  filter(nollia > 0) |>
  mutate(osuus = nollia / n) |>
  arrange(desc(nollia))

osuus_nollia <- mean(sahko$puuttuva_sahko)

tehot <- liitokset |>
  filter(!is.na(teho_kw), teho_kw > 0) |>
  left_join(select(afir_asemat, avain, op_id, op_nimi, kunta), by = "avain")

# Kuinka kasautunutta jakauma on? Jos muutama arvo kattaa suuren osan
# havainnoista, keskiarvo on erityisen harhaanjohtava.
kasautuma <- tehot |>
  count(teho_kw, sort = TRUE) |>
  mutate(osuus = n / sum(n), kumulatiivinen = cumsum(osuus))

top10_osuus <- kasautuma$kumulatiivinen[min(10, nrow(kasautuma))]
n_uniikkeja <- nrow(kasautuma)

keskiarvo <- mean(tehot$teho_kw)
mediaani  <- median(tehot$teho_kw)
osuus_lahella_keskiarvoa <- mean(abs(tehot$teho_kw - keskiarvo) < 2)

kapasiteetti_op <- tehot |>
  group_by(op_id, op_nimi) |>
  summarise(
    pistokkeita = n(),
    kw_yhteensa = sum(teho_kw),
    hpc_kw = sum(teho_kw[teho_kw >= 150]),
    .groups = "drop"
  ) |>
  arrange(desc(kw_yhteensa))

# Gini-kerroin: 0 = täysin tasainen, 1 = kaikki yhdellä toimijalla
gini <- function(x) {
  x <- sort(x[!is.na(x)])
  n <- length(x)
  if (n < 2 || sum(x) == 0) return(NA_real_)
  sum((2 * seq_len(n) - n - 1) * x) / (n * sum(x))
}

# Herfindahl-indeksi: markkinaosuuksien neliöiden summa
hhi <- function(x) {
  s <- x / sum(x)
  sum(s^2)
}

gini_kw  <- gini(kapasiteetti_op$kw_yhteensa)
gini_lkm <- gini(kapasiteetti_op$pistokkeita)
hhi_kw   <- hhi(kapasiteetti_op$kw_yhteensa)

# Epävarmuus bootstrapilla: otetaan pistokkeista toistuvia otoksia
# ja lasketaan Gini uudelleen. Näin nähdään, kuinka herkkä luku on.
boot_gini <- map_dbl(1:2000, function(i) {
  otos <- tehot |> slice_sample(n = nrow(tehot), replace = TRUE)
  otos |>
    group_by(op_id) |>
    summarise(kw = sum(teho_kw), .groups = "drop") |>
    pull(kw) |>
    gini()
})

gini_vali <- quantile(boot_gini, c(0.025, 0.975), na.rm = TRUE)

kok_kw <- sum(tehot$teho_kw)
n_pist <- nrow(tehot)
n_kuntia <- n_distinct(tehot$kunta)

# Todellinen: kapasiteetti kunnittain
todellinen <- tehot |>
  group_by(kunta) |>
  summarise(kw = sum(teho_kw), .groups = "drop")

# Skenaario A: sama kokonaisteho jaettuna tasan kaikkien kuntien kesken
skenaario_tasa <- tibble(
  kunta = todellinen$kunta,
  kw = kok_kw / n_kuntia
)

# Skenaario B: kaikki pistokkeet olisivat 22 kW (nopea AC)
# – sama pistokemäärä, kapasiteetti muuttuu
skenaario_ac <- todellinen |>
  left_join(count(tehot, kunta, name = "n"), by = "kunta") |>
  mutate(kw = n * 22) |>
  select(kunta, kw)

# Skenaario C: sama kokonaisteho, mutta jaettuna pistokemäärän suhteessa
skenaario_suhde <- todellinen |>
  left_join(count(tehot, kunta, name = "n"), by = "kunta") |>
  mutate(kw = kok_kw * n / n_pist) |>
  select(kunta, kw)

vertailu <- bind_rows(
  todellinen      |> mutate(skenaario = "Todellinen"),
  skenaario_tasa  |> mutate(skenaario = "A: tasan kunnittain"),
  skenaario_ac    |> mutate(skenaario = "B: kaikki 22 kW"),
  skenaario_suhde |> mutate(skenaario = "C: pistokemäärän suhteessa")
)

gini_skenaariot <- vertailu |>
  group_by(skenaario) |>
  summarise(gini = gini(kw), kok_kw = sum(kw), .groups = "drop") |>
  arrange(gini)

stopifnot(
  "Skenaarion kokonaisteho poikkeaa todellisesta yli 1 %" =
    all(abs(gini_skenaariot$kok_kw[gini_skenaariot$skenaario != "B: kaikki 22 kW"] /
              kok_kw - 1) < 0.01)
)

library(here)
library(sf)
library(dplyr)
library(tidyr)
library(purrr)
library(ggplot2)
library(ggdist)
library(scales)
library(patchwork)
library(giscoR)
library(httr2)
library(jsonlite)
library(qs2)

# Puolustuksellinen maskauksenesto (MASS, igraph yms. voivat varastaa nämä)
select <- dplyr::select
filter <- dplyr::filter

source(here("R", "theme_kristian.R"))

DATA_DIR <- here("data", "karttaprojektiot")
if (!dir.exists(DATA_DIR)) dir.create(DATA_DIR, recursive = TRUE)

set.seed(20260909)

# Maapallon keskimääräinen säde metreinä (IUGG:n auktorisoitu keskisäde R_1).
# Käytetään palloa, ei ellipsoidia: projektioiden vertailussa pallo on oikea
# vertailukohta, ja osa projektioista (esim. Winkel Tripel) on määritelty
# vain pallolle.
R_MAA <- 6371007

CRS_PALLO <- "+proj=longlat +R=6371007 +no_defs"

# Vertailtavat projektiot. Kaikissa sama säde ja sama keskimeridiaani (Greenwich),
# jotta vertailu on reilu.
PROJEKTIOT <- c(
  "Mercator"        = "+proj=merc     +lon_0=0 +R=6371007 +no_defs",
  "Gall-Peters"     = "+proj=cea +lat_ts=45 +lon_0=0 +R=6371007 +no_defs",
  "Mollweide"       = "+proj=moll     +lon_0=0 +R=6371007 +no_defs",
  "Eckert IV"       = "+proj=eck4     +lon_0=0 +R=6371007 +no_defs",
  "Equal Earth"     = "+proj=eqearth  +lon_0=0 +R=6371007 +no_defs",
  "Robinson"        = "+proj=robin    +lon_0=0 +R=6371007 +no_defs",
  "Winkel Tripel"   = "+proj=wintri   +lon_0=0 +R=6371007 +no_defs",
  "Natural Earth"   = "+proj=natearth +lon_0=0 +R=6371007 +no_defs",
  "Plate carree"    = "+proj=eqc      +lon_0=0 +R=6371007 +no_defs"
)

# Luokittelu myöhempää tulkintaa varten
PROJ_TYYPPI <- c(
  "Mercator"      = "konforminen",
  "Gall-Peters"   = "pinta-alatarkka",
  "Mollweide"     = "pinta-alatarkka",
  "Eckert IV"     = "pinta-alatarkka",
  "Equal Earth"   = "pinta-alatarkka",
  "Robinson"      = "kompromissi",
  "Winkel Tripel" = "kompromissi",
  "Natural Earth" = "kompromissi",
  "Plate carree"  = "kompromissi"
)

stopifnot(setequal(names(PROJEKTIOT), names(PROJ_TYYPPI)))

laske_vaaristymat <- function(lonlat, crs_kohde, R = R_MAA, delta_deg = 1e-4) {

  stopifnot(is.matrix(lonlat), ncol(lonlat) == 2)
  # Reunaehdot: numeerinen derivaatta ei saa ylittää päivämäärärajaa eikä napoja,
  # koska PROJ kiertää pituusasteen takaisin ja derivaatta hyppäisi.
  stopifnot(all(abs(lonlat[, 1]) <= 179.9), all(abs(lonlat[, 2]) <= 89.5))

  d <- delta_deg
  proj_apu <- function(m) sf::sf_project(CRS_PALLO, crs_kohde, m, keep = TRUE)

  pI <- proj_apu(cbind(lonlat[, 1] + d, lonlat[, 2]))   # itään
  pL <- proj_apu(cbind(lonlat[, 1] - d, lonlat[, 2]))   # länteen
  pP <- proj_apu(cbind(lonlat[, 1], lonlat[, 2] + d))   # pohjoiseen
  pE <- proj_apu(cbind(lonlat[, 1], lonlat[, 2] - d))   # etelään

  # Askel radiaaneina (keskeisdifferenssi -> 2 * delta)
  askel <- 2 * d * pi / 180
  phi   <- lonlat[, 2] * pi / 180
  cphi  <- cos(phi)

  # Osittaisderivaatat kartan koordinaateille
  dx_dlam <- (pI[, 1] - pL[, 1]) / askel
  dy_dlam <- (pI[, 2] - pL[, 2]) / askel
  dx_dphi <- (pP[, 1] - pE[, 1]) / askel
  dy_dphi <- (pP[, 2] - pE[, 2]) / askel

  # Jacobin matriisi suhteessa pallon PAIKALLISEEN ortonormaaliin kehykseen:
  # itä-suunnan kaarenpituus on R*cos(phi)*dlambda, pohjois-suunnan R*dphi.
  J11 <- dx_dlam / (R * cphi); J21 <- dy_dlam / (R * cphi)
  J12 <- dx_dphi / R;          J22 <- dy_dphi / R

  # J^T J:n alkiot -> singulaariarvot analyyttisesti (2x2, ei tarvita svd-silmukkaa)
  Ee <- J11^2 + J21^2
  Gg <- J12^2 + J22^2
  Ff <- J11 * J12 + J21 * J22
  jalki <- Ee + Gg
  det2  <- Ee * Gg - Ff^2

  diskr <- pmax(jalki^2 - 4 * det2, 0)          # numeerinen suoja
  lam1  <- (jalki + sqrt(diskr)) / 2
  lam2  <- pmax((jalki - sqrt(diskr)) / 2, 0)

  a <- sqrt(lam1)                                # Tissot'n soikion pitkä puoliakseli
  b <- sqrt(lam2)                                # lyhyt puoliakseli

  tibble(
    lon        = lonlat[, 1],
    lat        = lonlat[, 2],
    a          = a,
    b          = b,
    pinta_ala  = sqrt(pmax(det2, 0)),            # a * b
    omega      = 2 * asin(pmin((a - b) / (a + b), 1)) * 180 / pi
  )
}

polku_maat <- file.path(DATA_DIR, "maat.qs")

if (!file.exists(polku_maat)) {
  maat_raaka <- giscoR::gisco_get_countries(
    year       = "2020",
    resolution = "20",
    epsg       = "4326"
  )
  qs2::qs_save(maat_raaka, polku_maat)
}
maat_raaka <- qs2::qs_read(polku_maat)

stopifnot(all(c("ISO3_CODE", "NAME_ENGL") %in% names(maat_raaka)))
stopifnot(nrow(maat_raaka) > 200)

# Mannerluokitus giscoR:n omasta koodikirjasta
koodit <- giscoR::gisco_countrycode |>
  select(ISO3_CODE, continent, un.region.name) |>
  distinct(ISO3_CODE, .keep_all = TRUE)

MANNER_FI <- c(
  "Africa" = "Afrikka", "Asia" = "Aasia", "Europe" = "Eurooppa",
  "Americas" = "Amerikat", "Oceania" = "Oseania", "Antarctica" = "Antarktis"
)

maat <- maat_raaka |>
  left_join(koodit, by = "ISO3_CODE") |>
  mutate(
    manner_en = coalesce(continent, un.region.name),
    manner    = unname(MANNER_FI[manner_en])
  ) |>
  filter(!is.na(manner), ISO3_CODE != "ATA")   # Antarktis erikseen, ks. alla

# Antarktis on poistettu, koska Mercatorin projektio ei kykene esittamään sitä
# lainkaan: kerroin kasvaa rajatta navalla. Tama on itsessään tulos, ei puute.
cat("Maita mukana:", nrow(maat), "\n")

cat("Ilman mannerluokitusta jääneet:",
    sum(is.na(unname(MANNER_FI[coalesce(maat_raaka$ISO3_CODE, "")]))), "\n")

print(count(st_drop_geometry(maat), manner, sort = TRUE))

polku_vaesto <- file.path(DATA_DIR, "vaesto_worldbank.qs")

if (!file.exists(polku_vaesto)) {
  vastaus <- request("https://api.worldbank.org/v2/country/all/indicator/SP.POP.TOTL") |>
    req_url_query(format = "json", per_page = 20000, date = "2015:2024") |>
    req_retry(max_tries = 3) |>
    req_perform()

  raaka <- jsonlite::fromJSON(resp_body_string(vastaus), flatten = TRUE)

  stopifnot(length(raaka) == 2, is.data.frame(raaka[[2]]))

  vaesto_raaka <- raaka[[2]] |>
    as_tibble() |>
    select(ISO3_CODE = countryiso3code, vuosi = date, vakiluku = value) |>
    filter(!is.na(vakiluku), nchar(ISO3_CODE) == 3) |>
    mutate(vuosi = as.integer(vuosi)) |>
    group_by(ISO3_CODE) |>
    slice_max(vuosi, n = 1, with_ties = FALSE) |>
    ungroup()

  qs2::qd_save(vaesto_raaka, polku_vaesto)
}
vaesto_raaka <- qs2::qd_read(polku_vaesto)

stopifnot(nrow(vaesto_raaka) > 180)
stopifnot(all(vaesto_raaka$vakiluku > 0))

cat("Vakilukuja maittain:", nrow(vaesto_raaka),
    "| viimeisin vuosi:", max(vaesto_raaka$vuosi),
    "| yhteensa:", format(sum(vaesto_raaka$vakiluku), big.mark = " "), "\n")

polku_vaar <- file.path(DATA_DIR, "vaaristymat.qs")

if (!file.exists(polku_vaar)) {
  koord <- as.matrix(maapisteet[, c("lon", "lat")])

  vaaristymat <- imap_dfr(PROJEKTIOT, function(crs, nimi) {
    laske_vaaristymat(koord, crs) |>
      mutate(
        projektio = nimi,
        ISO3_CODE = maapisteet$ISO3_CODE,
        manner    = maapisteet$manner
      )
  })

  # Normalisointi: suhteellinen pinta-alavaaristyma r = s / geometrinen keskiarvo
  vaaristymat <- vaaristymat |>
    group_by(projektio) |>
    mutate(r_pinta_ala = pinta_ala / exp(mean(log(pinta_ala)))) |>
    ungroup() |>
    mutate(
      log2_r = log2(r_pinta_ala),
      tyyppi = unname(PROJ_TYYPPI[projektio])
    )

  qs2::qd_save(vaaristymat, polku_vaar)
}
vaaristymat <- qs2::qd_read(polku_vaar)

stopifnot(all(is.finite(vaaristymat$r_pinta_ala)))
stopifnot(all(vaaristymat$omega >= -1e-9))

# Sanity: pinta-alatarkoilla r pitaa olla 1
tarkistus <- vaaristymat |>
  filter(tyyppi == "pinta-alatarkka") |>
  summarise(poikkeama = max(abs(r_pinta_ala - 1)))
stopifnot(tarkistus$poikkeama < 1e-3)

cat("Rivi\u00e4 yhteens\u00e4:", nrow(vaaristymat), "\n")

merc <- vaaristymat |> filter(projektio == "Mercator")

kvantiilit <- quantile(merc$r_pinta_ala, c(0.05, 0.25, 0.5, 0.75, 0.95, 0.99))

ggplot(merc, aes(x = r_pinta_ala)) +
  geom_histogram(bins = 90, fill = "#457b9d", colour = NA, alpha = 0.9) +
  geom_vline(xintercept = 1, colour = "#e63946", linewidth = 0.9) +
  geom_vline(xintercept = kvantiilit[["50%"]], colour = "#f4a261",
             linetype = "dashed", linewidth = 0.9) +
  scale_x_continuous(
    trans  = "log2",
    breaks = c(0.5, 1, 2, 4, 8, 16, 32),
    labels = c("0,5\u00d7", "1\u00d7", "2\u00d7", "4\u00d7", "8\u00d7", "16\u00d7", "32\u00d7")
  ) +
  labs(
    title    = "Mercatorin pinta-alavääristymä on jakauma, ei luku",
    subtitle = paste0(
      "Punainen viiva = kartan keskimääräinen maa-alue. Katkoviiva = mediaani (",
      formatC(kvantiilit[["50%"]], digits = 2, format = "f"), "\u00d7)."
    ),
    x = "Kuinka moninkertaiselta alue näyttää kartan keskimääräiseen maa-alueeseen verrattuna",
    y = "Otospisteiden lukumäärä",
    caption = "Aineisto: GISCO/Eurostat maarajat, 60 000 tasa-aluepainotettua otospistettä"
  ) +
  theme_kristian()

merc_yhteenveto <- tibble(
  Tunnusluku = c("5. persentiili", "Alakvartiili", "Mediaani", "Yläkvartiili",
                 "95. persentiili", "99. persentiili", "Maksimi",
                 "Ylin / alin (5% vs 95%)"),
  Arvo = c(
    kvantiilit[["5%"]], kvantiilit[["25%"]], kvantiilit[["50%"]],
    kvantiilit[["75%"]], kvantiilit[["95%"]], kvantiilit[["99%"]],
    max(merc$r_pinta_ala),
    kvantiilit[["95%"]] / kvantiilit[["5%"]]
  )
) |>
  mutate(Arvo = paste0(formatC(Arvo, digits = 2, format = "f"), "\u00d7"))

knitr::kable(merc_yhteenveto,
             caption = "Mercatorin suhteellinen pinta-alavääristymä maa-alueilla")

hila <- expand.grid(
  lon = seq(-179.5, 179.5, by = 1),
  lat = seq(-84.5, 84.5, by = 1)
) |> as.matrix()

hila_v <- laske_vaaristymat(hila, PROJEKTIOT[["Mercator"]]) |>
  mutate(r = pinta_ala / exp(mean(log(merc$pinta_ala))))

rajat_sf <- maat |> st_geometry()

ggplot() +
  geom_tile(data = hila_v, aes(x = lon, y = lat, fill = log2(r)),
            width = 1, height = 1) +
  geom_sf(data = rajat_sf, fill = NA, colour = "grey20", linewidth = 0.12) +
  scale_fill_gradient2(
    low = "#1d3557", mid = "#f7f2e8", high = "#e63946", midpoint = 0,
    breaks = log2(c(0.5, 1, 2, 4, 8, 16)),
    labels = c("0,5\u00d7", "1\u00d7", "2\u00d7", "4\u00d7", "8\u00d7", "16\u00d7"),
    name   = "Näennäinen\nkoko"
  ) +
  coord_sf(xlim = c(-180, 180), ylim = c(-85, 85), expand = FALSE, crs = 4326) +
  labs(
    title    = "Mercatorin vääristymä riippuu vain leveyspiiristä",
    subtitle = "valkoinen = näyttää liian pieneltä, punainen = näyttää liian isolta",
    x = NULL, y = NULL,
    caption = "Kartta on piirretty tasakulmakoordinaatistossa, jotta vääristymä itse näkyy vääristymättä"
  ) +
  theme_kristian()

# Todelliset pinta-alat pallogeometrialla (s2)
sf::sf_use_s2(TRUE)
maat$ala_tosi <- as.numeric(st_area(maat))

# Rajaviivat pitaa TIHENTAA ennen projisointia. Muuten pitka suora rajaviiva
# (esim. USA/Kanada 49. leveyspiirilla) piirtyy kartalle suorana, vaikka sen
# pitaisi kaartua -- ja pinta-ala menee vaarin. 50 km segmentti riittaa.
maat_tiheat <- st_segmentize(maat, dfMaxLength = 50000)

# Naennaiset pinta-alat kartalla: projisoidaan polygonit ja mitataan tason ala.
naennainen_ala <- function(crs) {
  sf::sf_use_s2(FALSE)
  g <- maat_tiheat |>
    st_wrap_dateline(options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180")) |>
    st_transform(crs)
  ala <- as.numeric(st_area(g))
  sf::sf_use_s2(TRUE)
  ala
}

# Gronlanti on Tanskan alue; GISCO:ssa erillinen koodi GRL.
kohteet <- c("GRL", "COD", "IND", "FIN", "BRA", "RUS", "AUS", "DZA")

vertailu <- tibble(
  ISO3_CODE   = maat$ISO3_CODE,
  maa         = maat$NAME_ENGL,
  ala_tosi    = maat$ala_tosi,
  ala_merc    = naennainen_ala(PROJEKTIOT[["Mercator"]]),
  ala_eqe     = naennainen_ala(PROJEKTIOT[["Equal Earth"]])
) |>
  mutate(
    # normalisoidaan niin, etta maailman maa-alueiden yhteispinta-ala tasmaa
    r_merc = (ala_merc / sum(ala_merc)) / (ala_tosi / sum(ala_tosi)),
    r_eqe  = (ala_eqe  / sum(ala_eqe))  / (ala_tosi / sum(ala_tosi))
  )

# Equal Earth on pinta-alatarkka: suhteen pitaa olla 1 numeerisen tarkkuuden
# rajoissa. Tama on koko pinta-alalaskennan validointi.
cat("Equal Earth, suurin poikkeama ykkosesta:",
    round(max(abs(vertailu$r_eqe - 1)), 4), "\n")

stopifnot(max(abs(vertailu$r_eqe - 1)) < 0.02)

# Afrikan yhteispinta-ala
afr_iso <- maat$ISO3_CODE[maat$manner == "Afrikka"]
afr <- vertailu |> filter(ISO3_CODE %in% afr_iso) |>
  summarise(tosi = sum(ala_tosi), merc = sum(ala_merc))

grl <- vertailu |> filter(ISO3_CODE == "GRL")

cat("Afrikan todellinen pinta-ala / Gronlannin:",
    round(afr$tosi / grl$ala_tosi, 2), "\n")

cat("Afrikan naennainen pinta-ala Mercatorilla / Gronlannin:",
    round(afr$merc / grl$ala_merc, 2), "\n")

cat("Gronlannin liioittelukerroin Mercatorilla:",
    round(grl$r_merc, 2), "\n")

vertailu |>
  filter(ISO3_CODE %in% kohteet) |>
  arrange(desc(r_merc)) |>
  transmute(
    Maa = maa,
    `Todellinen pinta-ala (milj. km²)` = round(ala_tosi / 1e12, 2),
    `Liioittelukerroin Mercatorilla`   = paste0(formatC(r_merc, digits = 2, format = "f"), "\u00d7")
  ) |>
  knitr::kable(caption = "Kuinka moninkertaiselta maa näyttää Mercatorin kartalla")

jarjestys <- vaaristymat |>
  group_by(projektio) |>
  summarise(m = median(omega), .groups = "drop") |>
  arrange(m) |>
  pull(projektio)

d_plot <- vaaristymat |>
  mutate(projektio = factor(projektio, levels = jarjestys))

VARIT <- c("pinta-alatarkka" = "#2a9d8f",
           "konforminen"     = "#e63946",
           "kompromissi"     = "#f4a261")

# HUOM: osa jakaumista on degeneroituneita eli vakioita. Pinta-alatarkoilla
# projektioilla r_pinta_ala == 1 kaikkialla ja Mercatorilla omega == 0
# kaikkialla. Ydinestimointi (bw.SJ) kaatuu vakiodataan, joten slab lasketaan
# histogrammilla. Se on tassa myos rehellisempi esitys: piikki on aito piikki,
# ei levitetty kumpare.

p1 <- ggplot(d_plot, aes(x = r_pinta_ala, y = projektio, fill = tyyppi)) +
  stat_halfeye(
    density   = "histogram",
    .width    = c(0.5, 0.9),
    normalize = "groups",
    slab_alpha = 0.85,
    point_size = 1.6,
    interval_size_range = c(0.5, 1.2)
  ) +
  geom_vline(xintercept = 1, colour = "#e63946", linewidth = 0.7) +
  scale_x_continuous(
    trans  = "log2",
    breaks = c(0.5, 1, 2, 4, 8, 16),
    labels = c("0,5\u00d7", "1\u00d7", "2\u00d7", "4\u00d7", "8\u00d7", "16\u00d7")
  ) +
  coord_cartesian(xlim = c(0.4, 20)) +
  scale_fill_manual(values = VARIT) +
  labs(title = "Pinta-alavääristymä", x = "Näennäinen koko", y = NULL, fill = NULL) +
  theme_kristian()

p2 <- ggplot(d_plot, aes(x = omega, y = projektio, fill = tyyppi)) +
  stat_halfeye(
    density   = "histogram",
    .width    = c(0.5, 0.9),
    normalize = "groups",
    slab_alpha = 0.85,
    point_size = 1.6,
    interval_size_range = c(0.5, 1.2)
  ) +
  scale_x_continuous(labels = function(x) paste0(x, "\u00b0")) +
  coord_cartesian(xlim = c(0, 80)) +
  scale_fill_manual(values = VARIT) +
  labs(title = "Kulmavääristymä (muotojen vääristymä)",
       x = "Suurin kulmavirhe", y = NULL, fill = NULL) +
  theme_kristian()

(p1 | p2) +
  plot_layout(guides = "collect") +
  plot_annotation(
    title = "Jokainen projektio valitsee, kummasta virheestä se maksaa",
    subtitle = "Vasemmalla pinta-alojen virhe, oikealla muotojen virhe. Sama piste-otos molemmissa.",
    caption = paste0(
      "60 000 tasa-aluepainotettua otospistett\u00e4 maa-alueilta. ",
      "Akselit on rajattu luettavuuden vuoksi; Mercatorin pinta-alah\u00e4nt\u00e4 jatkuu ",
      formatC(max(vaaristymat$r_pinta_ala[vaaristymat$projektio == "Mercator"]),
              digits = 0, format = "f"), "\u00d7 asti."
    )
  ) &
  theme_kristian()

yhteenveto <- vaaristymat |>
  group_by(projektio, tyyppi) |>
  summarise(
    pa_med   = median(r_pinta_ala),
    pa_p95   = quantile(r_pinta_ala, 0.95),
    pa_haj   = quantile(r_pinta_ala, 0.95) / quantile(r_pinta_ala, 0.05),
    om_med   = median(omega),
    om_p95   = quantile(omega, 0.95),
    om_max   = max(omega),
    .groups  = "drop"
  ) |>
  arrange(om_med)

yhteenveto |>
  transmute(
    Projektio = projektio,
    Tyyppi    = tyyppi,
    `Pinta-ala, mediaani` = paste0(formatC(pa_med, digits = 2, format = "f"), "\u00d7"),
    `Pinta-ala, 95 %`     = paste0(formatC(pa_p95, digits = 2, format = "f"), "\u00d7"),
    `Ylin/alin -suhde`    = paste0(formatC(pa_haj, digits = 1, format = "f"), "\u00d7"),
    `Kulmavirhe, mediaani`= paste0(formatC(om_med, digits = 1, format = "f"), "\u00b0"),
    `Kulmavirhe, 95 %`    = paste0(formatC(om_p95, digits = 1, format = "f"), "\u00b0")
  ) |>
  knitr::kable(caption = "Projektioiden vertailu maa-alueiden yli")

hila_eqe <- laske_vaaristymat(hila, PROJEKTIOT[["Equal Earth"]])

ggplot() +
  geom_tile(data = hila_eqe, aes(x = lon, y = lat, fill = omega),
            width = 1, height = 1) +
  geom_sf(data = rajat_sf, fill = NA, colour = "grey15", linewidth = 0.12) +
  scale_fill_gradientn(
    colours = c("#f7f2e8", "#f4a261", "#e63946", "#7a1020"),
    values  = scales::rescale(c(0, 15, 35, 70)),
    name    = "Kulmavirhe",
    labels  = function(x) paste0(x, "\u00b0")
  ) +
  coord_sf(xlim = c(-180, 180), ylim = c(-85, 85), expand = FALSE, crs = 4326) +
  labs(
    title    = "Equal Earthin hinta: muodot vääristyvät reunoilla ja navoilla",
    subtitle = "Vaalea = muodot lähes oikein, tumma = muodot pahasti vääristyneet",
    x = NULL, y = NULL
  ) +
  theme_kristian()

eqe <- vaaristymat |> filter(projektio == "Equal Earth")

pahin <- eqe |>
  group_by(manner) |>
  summarise(
    mediaani = median(omega),
    p90      = quantile(omega, 0.90),
    osuus_yli_20 = mean(omega > 20),
    .groups = "drop"
  ) |>
  arrange(desc(mediaani))

pahin |>
  transmute(
    Manner = manner,
    `Kulmavirhe, mediaani` = paste0(formatC(mediaani, digits = 1, format = "f"), "\u00b0"),
    `Kulmavirhe, 90 %`     = paste0(formatC(p90, digits = 1, format = "f"), "\u00b0"),
    `Osuus, jossa yli 20°`  = percent(osuus_yli_20, accuracy = 0.1)
  ) |>
  knitr::kable(caption = "Equal Earthin muotovirhe mantereittain")

# Jokaiselle otospisteelle paino = maan vakiluku / kyseisen maan otospisteiden lkm.
# Tama vastaa oletusta, etta vaesto jakautuu tasaisesti maan sisalla. Oletus on
# karkea, mutta se ei riipu mistaan projektiosta eika lisaa piilo-oletuksia
# muuta kuin maan sisalla, missa leveyspiirivaihtelu on useimmilla mailla pieni.

pisteet_per_maa <- maapisteet |> count(ISO3_CODE, name = "n_pisteita")

painot <- pisteet_per_maa |>
  inner_join(vaesto_raaka, by = "ISO3_CODE") |>
  mutate(paino = vakiluku / n_pisteita)

cat("Maita, joille saatiin sek\u00e4 otospisteit\u00e4 ett\u00e4 v\u00e4kiluku:", nrow(painot), "\n")

cat("Katettu v\u00e4est\u00f6:", format(sum(painot$vakiluku), big.mark = " "), "\n")

stopifnot(nrow(painot) > 150)

vaaristymat_p <- vaaristymat |>
  inner_join(select(painot, ISO3_CODE, paino), by = "ISO3_CODE")

# Painotettu kvantiilifunktio (ei lisariippuvuuksia)
painotettu_kvantiili <- function(x, w, p) {
  stopifnot(length(x) == length(w), all(w >= 0), all(is.finite(x)))
  jarj <- order(x)
  x <- x[jarj]; w <- w[jarj]
  kumul <- cumsum(w) / sum(w)
  vapply(p, function(pp) x[which.max(kumul >= pp)], numeric(1))
}

vertailu_painotus <- vaaristymat_p |>
  filter(projektio == "Mercator") |>
  summarise(
    `Maapinta-ala, mediaani`   = median(r_pinta_ala),
    `Väestöpainotettu, mediaani` = painotettu_kvantiili(r_pinta_ala, paino, 0.5),
    `Maapinta-ala, 90 %`       = quantile(r_pinta_ala, 0.90),
    `Väestöpainotettu, 90 %`   = painotettu_kvantiili(r_pinta_ala, paino, 0.90)
  ) |>
  pivot_longer(everything(), names_to = "Painotus", values_to = "Arvo") |>
  mutate(Arvo = paste0(formatC(Arvo, digits = 2, format = "f"), "\u00d7"))

knitr::kable(vertailu_painotus,
             caption = "Mercatorin vääristymä riippuu ratkaisevasti siitä, mitä painotetaan")

# Vertailukohta: tasainen otanta koko maapallon pinnalta, meret mukaan lukien.
pallo_otos <- cbind(
  lon = runif(60000, -179.9, 179.9),
  lat = asin(runif(60000, -1, 1)) * 180 / pi
)
pallo_otos <- pallo_otos[abs(pallo_otos[, "lat"]) <= 89.5, , drop = FALSE]

# Normalisoidaan samalla vakiolla kuin maa-alueet, jotta kaikki kolme kayraa
# ovat samalla asteikolla ja keskenaan vertailukelpoisia.
G_MERC <- exp(mean(log(merc$pinta_ala)))

pallo_v <- laske_vaaristymat(pallo_otos, PROJEKTIOT[["Mercator"]]) |>
  mutate(r = pinta_ala / G_MERC)

# Painotettu kertymafunktio. Aloituspiste F = 0 lisataan, jotta askelkuvaaja
# lahtee nollasta eika ensimmaisen havainnon korkeudelta.
ecdf_painotettu <- function(x, w = rep(1, length(x)), nimi) {
  stopifnot(length(x) == length(w), all(is.finite(x)), all(w >= 0))
  jarj <- order(x)
  x <- x[jarj]; w <- w[jarj]
  tibble(
    arvo     = c(x[1], x),
    F        = c(0, cumsum(w) / sum(w)),
    painotus = nimi
  )
}

mercp <- vaaristymat_p |> filter(projektio == "Mercator")

kaikki_ecdf <- bind_rows(
  ecdf_painotettu(pallo_v$r,             nimi = "Koko maapallon pinta"),
  ecdf_painotettu(merc$r_pinta_ala,      nimi = "Maa-alueet"),
  ecdf_painotettu(mercp$r_pinta_ala, mercp$paino, nimi = "Ihmiset")
) |>
  mutate(painotus = factor(painotus,
    levels = c("Koko maapallon pinta", "Maa-alueet", "Ihmiset")))

stopifnot(
  all(abs(
    kaikki_ecdf |> group_by(painotus) |> summarise(m = max(F)) |> pull(m) - 1
  ) < 1e-9)
)

ggplot(kaikki_ecdf, aes(x = arvo, y = F, colour = painotus)) +
  geom_step(linewidth = 1) +
  geom_vline(xintercept = 1, colour = "grey50", linetype = "dotted") +
  scale_x_continuous(
    trans  = "log2",
    breaks = c(0.5, 1, 2, 4, 8, 16, 32),
    labels = c("0,5\u00d7", "1\u00d7", "2\u00d7", "4\u00d7", "8\u00d7", "16\u00d7", "32\u00d7")
  ) +
  scale_y_continuous(labels = percent, limits = c(0, 1)) +
  # Rajaus tehdaan coord_cartesianilla, EI scale_x:n limits-argumentilla:
  # limits pudottaisi havainnot pois datasta, jolloin kertymakayra ei enaa
  # yltaisi sataan prosenttiin. coord_cartesian vain zoomaa.
  coord_cartesian(xlim = c(0.4, 40)) +
  scale_colour_manual(values = c("Koko maapallon pinta" = "#457b9d",
                                 "Maa-alueet"           = "#f4a261",
                                 "Ihmiset"              = "#2a9d8f")) +
  labs(
    title    = "Kenen näkökulmasta Mercator on paha?",
    subtitle = "Kertymäfunktio: käyrä kertoo, kuinka suuri osuus jää kunkin vääristymäarvon alle",
    x = "Näennäinen koko Mercatorin kartalla",
    y = "Kertymäosuus", colour = "Painotus",
    caption = "Väestöpainotus: Maailmanpankki SP.POP.TOTL. Vaaka-akseli on rajattu, ei suodatettu."
  ) +
  theme_kristian()

# Isoympyraetaisyys (haversine)
etaisyys_ortodromi <- function(lon1, lat1, lon2, lat2, R = R_MAA) {
  rad <- pi / 180
  dphi <- (lat2 - lat1) * rad
  dlam <- (lon2 - lon1) * rad
  a <- sin(dphi / 2)^2 + cos(lat1 * rad) * cos(lat2 * rad) * sin(dlam / 2)^2
  2 * R * asin(pmin(sqrt(a), 1))
}

# Loksodromietaisyys isometrisen leveyden avulla
etaisyys_loksodromi <- function(lon1, lat1, lon2, lat2, R = R_MAA) {
  rad  <- pi / 180
  phi1 <- lat1 * rad; phi2 <- lat2 * rad
  dphi <- phi2 - phi1
  dlam <- (lon2 - lon1) * rad
  dlam <- ((dlam + pi) %% (2 * pi)) - pi        # lyhin suunta
  dpsi <- log(tan(pi / 4 + phi2 / 2) / tan(pi / 4 + phi1 / 2))
  q <- ifelse(abs(dpsi) > 1e-12, dphi / dpsi, cos(phi1))
  R * sqrt(dphi^2 + q^2 * dlam^2)
}

# Validointi: paivantasaajaa pitkin loksodromi = ortodromi
stopifnot(abs(etaisyys_loksodromi(0, 0, 90, 0) - etaisyys_ortodromi(0, 0, 90, 0)) < 1)
# Validointi: samaa meridiaania pitkin myos yhta pitkat
stopifnot(abs(etaisyys_loksodromi(20, -30, 20, 40) - etaisyys_ortodromi(20, -30, 20, 40)) < 1)
# Loksodromi ei koskaan lyhyempi
set.seed(99)
tst <- tibble(a = runif(5000, -180, 180), b = asin(runif(5000, -1, 1)) * 180 / pi,
              c = runif(5000, -180, 180), d = asin(runif(5000, -1, 1)) * 180 / pi)
stopifnot(all(etaisyys_loksodromi(tst$a, tst$b, tst$c, tst$d) >=
              etaisyys_ortodromi(tst$a, tst$b, tst$c, tst$d) - 1))

cat("Loksodromifunktion validointi lapaisty.\n")

set.seed(1569)   # Mercatorin kartan julkaisuvuosi
N_REITTI <- 200000

reitit <- tibble(
  lon1 = runif(N_REITTI, -180, 180),
  lat1 = asin(runif(N_REITTI, -1, 1)) * 180 / pi,
  lon2 = runif(N_REITTI, -180, 180),
  lat2 = asin(runif(N_REITTI, -1, 1)) * 180 / pi
) |>
  mutate(
    d_orto = etaisyys_ortodromi(lon1, lat1, lon2, lat2) / 1000,
    d_lokso = etaisyys_loksodromi(lon1, lat1, lon2, lat2) / 1000,
    ylimaara = d_lokso / d_orto - 1
  ) |>
  filter(d_orto > 100, is.finite(ylimaara))

stopifnot(all(reitit$ylimaara >= -1e-6))

reitit <- reitit |>
  mutate(pituusluokka = cut(
    d_orto,
    breaks = c(0, 1000, 3000, 6000, 10000, 20100),
    labels = c("alle 1 000 km", "1 000\u20133 000 km", "3 000\u20136 000 km",
               "6 000\u201310 000 km", "yli 10 000 km")
  ))

lokso_yht <- reitit |>
  group_by(pituusluokka) |>
  summarise(
    n = n(),
    mediaani = median(ylimaara),
    p75 = quantile(ylimaara, 0.75),
    p95 = quantile(ylimaara, 0.95),
    .groups = "drop"
  )

lokso_yht |>
  transmute(
    `Reitin pituus` = pituusluokka,
    `Reittejä` = format(n, big.mark = " "),
    `Ylimääräinen matka, mediaani` = percent(mediaani, accuracy = 0.1),
    `75. persentiili` = percent(p75, accuracy = 0.1),
    `95. persentiili` = percent(p95, accuracy = 0.1)
  ) |>
  knitr::kable(caption = "Kuinka paljon pidempi suora kompassikurssi on lyhimpään reittiin verrattuna")

# Luokiteltu puolisilmakuvaaja ei toimi tassa: ylimaarainen matka on nollassa
# kiinni valtaosalla reitteja, jolloin tiheysestimaatista tulee nakymattoman
# kapea piikki. Piirretaan sen sijaan kvantiilivyohykkeet jatkuvana.

BIN_LEVEYS <- 500   # km

vyohykkeet <- reitit |>
  mutate(bin = floor(d_orto / BIN_LEVEYS) * BIN_LEVEYS + BIN_LEVEYS / 2) |>
  group_by(bin) |>
  filter(n() >= 200) |>          # ohuet reunabinit pois
  summarise(
    n   = n(),
    p05 = quantile(ylimaara, 0.05),
    p25 = quantile(ylimaara, 0.25),
    p50 = quantile(ylimaara, 0.50),
    p75 = quantile(ylimaara, 0.75),
    p95 = quantile(ylimaara, 0.95),
    .groups = "drop"
  )

stopifnot(nrow(vyohykkeet) > 20, all(vyohykkeet$p05 >= 0))

# Toinen paneeli: kuinka suuri osuus reiteista jaa alle viiden prosentin
# ylimaaran. Tama on se luku, joka ratkaisi asian 1500-luvun navigaattorille.
osuudet <- reitit |>
  mutate(bin = floor(d_orto / BIN_LEVEYS) * BIN_LEVEYS + BIN_LEVEYS / 2) |>
  group_by(bin) |>
  filter(n() >= 200) |>
  summarise(osuus_alle_5 = mean(ylimaara < 0.05), .groups = "drop")

pA <- ggplot(vyohykkeet, aes(x = bin)) +
  geom_ribbon(aes(ymin = p05, ymax = p95), fill = "#457b9d", alpha = 0.25) +
  geom_ribbon(aes(ymin = p25, ymax = p75), fill = "#457b9d", alpha = 0.45) +
  geom_line(aes(y = p50), colour = "#f4a261", linewidth = 1.1) +
  geom_hline(yintercept = 0.05, colour = "#e63946",
             linetype = "dashed", linewidth = 0.6) +
  annotate("text", x = max(vyohykkeet$bin), y = 0.052,
           label = "5 %", hjust = 1, vjust = 0, colour = "#e63946", size = 3.4) +
  scale_x_continuous(labels = function(x) format(x, big.mark = " ")) +
  scale_y_continuous(
    trans  = "sqrt",                     # neliojuuriasteikko: pieni pää auki
    breaks = c(0, 0.01, 0.05, 0.1, 0.2, 0.4, 0.6),
    labels = percent_format(accuracy = 1)
  ) +
  labs(
    title    = "Suoran kompassikurssin hinta kasvaa matkan mukana",
    subtitle = paste0(
      "Oranssi viiva = mediaani. Tumma vyöhyke = keskimmäiset 50 %, ",
      "vaalea = keskimmäiset 90 %."
    ),
    x = NULL, y = "Ylimääräinen matka"
  ) +
  theme_kristian()

pB <- ggplot(osuudet, aes(x = bin, y = osuus_alle_5)) +
  geom_line(colour = "#2a9d8f", linewidth = 1.1) +
  geom_hline(yintercept = 0.5, colour = "grey50", linetype = "dotted") +
  scale_x_continuous(labels = function(x) format(x, big.mark = " ")) +
  scale_y_continuous(labels = percent, limits = c(0, 1)) +
  labs(
    x = "Reitin pituus (km)",
    y = "Osuus reiteistä,\njoilla hukka alle 5 %"
  ) +
  theme_kristian()

(pA / pB) +
  plot_layout(heights = c(2.2, 1)) +
  plot_annotation(
    caption = "200 000 satunnaista reittiparia maapallon pinnalla, tasa-aluepainotettu otanta"
  ) &
  theme_kristian()

aiheet <- init |> select(id, vpvuosi, tyyppi, aiheet) |>
  unnest(aiheet) |> filter(!is.na(aiheet), aiheet != "") |>
  mutate(aihe = str_squish(str_to_lower(aiheet)))
stopifnot("Aihetunnisteita ei löytynyt" = nrow(aiheet) > 1000)

# Yleisimmät aiheet koko aineistossa
top <- aiheet |> count(aihe, sort = TRUE) |> slice_head(n = 20)
ggplot(top, aes(x = n, y = fct_reorder(aihe, n))) +
  geom_col(fill = pal[["laivasto"]]) +
  labs(title = "Yleisimmät aloitteiden ja kysymysten aiheet",
       subtitle = "Aineiston omat aihetunnisteet", x = "Mainintoja", y = NULL)

top_aiheet <- top |> slice_head(n = 6) |> pull(aihe)
per_vuosi <- aiheet |> count(vpvuosi, name = "n_yht")
trendi <- aiheet |> filter(aihe %in% top_aiheet) |>
  count(vpvuosi, aihe) |> left_join(per_vuosi, by = "vpvuosi") |>
  mutate(osuus = n / n_yht) |> filter(vpvuosi >= 2015, vpvuosi < 2026)

ggplot(trendi, aes(vpvuosi, osuus, color = aihe)) +
  geom_line(linewidth = 1) + geom_point() +
  scale_y_continuous(labels = label_percent()) +
  scale_color_manual(values = unname(pal)) +
  labs(title = "Aiheiden painopiste liikkuu vuosien yli",
       subtitle = "Kuuden yleisimmän aiheen osuus aloitteiden aihetunnisteista",
       x = NULL, y = "Osuus maininnoista", color = NULL)