Carregando os pacotes

Muitos já devem estar familiarizados com a apresentação do historiador Hans Rosling sobre a evolução da expectativa de vida e do PIB per capita dos países em torno do mundo. Este post vai mostrar como usar o ggplot2 e o tidyverse para explorar estes dados. Pode-se acessar uma versão simplificada da base de dados pelo pacote gapminder.

### Tutorial Gapminder ###
library(tidyverse)
library(extrafont)
library(ggplot2)
library(gapminder)
library(kableExtra)
##########################
data(gapminder)
d <- gapminder

# Checagens iniciais #
# Verifica se há valores ausentes
d %>%
  select(everything()) %>%
  summarise_all(funs(sum(is.na(.))))

## # A tibble: 1 x 6
##   country continent  year lifeExp   pop gdpPercap
##     <int>     <int> <int>   <int> <int>     <int>
## 1       0         0     0       0     0         0

# Informações gerais sobre os dados
str(d)

## Classes 'tbl_df', 'tbl' and 'data.frame':    1704 obs. of  6 variables:
##  $ country  : Factor w/ 142 levels "Afghanistan",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ continent: Factor w/ 5 levels "Africa","Americas",..: 3 3 3 3 3 3 3 3 3 3 ...
##  $ year     : int  1952 1957 1962 1967 1972 1977 1982 1987 1992 1997 ...
##  $ lifeExp  : num  28.8 30.3 32 34 36.1 ...
##  $ pop      : int  8425333 9240934 10267083 11537966 13079460 14880372 12881816 13867957 16317921 22227415 ...
##  $ gdpPercap: num  779 821 853 836 740 ...

# Nome das variáveis minúsculas
names(d) <- tolower(names(d))
# Tranformações #
# Computa o log do pib per capita
d <- d %>%
  mutate(lgdppc = log10(gdppercap))

# Tema customizado #
theme_vini <- theme_bw() +
  theme(text = element_text(family = "Tw Cen MT", size = 12, colour = "gray20"),
        plot.title = element_text(size = 16),
        legend.text = element_text(size = 12),
        legend.position = "bottom")
# Nomes que serão usados várias vezes para os eixos
nomes <- list(title = "Expectativa de vida e PIB per capita",
              x = "Log do PIB per capita (US$ 2010)",
              y = "Expectativa de vida ao nascer",
              fonte = "Fonte: Gapmineder (www.gapminder.org) e World Bank Open Data.")

Visualizando

Note que não temos dados para todos os anos do período. Os dados estão disponíveis de cinco em cinco anos começando em 1952 e terminando em 2007. Podemos começar com um gráfico de dispersão para ver a relação entre a “economia” (PIB per capita) e a “qualidade da saúde/vida” (expectativa de vida ao nascer) de um país. Apenas como exemplo incluo também uma linha de regressão quadrática no gráfico.

unique(d$year)

##  [1] 1952 1957 1962 1967 1972 1977 1982 1987 1992 1997 2002 2007

d %>%
  filter(year == 2007) %>%
  ggplot(aes(lgdppc, lifeexp)) +
  geom_point() +
  geom_smooth(method = "lm", formula = y ~ poly(x, 2), se = FALSE) +
  labs(title = paste(nomes$title, "(2007)"),
       caption = nomes$fonte,
       subtitle = "Relação entre expectativa de vida ao nascer e o logaritmo do PIB per capita (fit quadrático)",
       x = nomes$x,
       y = nomes$y) +
  theme_vini

Podemos nos valer de outras informações disponíveis na base para alterar atributos estéticos do gráfico. O tamanho de cada círculo pode refletir o tamanho da população daquele país; a cor do círculo, por sua vez, pode representar o continente daquele país. Por conveniência uso as cores pré-definidas do pacote gapminder. Além disso também podemos destacar o nome de alguns países usando o pacote ggrepel.

data(continent_colors)
library(ggrepel)
destaque <- c("Australia", "Brazil", "Chile", "India", "Nigeria",
              "Sudan", "Taiwan")
d %>%
  filter(year == 2007) %>%
  mutate(country = as.character(country)) %>%
  mutate(sel = ifelse(country %in% destaque, country, NA)) %>%
  ggplot(aes(lgdppc, lifeexp)) +
  geom_point(aes(size = pop, colour = continent), alpha = .75) +
  geom_smooth(method = "lm", formula = y ~ poly(x, 2), se = FALSE,
              color = "black") +
  geom_text_repel(aes(label = sel), family = "Tw Cen MT", force = 20,
                  nudge_y = c(-2, -1, .5, 4, .5, .5, -.5),
                  nudge_x = c(0, .5, 0, 0, 0, 0, 0),
                  size = 5) + 
  labs(title = paste(nomes$title, "(2007)"),
       caption = nomes$fonte,
       x = nomes$x,
       y = nomes$y) +
  scale_color_manual(values = continent_colors, name = "") +
  scale_size_continuous(range = c(1, 20)) +
  guides(size = FALSE) + 
  theme_vini

