Otyłość w Polsce i na świecie

Bazy WHO

Baza WHO (tzw. Global Health Observatory, https://www.who.int/data/gho ) ma ten oto ficzer, że nie da się z niej pobrać (przy użyciu normalnego interfejsu) danych można je tylko oglądać. Żeby pobrać trzeba wpisać coś podobnego do:

https://apps.who.int/gho/athena/api/GHO/WHS9_86?format=csv

gdzie WHS9_86 to identyfikator zbioru danych, przy czym identyfikatory nie są publikowane jeżeli oglądamy dane przy użyciu normalnego interfejsu, ale jest ich lista do pobrania tutaj:

https://apps.who.int/gho/athena/api/GHO?format=csv&profile=verbose

na przykład:

curl 'https://apps.who.int/gho/athena/api/GHO?format=csv&profile=verbose' > gho.csv
grep -i Obesity gho.csv
"GHO","NCD_BMI_30A","Prevalence of obesity among adults..."
"GHO","NCD_BMI_30C","Prevalence of obesity among adults..."
...

Opis interfejsu jest tutaj https://apps.who.int/gho/data/node.resources.api (ten tutaj zaś https://www.who.int/data/gho/info/athena-api jest niekompletny; zresztą cała baza WHO to parodia.) Wreszcie jest też pakiet R umożliwiający dostęp do bazy GHO https://cran.r-project.org/web/packages/rgho/vignettes/a-intro.html.

Wczytujemy dane (oczyszczone skryptem Perlowym):

## curl https://apps.who.int/gho/athena/api/GHO/NCD_BMI_30A?format=csv
## curl https://apps.who.int/gho/athena/api/GHO/NCD_BMI_30C?format=csv

obesity <- read.csv(file='obesity_who_all_C.csv',sep=';',header=T)
## ecdc_countries_names_codes3166.csv
## w tym pliku brakuje wielu krajów np. królestwa Tonga
countries <- read.csv(file='ecdc_countries_names_codes3166.csv', 
                      sep=';',header=T)
##obesity <- left_join(obesity, countries, by=c('kraj' = 'iso') )

Polska

Polska kobiety/mężczyźni (bez ogółem bo po co):

obesityPL <- obesity %>% filter (kraj == 'POL' & plec != 'BTSX')

popl <- ggplot(obesityPL, aes(x= as.factor(rok), 
        group=as.factor(plec), color=as.factor(plec), y=nadwaga )) +
  geom_line(size=.5 ) +
  geom_point(size=2.5, alpha=.3) +
  xlab(label="") +
  scale_x_discrete( breaks = every_nth(n = 10)) +
  ylab(label="tys") +
  theme_nikw()+
  ggtitle("Nadwaga w PL")
popl

Wybrane kraje świata

Wybrane kraje świata (także bez ogółem):

countries <- c('POL', 'DEU', 'ESP', 'CZE', 'ITA', 'FRA', 'FIN',
               'AFG', 'CHN', 'IND', 'NZA', 'FJI', 'TON', 'WSM',
               'ETH', 'NGA', 'USA', 'CAN', 'MEX')
o <- obesity %>% filter (plec != 'BTSX' & kraj %in% countries) %>% as.data.frame

po <- ggplot(o, aes(x= as.factor(rok), 
          group=as.factor(plec), color=as.factor(plec), y=nadwaga )) +
  geom_line(size=.5, alpha=.6 ) +
  geom_point(size=.5, alpha=.3) +
  xlab(label="") +
  scale_x_discrete( breaks = every_nth(n = 8)) +
  scale_y_continuous(breaks=seq(0,75, by=5)) +
  ylab(label="tys") +
  theme_nikw()+
  ##labs(caption=source, color='Rok') +
  facet_wrap( ~kraj, scales = "fixed", ncol = 6) +
  ggtitle("Nadwaga w wybranych krajach")
po

Wszystkie kraje świata

Wykres punktowy dla najnowszych danych (ostatniego raportowanego roku); absurdalnie długi ale trudno. Tylko ogółem oczywiście (BTSX):

o_last <- obesity %>% filter (plec == 'BTSX' ) %>%
  group_by(kraj) %>%  drop_na(nadwaga) %>% arrange(rok) %>%
  filter(row_number()==n()) %>%  as.data.frame

poworld <- ggplot(o_last, aes(x = reorder(kraj, nadwaga), color=region )) +
  geom_point(aes(y = nadwaga), size=1) +
  xlab(label="kraj") +
  ylab(label="obesity") +
  ggtitle("Nadwaga") +
  theme(axis.text = element_text(size = 4)) +
  theme(plot.title = element_text(hjust = 0.5)) +
  coord_flip()
poworld

Zmiana 1980–2016

Bardziej skomplikowany wykres punktowy. Poziom w 2016 vs poziom w 1980; do tego słupki obrazujące różnicę

o_first <- obesity %>% filter (plec == 'BTSX' & as.numeric(as.character(rok)) > 1979 ) %>%
  group_by(kraj) %>%  drop_na(nadwaga) %>% arrange(rok) %>%
  filter(row_number()==1) %>%  as.data.frame

## Warning in mask$eval_all_filter(dots, env_filter): pojawiły się wartości NA na
## skutek przekształcenia

oo <- bind_rows(o_last, o_first)

# łączymy o_first z o_last
oo.oo <- left_join(o_last, o_first, by='kraj')
# obliczamy różnicę
oo.oo$diff.xy <- oo.oo$nadwaga.x - oo.oo$nadwaga.y

poworld2 <- oo.oo %>%
  ggplot(aes(x = reorder(kraj, nadwaga.x) )) +
  geom_point(aes(y = nadwaga.x, color="nadwaga.x"), size=1 ) +
  geom_point(aes(y = nadwaga.y, color="nadwaga.y"), size=1 ) +
  geom_bar(aes(y = diff.xy, fill='roznica'), stat="identity", alpha=.25 ) +
  xlab(label="kraj") +
  ylab(label="obesity") +
  ggtitle("Nadwaga na świecie") +
  ##
  ## Skala musi być manualnie
  scale_color_manual(name="", labels =c("2016", "1980"),
                     values = c(nadwaga.x="red", nadwaga.y="blue" ) ) +
  scale_fill_manual(name="", values = c(roznica="green" ) ) +
  ##
  theme(axis.text = element_text(size = 4)) +
  theme(plot.title = element_text(hjust = 0.5)) +
  coord_flip()
poworld2

Inne podejście (wynik ten sam):

obesity$yr <- as.numeric(as.character(obesity$rok))

## Warning: pojawiły się wartości NA na skutek przekształcenia

obesity_diff <- obesity %>%
  filter (plec == 'BTSX' & yr > 1979 ) %>%
  group_by(kraj) %>%
  summarise(fst= nadwaga[which.min(yr)], 
            lst = nadwaga[which.max(yr)],
            diff = nadwaga[which.max(yr)] - nadwaga[which.min(yr)])

## `summarise()` ungrouping output (override with `.groups` argument)

poworld3 <- obesity_diff %>%
  ggplot(aes(x = reorder(kraj, lst ))) +
  geom_point(aes(y = lst, color="lst"), size=1 ) +
  geom_point(aes(y = fst, color="fst"), size=1 ) +
  geom_bar(aes(y = diff, fill='diff'), stat="identity", alpha=.25 ) +
  xlab(label="kraj") +
  ylab(label="obesity") +
  ggtitle("Nadwaga na świecie") +
  ##
  scale_color_manual(name="", labels =c("2016", "1980"),
                     values = c(lst="red", fst="blue" ) ) +
  scale_fill_manual(name="", values = c( diff="green" ) ) +
  #
  theme(axis.text = element_text(size = 4)) +
  theme(plot.title = element_text(hjust = 0.5)) +
  coord_flip()
poworld3

albo na oddzielnych wykresach:

poworld3 <- ggplot(oo, aes(x = reorder(kraj, nadwaga) )) +
  geom_point(aes(y = nadwaga), size=1) +
  xlab(label="kraj") +
  ylab(label="obesity") +
  ggtitle("Nadwaga na świecie (wersja #3)") +
  facet_wrap(~as.factor(rok), scales = "fixed") +
  theme(axis.text = element_text(size = 4)) +
  theme(plot.title = element_text(hjust = 0.5)) +
  coord_flip()
poworld3