Como básico: gráficos de barras

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br


[Esteartigofoipublicadopelaprimeiravezem[Thisarticlewasfirstpublishedon Econometria e Software Livre, e gentilmente contribuiu para os R-blogueiros]. (Você pode relatar um problema sobre o conteúdo desta página aqui)


Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.

Esta postagem do blog mostra como criar gráficos de barras e gráficos de área. É principalmente uma lista de receitas, recuada
para mim. Estes são gráficos que tenho frequentemente que fazer nos relatórios e gostaria de ter o código à mão
algum lugar. Talvez isso seja útil para alguns de vocês também. Na verdade, este post é exatamente como
Comecei minha postagem no blog. Eu queria ter um repositório de receitas e, com o tempo, o blog passou a
o que é agora (tutoriais e eu explorando métodos e conjuntos de dados com R).

Gráficos de barra

Os gráficos de barras são gráficos bastante simples, mas existem variações suficientes deles que merecem
uma única postagem no blog. No entanto, não espere muitas explicações.

Vamos começar carregando alguns dados e os pacotes geralmente necessários:

library(tidyverse)
library(lubridate)
library(janitor)
library(colorspace)
data(gss_cat)

Muitas vezes, o que se quer mostrar são contagens:

gss_cat %>%
  count(marital, race)
## # A tibble: 18 x 3
##    marital       race      n
##  *           
##  1 No answer     Other     2
##  2 No answer     Black     2
##  3 No answer     White    13
##  4 Never married Other   633
##  5 Never married Black  1305
##  6 Never married White  3478
##  7 Separated     Other   110
##  8 Separated     Black   196
##  9 Separated     White   437
## 10 Divorced      Other   212
## 11 Divorced      Black   495
## 12 Divorced      White  2676
## 13 Widowed       Other    70
## 14 Widowed       Black   262
## 15 Widowed       White  1475
## 16 Married       Other   932
## 17 Married       Black   869
## 18 Married       White  8316

Vamos agrupar os estados conjugais que aparecem menos de 10% do tempo em uma categoria “Outros”:

(
  counts_marital_race %
    mutate(marital = fct_lump(marital, prop = 0.1)) %>%
    count(marital, race)
)
## # A tibble: 12 x 3
##    marital       race      n
##  *           
##  1 Never married Other   633
##  2 Never married Black  1305
##  3 Never married White  3478
##  4 Divorced      Other   212
##  5 Divorced      Black   495
##  6 Divorced      White  2676
##  7 Married       Other   932
##  8 Married       Black   869
##  9 Married       White  8316
## 10 Other         Other   182
## 11 Other         Black   460
## 12 Other         White  1925

O gráfico de barras mais simples:

ggplot(counts_marital_race) +
  geom_col(aes(x = marital, y = n, fill = race)) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog()

Agora com position = "dodge":

ggplot(counts_marital_race) +
  geom_col(aes(x = marital, y = n, fill = race), position = "dodge") +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog()

Movendo a lenda com theme(legend.position = ...):

ggplot(counts_marital_race) +
  geom_col(aes(x = marital, y = n, fill = race), position = "dodge") +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() +
  theme(legend.position = "left")

Contando também por ano:

(
  counts_marital_race_year %
    mutate(marital = fct_lump(marital, prop = 0.1)) %>%
    count(year, marital, race) %>%
    ungroup()
)
## # A tibble: 96 x 4
##     year marital       race      n
##  *            
##  1  2000 Never married Other    60
##  2  2000 Never married Black   157
##  3  2000 Never married White   495
##  4  2000 Divorced      Other    20
##  5  2000 Divorced      Black    60
##  6  2000 Divorced      White   361
##  7  2000 Married       Other    78
##  8  2000 Married       Black   121
##  9  2000 Married       White  1079
## 10  2000 Other         Other    17
## # … with 86 more rows

Quando você deseja mostrar como uma variável evolui com o tempo, o gráfico de áreas é útil:

counts_marital_race_year %>%
  group_by(year, marital) %>%
  summarise(n = sum(n)) %>%
  ggplot() +
  geom_area(aes(x = year, y = n, fill = marital)) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Leia Também  Estourar os balões - jogo de matemática para educação em casa

Agora com facetas:

counts_marital_race_year %>%
  ggplot() +
  geom_area(aes(x = year, y = n, fill = marital)) +
  facet_wrap(facets = vars(race), ncol = 1) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Mas e se eu quiser que cada gráfico tenha seu próprio eixo y?

counts_marital_race_year %>%
  ggplot() +
  geom_area(aes(x = year, y = n, fill = marital)) +
  facet_wrap(facets = vars(race), ncol = 1, scales = "free_y") +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Agora, faça um gráfico de áreas, mas com frequências relativas:

counts_marital_race_year %>% 
  group_by(year, marital) %>% 
  summarise(n = sum(n)) %>%  
  mutate(freq = n/sum(n)) %>% 
  ggplot() +
  geom_area(aes(x = year, y = freq, fill = marital)) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Com facet_wrap():

counts_marital_race_year %>% 
  group_by(race, year, marital) %>% 
  summarise(n = sum(n)) %>%  
  mutate(freq = n/sum(n)) %>% 
  ggplot() +
  geom_area(aes(x = year, y = freq, fill = marital)) +
  facet_wrap(facets = vars(race), ncol = 1, scales = "free_y") +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Deseja substituir 2000 por “2000-01-01”? Primeiro, é necessário criar um vetor de datas e posições mais bonitas:

pretty_dates %
  mutate(pretty_dates = paste0(year, "-01-01")) %>%
  pull(pretty_dates) %>%
  unique()

position_dates %
  pull(year) %>%
  unique() %>%
  sort() 

scale_x_continuous() agora pode usar isso. Usando guide = guide_axis(n.dodge = 2) evitar
etiquetas sobrepostas:

counts_marital_race_year %>% 
  group_by(race, year, marital) %>% 
  summarise(n = sum(n)) %>%  
  mutate(freq = n/sum(n)) %>%
  ggplot() +
  geom_area(aes(x = year, y = freq, fill = marital)) +
  facet_wrap(facets = vars(race), ncol = 1, scales = "free_y") +
  scale_x_continuous("Year of survey", labels = pretty_dates,
                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Adicionar rótulos não é trivial. Aqui não está funcionando:

counts_marital_race_year %>% 
  group_by(race, year, marital) %>% 
  summarise(n = sum(n)) %>%  
  mutate(freq = n/sum(n)) %>% 
  ggplot() +
  geom_area(aes(x = year, y = freq, fill = marital)) +
  facet_wrap(facets = vars(race), ncol = 1, scales = "free_y") +
  scale_x_continuous("Year of survey", labels = pretty_dates,
                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +
  geom_label(aes(x = year, y = freq, label = round(100 * freq))) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Outra tentativa falhada. Deixo aqui para a posteridade.
Minha primeira ideia foi primeiro classificar o conjunto de dados agrupados por frequência decrescente e depois
reordenar a variável fator marital por posição descendente, que é a porcentagem cumulativa.
Isso funcionaria bem, se os mesmos níveis de fator tivessem a mesma ordem para cada um dos
categorias de corrida. No entanto, este não é o caso. Para os negros, a categoria mais frequente é “Nunca se casou”.
Como você pode ver abaixo, esse truque funcionou bem para 2 categorias em 3:

counts_marital_race_year %>% 
  group_by(race, year, marital) %>% 
  summarise(n = sum(n)) %>%  
  mutate(freq = n/sum(n)) %>%
  group_by(year, race) %>%  
  arrange(desc(freq)) %>% 
  mutate(position = cumsum(freq)) %>% 
  mutate(marital = fct_reorder(marital, desc(position))) %>% 
  ggplot() +
  geom_area(aes(x = year, y = freq, fill = marital)) +
  facet_wrap(facets = vars(race), ncol = 1, scales = "free") +
  scale_x_continuous("Year of survey", labels = pretty_dates,
                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +
  geom_label(aes(x = year, y = position, label = round(100 * freq))) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br

Portanto, para remediar isso, não é reordenar muito cedo; primeiro, precisamos reordenar a variável fator
frequência. Em seguida, organizamos os dados pelo agora reordenado marital variável, e então podemos
calcule a posição usando a frequência cumulativa.

counts_marital_race_year %>% 
  group_by(race, year, marital) %>% 
  summarise(n = sum(n)) %>%  
  mutate(freq = n/sum(n)) %>%
  group_by(year, race) %>%  
  mutate(marital = fct_reorder(marital, freq)) %>% 
  arrange(desc(marital)) %>% 
  mutate(position = cumsum(freq)) %>% 
  ggplot() +
  geom_area(aes(x = year, y = freq, fill = marital)) +
  facet_wrap(facets = vars(race), ncol = 1, scales = "free") +
  scale_x_continuous("Year of survey", labels = pretty_dates,
                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +
  geom_label(aes(x = year, y = position, label = round(100 * freq))) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Leia Também  Machine Learning com R: uma introdução prática de Robert Muenchen na Machine Learning Week, Las Vegas

Podemos colocar os rótulos um pouco melhor (no meio de suas respectivas áreas), assim:

counts_marital_race_year %>% 
  group_by(race, year, marital) %>% 
  summarise(n = sum(n)) %>%  
  mutate(freq = n/sum(n)) %>%
  group_by(year, race) %>%  
  mutate(marital = fct_reorder(marital, freq)) %>% 
  arrange(desc(marital)) %>% 
  mutate(position = cumsum(freq)) %>% mutate(prev_pos = lag(position, default = 0)) %>%
  mutate(position = (position + prev_pos)/2) %>%  
  ggplot() +
  geom_area(aes(x = year, y = freq, fill = marital)) +
  facet_wrap(facets = vars(race), ncol = 1, scales = "free") +
  scale_x_continuous("Year of survey", labels = pretty_dates,
                     breaks = position_dates, guide = guide_axis(n.dodge = 2)) +
  geom_label(aes(x = year, y = position, label = round(100 * freq))) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Agora vamos nos concentrar na variável tvhours. Queremos mostrar o total de horas assistidas, mas também
o total em todas as categorias de race e marital em um gráfico de barras facetado:

(
  total_tv %
    group_by(year, race, marital) %>%
    summarise(total_tv = sum(tvhours, na.rm = TRUE))
)
## # A tibble: 127 x 4
## # Groups:   year, race [24]
##     year race  marital       total_tv
##                  
##  1  2000 Other No answer            2
##  2  2000 Other Never married      103
##  3  2000 Other Separated           16
##  4  2000 Other Divorced            17
##  5  2000 Other Widowed             24
##  6  2000 Other Married            122
##  7  2000 Black Never married      452
##  8  2000 Black Separated          135
##  9  2000 Black Divorced           156
## 10  2000 Black Widowed            183
## # … with 117 more rows

Essa tagarelice tem o total de horas assistidas por ano, raça e estado civil. Como adicionar o total
por ano e categorias de raça? Para isso, primeiro vamos usar o group_split():

total_tv_split %
  select(race, year, marital, total_tv) %>%
  mutate(year = as.character(year)) %>%  
  group_split(year, race)
## Warning: ... is ignored in group_split(), please use
## group_by(..., .add = TRUE) %>% group_split()

Eu tenho que reordenar as colunas com select()porque ao usar janitor::adorn_totals(), qual
Usarei abaixo para adicionar totais. A primeira coluna deve ser uma coluna de caracteres (ela serve como
uma coluna identificadora).

Isso cria uma lista com 3 corridas vezes 6 anos, portanto 24 elementos. Cada elemento da lista é uma pitada
com cada combinação única de ano e raça:

length(total_tv_split)
## [1] 24
total_tv_split[1:2]
## 
## >[2]>
## [[1]]
## # A tibble: 6 x 4
##   race  year  marital       total_tv
##                 
## 1 Other 2000  No answer            2
## 2 Other 2000  Never married      103
## 3 Other 2000  Separated           16
## 4 Other 2000  Divorced            17
## 5 Other 2000  Widowed             24
## 6 Other 2000  Married            122
## 
## [[2]]
## # A tibble: 5 x 4
##   race  year  marital       total_tv
##                 
## 1 Black 2000  Never married      452
## 2 Black 2000  Separated          135
## 3 Black 2000  Divorced           156
## 4 Black 2000  Widowed            183
## 5 Black 2000  Married            320

Por que fazer isso? Usar janitor::adorn_totals(), que adiciona totais em linhas a um quadro de dados ou a
cada quadro de dados se uma lista de quadros de dados for passada para ele. Eu ainda preciso transformar os dados um pouco
mordeu. Depois de usar adorn_totals(), Vinculo minha lista de quadros de dados e preenche o ano
coluna (ao usar adorn_totals(), colunas de caracteres como year são preenchidos com "-", mas eu escolhi
preenchê-lo com NA_character_) Em seguida, substituo o valor de NA da coluna conjugal pelo
corda "Total" e depois reordene o marital coluna pelo valor de total_tv:

total_tv_split %
  adorn_totals(fill = NA_character_) %>%
  map(as.data.frame) %>%  
  bind_rows() %>%
  fill(year, .direction = "down") %>%
  mutate(marital = ifelse(is.na(marital), "Total", marital)) %>%
  mutate(marital = fct_reorder(marital, total_tv))

Finalmente posso criar meu enredo. Porque eu adicionei “Total” como um nível no marital coluna,
agora aparece perfeitamente na trama:

ggplot(total_tv_split) +
  geom_col(aes(x = marital, y = total_tv, fill = race)) +
  facet_wrap(facets = vars(year), nrow = 2) +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  scale_x_discrete(guide = guide_axis(n.dodge = 3)) +
  brotools::theme_blog() 

Para finalizar esta lista de receitas, vamos fazer um gráfico de pirâmide agora (inspiração aqui:

data_pyramid %
  filter(year == "2000", marital %in% c("Married", "Never married")) %>%
  group_by(race, marital, rincome) %>%  
  summarise(total_tv = sum(tvhours, na.rm = TRUE))

ggplot(data_pyramid, aes(x = rincome, y = total_tv, fill = marital)) +
  geom_col(data = filter(data_pyramid, marital == "Married")) +
  geom_col(data = filter(data_pyramid, marital == "Never married"), aes(y = total_tv * (-1))) +
  facet_wrap(facets = vars(race), nrow = 1, scales = "free_x") +
  coord_flip() +
  scale_fill_discrete_qualitative(palette = "Dark 3") +
  brotools::theme_blog() 

Feliz Páscoa!

Espero que tenha gostado! Se você achou este post útil, talvez queira seguir
eu em Twitter para atualizações de postagens no blog e
compre-me um café expresso ou paypal.me ou compre meu e-book no Leanpub.

.bmc-button img {width: 27px! important; margin-bottom: 1px! important; box-shadow: none! important; border: none! important; vertical: align: middle! important;}. bmc-button {line- altura: 36px! importante; altura: 37px! importante; decoração de texto: nenhuma! importante; exibição: inline-flex! importante; cor: #ffffff! importante; cor de fundo: # 272b30! importante; raio da borda: 3px! importante; borda: 1px transparente transparente! importante; preenchimento: 1px 9px! importante; tamanho da fonte: 22px! importante; espaçamento entre letras: 0,6px! importante; caixa-sombra: 0px 1px 2px rgba (190, 190, 190, 0,5 )! important; -webkit-box-shadow: 0px 1px 2px 2px rgba (190, 190, 190, 0,5)! important; margin: 0 auto! important; família da fonte: ‘Cookie’, cursivo! importante; -webkit- tamanho da caixa: borda da caixa! importante; tamanho da caixa: borda da caixa! importante; -o-transição: 0,3s tudo linear! importante; -webkit-transição: 0,3s tudo linear! importante; -moz-transição: 0,3 s tudo linear! importante; -ms-transição: 0,3s tudo linear! importante; transição: 0,3s tudo linear! importante;}. bmc-b utton: pairar, botão .bmc: ativo, botão .bmc: foco {-webkit-box-shadow: 0px 1px 2px 2px rgba (190, 190, 190, 0,5)! important; decoração de texto: nenhuma! importante; box-shadow: 0px 1px 2px 2px rgba (190, 190, 190, 0,5)! importante; opacidade: 0,85! importante; cor: # 82518c! importante;}
Compre-me um café expressoCompre-me um café expresso

var vglnk = {key: ‘949efb41171ac6ec1bf7f206d57e90b8’};

(função (d, t) {
var s = d.createElement
s.src = ‘//cdn.viglink.com/api/vglnk.js’;
var r = d.getElementsByTagName
} (documento, ‘script’));

Para Deixe um comentário para o autor, siga o link e comente no blog: Econometria e Software Livre.

R-bloggers.com oferece atualizações diárias por email sobre notícias e tutoriais do R sobre o aprendizado do R e muitos outros tópicos. Clique aqui se você deseja publicar ou encontrar um emprego em ciência da dados / R.


Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.



cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br