Tendências

O gráfico acima é um retrato do momento, mas pode ser interessante entender como estas variáveis se comportaram ao longo do tempo.

d %>%
  group_by(year) %>%
  summarise(media = mean(lifeexp)) %>%
  ggplot(aes(year, media, group = 1)) +
  geom_line() +
  geom_point() +
  labs(title = paste(nomes$title, "(média mundial)"),
       caption = nomes$fonte,
       x = nomes$x,
       y = nomes$y) +
  theme_vini

library(RColorBrewer)
ggplot(d, aes(year, lifeexp, group = country, colour = continent)) +
  geom_line() +
  labs(title = "Expecativa de vida (1952/2007)",
       caption = nomes$fonte,
       x = "",
       y = nomes$y) +
  scale_color_brewer(palette = 6, type = "qual", name = "") +
  scale_y_continuous(breaks = seq(from = 30, to = 80, by = 10)) +
  theme_vini

d %>%
  group_by(year, continent) %>%
  summarise(expec_media = mean(lifeexp)) %>%
  ggplot(aes(year, expec_media, group = continent, colour = continent)) +
  geom_line() +
  geom_point() +
  labs(title = "Expecativa de vida média (1952/2007)",
       caption = nomes$fonte,
       x = "",
       y = nomes$y) +
  scale_color_brewer(palette = 6, type = "qual", name = "") +
  theme_vini

eixo_y <- seq(from = 3, to = 4.5, by = .5)
d %>%
  group_by(year, continent) %>%
  summarise(expec_media = mean(lgdppc)) %>%
  ggplot(aes(year, expec_media, group = continent, colour = continent)) +
  geom_line() +
  geom_point() +
  labs(title = "PIB per capita médio (1952/2007)",
       caption = nomes$fonte,
       subtitle = "Escala computada em log (base 10) mas o valor impresso no eixo em US$.",
       x = "",
       y = nomes$x) +
  scale_color_brewer(palette = 6, type = "qual", name = "") +
  scale_y_continuous(breaks = eixo_y,
                labels = format(round(10^eixo_y, 0), big.mark = ".")) +
  theme_vini

Analisando os dados

Podemos encontrar fatos interessantes simplesmente agregando e reorganizando os dados. No gráfico anterior vimos que o continente com maior PIB per capita médio é a Oceania. Curiosamente, a base inclui somente dois países na Oceania: Austrália e Nove Zelândia.

# Note que na Oceania os dados só incluem Autrália e Nova Zelândia
d %>%
  filter(continent == "Oceania") %>%
  arrange(desc(lifeexp), desc(gdppercap)) %>%
  head(10)

## # A tibble: 10 x 7
##    country     continent  year lifeexp      pop gdppercap lgdppc
##    <fct>       <fct>     <int>   <dbl>    <int>     <dbl>  <dbl>
##  1 Australia   Oceania    2007    81.2 20434176    34435.   4.54
##  2 Australia   Oceania    2002    80.4 19546792    30688.   4.49
##  3 New Zealand Oceania    2007    80.2  4115771    25185.   4.40
##  4 New Zealand Oceania    2002    79.1  3908037    23190.   4.37
##  5 Australia   Oceania    1997    78.8 18565243    26998.   4.43
##  6 Australia   Oceania    1992    77.6 17481977    23425.   4.37
##  7 New Zealand Oceania    1997    77.6  3676187    21050.   4.32
##  8 New Zealand Oceania    1992    76.3  3437674    18363.   4.26
##  9 Australia   Oceania    1987    76.3 16257249    21889.   4.34
## 10 Australia   Oceania    1982    74.7 15184200    19477.   4.29

unique(d$country[d$continent == "Oceania"])

## [1] Australia   New Zealand
## 142 Levels: Afghanistan Albania Algeria Angola Argentina ... Zimbabwe

Podemos encontrar os países que mais cresceram (em termos absolutos e relativos) durante o período observado. Note como há vários países asiáticos listados qual seja a métrica escolhida.

# Países que mais cresceram no período da amostra
# termos absolutos
d %>%
  filter(year == min(year) | year == max(year)) %>%
  group_by(country) %>%
  summarise(gap = diff(gdppercap)) %>%
  arrange(desc(gap)) %>%
  head(10) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("hover", "bordered"), full_width = FALSE)

# termos relativos
d %>%
  filter(year == min(year) | year == max(year)) %>%
  group_by(country) %>%
  mutate(gap = gdppercap / dplyr::lag(gdppercap) * 100) %>%
  select(country, gap) %>%
  arrange(desc(gap)) %>%
  head(10) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("hover", "bordered"), full_width = FALSE)

