Correlações de altura e massa em Star Wars

library(tidyverse)
theme_set(theme_bw())

starwars

Altura e massa

Primeiro passo, examinar o formato dos dados.

starwars %>% 
  filter(!is.na(height), !is.na(mass)) %>% 
  ggplot(aes(x = height, y = mass)) + 
  geom_point() 

Ops. Quem é esse ser de 1 tonelada?

starwars %>% 
  filter(mass > 1e3)

starwars %>% 
  filter(species == "Hutt") %>% 
  count()

Jabba é o único da sua espécie, e é um ponto bem extremo, enquanto a relação dos demais seres parece linear. Nas análises abaixo, desconsideraremos ele.

Aproveitando, pode ser que espécies diferentes tenham comportamento muito diferente. Vamos separar então humanos de não humanos.

starwars %>% 
  filter(mass < 500) %>% 
  mutate(species = if_else(species == "Human" & !is.na(species), "Human", "Other")) %>% 
  ggplot(aes(x = height, y = mass, color = species)) + 
  geom_point() + 
  facet_wrap(~species) + 
  theme(legend.position = "None")

Repare nos pontos extremos entre os humanos, e em uma certa não linearidade entre os demais.

Quem são os extremos?

starwars %>% 
  filter(species == "Human", mass > 100 | mass < 60) %>% 
  arrange(-mass)

Parecem plausíveis de analisarmos junto com os demais.

Transformação de rank alteram os dados para que seja mais fácil ver correlações independente de não linearidade e de pontos extremos:

starwars %>% 
  filter(mass < 500) %>% 
  mutate(species = if_else(species == "Human" & !is.na(species), "Human", "Other"), 
         `height rank` = rank(height), 
         `mass rank` = rank(mass)) %>% 
  ggplot(aes(x = `height rank` , y = `mass rank`, color = species)) + 
  geom_point() + 
  facet_wrap(~species) + 
  theme(legend.position = "None")

Com a transformação de rank, os pontos extremos entre os humanos tem menos peso, e a relação entre os outros fica bem mais linear. Lembre que os coef. de Spearman e Kendall operam sobre ranks.

starwars %>% 
  filter(mass < 500, !is.na(height), !is.na(mass)) %>% 
  mutate(species = if_else(species == "Human" & !is.na(species), "Human", "Other")) %>% 
  group_by(species) %>% 
  summarise(
    pearson = cor(height, mass, method = "pearson"), 
    spearman = cor(height, mass, method = "spearman"), 
    kendall = cor(height, mass, method = "kendall")
  )

A correlação de spearman dos humanos é mais próxima da dos não humanos, já que o efeito dos pontos extremos foi reduzido. A correlação dos não humanos é um pouco maior porque a não linearidade (que era sutil) foi diminuída. A correlação de kendall é mais difícil de comparar, mas ela aponta que a correlação é semelhante entre humanos e não humanos.

A propósito, na nossa análise nós desconsideramos o ser que tem massa > 500kg. Veja como cada coeficiente de correlação é afetado se o incluímos:

starwars %>% 
  filter(!is.na(height), !is.na(mass)) %>% 
  mutate(species = if_else(species == "Human" & !is.na(species), "Human", "Other")) %>% 
  group_by(species) %>% 
  summarise(
    pearson = cor(height, mass, method = "pearson"), 
    spearman = cor(height, mass, method = "spearman"), 
    kendall = cor(height, mass, method = "kendall")
  )

Idade e massa

starwars %>% 
  filter(mass < 500, birth_year < 500) %>% 
  mutate(species = if_else(species == "Human" & !is.na(species), "Human", "Other")) %>% 
  ggplot(aes(x = birth_year, y = mass, color = species)) + 
  geom_point() + 
  facet_wrap(~species)

Com a transformação de rank:

starwars %>% 
  filter(mass < 500) %>% 
  mutate(species = if_else(species == "Human" & !is.na(species), "Human", "Other"), 
         birth_year = rank(birth_year), 
         mass = rank(mass)) %>% 
  ggplot(aes(x = birth_year, y = mass, color = species)) + 
  geom_point() + 
  facet_wrap(~species)

starwars %>% 
  filter(mass < 500, birth_year < 500, !is.na(birth_year), !is.na(mass)) %>% 
  mutate(species = if_else(species == "Human" & !is.na(species), "Human", "Other")) %>% 
  group_by(species) %>% 
  summarise(
    pearson = cor(birth_year, mass, method = "pearson"), 
    spearman = cor(birth_year, mass, method = "spearman"), 
    kendall = cor(birth_year, mass, method = "kendall")
  )

E se mantivermos o ponto extremo pela variável birth_year:

starwars %>% 
  filter(mass < 500, !is.na(birth_year), !is.na(mass)) %>% 
  mutate(species = if_else(species == "Human" & !is.na(species), "Human", "Other")) %>% 
  group_by(species) %>% 
  summarise(
    pearson = cor(birth_year, mass, method = "pearson"), 
    spearman = cor(birth_year, mass, method = "spearman"), 
    kendall = cor(birth_year, mass, method = "kendall")
  )

Se mantivermos o ponto extremo segundo massa, o resultado muda também. Lição: muito cuidado com pontos extremos se você usar pearson.