A mesma análise também pode ser feita para a expectativa de vida. Adicionalmente também podemos encontrar qual foi a maior variação (negativa) entre um ponto observado e outro dentro da amostra.

# País que mais aumentou sua expectiativa de vida no período da amostra
# termos abolutos
d %>%
  filter(year == min(year) | year == max(year)) %>%
  group_by(country) %>%
  summarise(gap = diff(lifeexp)) %>%
  arrange(desc(gap)) %>%
  head(10) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("hover", "bordered"), full_width = FALSE)

# termos relativos
d %>%
  filter(year == min(year) | year == max(year)) %>%
  group_by(country) %>%
  mutate(gap = lifeexp / dplyr::lag(lifeexp) * 100) %>%
  arrange(desc(gap)) %>%
  select(country, gap) %>%
  head(10) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("hover", "bordered"), full_width = FALSE)

# Maior variação negativa na lifeexp ano a ano
d %>%
  group_by(country) %>%
  mutate(del = lifeexp - lag(lifeexp)) %>%
  filter(year != 1952) %>%
  arrange(del) %>%
  head() %>%
  kable() %>%
  kable_styling(bootstrap_options = c("hover", "bordered"), full_width = FALSE)

Visualizando o Brasil

Agora vamos analisar o Brasil mais de perto. Para tornar a análise mais concreta escolho um pequeno grupo de países para acompanhar.

# Visualizando a trajetória do Brasil
sub <- c("Argentina", "Brazil", "Chile", "Korea, Rep.", "Venezuela")
sub_d <- d %>%
  filter(country %in% sub)

ggplot() +
  geom_line(data = d, aes(x = year, y = lgdppc, group = country),
            colour = "gray60", alpha = .5) +
  geom_point(data = sub_d, aes(x = year, y = lgdppc, colour = country),
             size = 2) +
  geom_line(data = sub_d, size = 1.25,
            aes(x = year, y = lgdppc, group = country, colour = country)) +
  labs(title = "PIB per capita (1952/2007)",
       caption = nomes$fonte,
       x = "",
       y = nomes$x) +
  scale_color_brewer(palette = 6, type = "qual", name = "") +
  theme_vini

O Brasil em 2007 tinha a 68ª maior expectativa de vida ao nascer a 60º PIB per capita (numa amostra de 142 países). Olhando para a distribuição dos dados, o Brasil não está tão mal em termos de expectativa de vida, mas ainda está bastante atrás dos demais países em termos de PIB. Note que neste último gráfico uso os valores absolutos para facilitar a interpretação. A posição do Brasil é indicada por uma linha vertical em vermelho.

d %>%
  filter(year == 2007) %>%
  ggplot(aes(lifeexp)) +
  geom_histogram(bins = 20) +
  geom_vline(xintercept = 72.4, colour = "tomato", size = 1) +
  scale_y_continuous(expand = c(0, 0), limits  = c(0, 25)) +
  labs(y = "", x = nomes$y,
       title = "Distribuição da expectativa de vida",
       subtitle = "A linha vermelha indica a posição do Brasil.",
       caption = nomes$fonte) +
  theme_vini

d %>%
  filter(year == 2007) %>%
  ggplot(aes(gdppercap)) +
  geom_histogram(bins = 20) +
  geom_vline(xintercept = 9066, colour = "tomato", size = 1) +
  scale_y_continuous(expand = c(0, 0), limits = c(0, 16)) +
  scale_x_continuous(label = format(seq(0, 50000, 10000), big.mark = ".")) + 
  labs(y = "", x = "PIB per capita (US$ 2010)",
       title = "Distribuição do PIB per capita (2007)",
       subtitle = "A linha vermelha indica a posição do Brasil.",
       caption = nomes$fonte) +
  theme_vini

Gráfico interativo

Também é possível produzir gráficos interativos com o R. Estes dados são particularmente bem adaptados a este de visualização pois eles mudam no tempo.

library(plotly)

info <- list(symbol = "circle", sizemode = "diameter",
             line = list(width = 2, color = '#FFFFFF'))
p <-
plot_ly(data = d,
        x = ~lgdppc,
        y = ~lifeexp,
        color = ~continent,
        colors = continent_colors,
        size = ~pop,
        frame = ~year,
        type = "scatter",
        mode = "markers",
        marker = info,
        text = ~paste("Country:", country,
                      "<br>Life Expectancy:", round(lifeexp, 2),
                      '<br>GDP per capita:', round(gdppercap, 2),
                      '<br>Pop.:', format(pop, big.mark = ","))
             ) %>%
plotly::layout( 
               title = "Expectativa de vida e PIB per capita",
               xaxis = list(title = "GDP per capita (US$, log)"),
               yaxis = list(title = "Life Expectancy (years)")
       )

chart_link = api_create(p, filename="Life Expectancy and GDP")
chart_link