Aula 4 - Pares de Tabelas e Grupos de Variáveis

Operação em Grupos e Pares de Tabelas

Seja bem-vindo a quarta aula do nosso minicurso de Fundamentos de Processamento de Dados Utilizando o Tidyverse!

Parabéns por chegar até aqui!!

Na aula de hoje, iremos:

Conhecer as funções dplyr::join para junção de pares de tabelas
Começar a trabalhar com operações via dplyr::summarise em observações agrupadas com a função dplyr::group_by

1 Junção de Conjunto de Dados

As funções com sufixo **_join** possuem o objetivo de juntar pares de conjunto de dados baseado em alguma condição e alguma chave

Dado dois conjuntos de dados, x e y. Sua sintaxe é dada por:

dplyr::prefixo_join(dados_x, dados_y, 
             by = 'chave')

Temos que os prefixos disponíveis no dplyr são

inner
- Mantém apenas as observações que possuem chave em x equivalente em y
full
- Mantém todas as observações de x e y
left e right
- Left: Mantém todas as observações de x
- Right: Mantém todas as observações de y

Imagem reirada do site do Metabase

As funções do pacote possuem argumentos semelhantes com os argumentos do SQL:

relationship
- 1 para 1; 1 para muitos, muitos para 1; muitos para muitos
multiple
- Observações com múltiplas correspondências
unmatched
- Remover observações sem correspondência ou landar um erro

Os argumentos podem ser vistos via help da função: ?dplyr::inner_join ou via o website oficial Joins dplyr

1.1 Exemplo - Futebol Europeu

Os seguintes conjuntos de dados foram construidos a partir do site Transfermarkt via raspagem de dados

3 conjuntos de dados foram construídos
- Participantes da La Liga na temporada de 22/23
- Participantes da Liga dos Campeões na temporada de 22/23
- Participantes da Liga Europa na temporada de 22/23

library(rvest)

url_la_liga = rvest::read_html('https://www.transfermarkt.com.br/laliga/tabelle/wettbewerb/ES1?saison_id=2022')

web_scrap_la_liga = data.frame(
  times = url_la_liga |>
      rvest::html_nodes('#yw1 .no-border-links')|>
      rvest::html_text() |>
      stringr::str_remove_all('fc') |>
      stringr::str_remove_all('cf') |>
      stringr::str_trim() |>
      str_replace_all("\\s+", "_") |>
      tolower() |>
      abjutils::rm_accent(),
  pts = url_la_liga |>
      rvest::html_nodes('.zentriert:nth-child(10)')|>
      rvest::html_text()
)

url_champions_league =  rvest::read_html('https://www.transfermarkt.com.br/uefa-champions-league/teilnehmer/pokalwettbewerb/CL/saison_id/2022')

web_scrap_champions_league = 
  data.frame(
    times = url_champions_league |>
        rvest::html_nodes('.hauptlink')|>
        rvest::html_text() |>
        tolower() |>
        stringr::str_remove_all('fc') |>
        stringr::str_remove_all('cf') |>
        stringr::str_trim() |>
        stringr::str_replace_all(' ', '_') |>
        abjutils::rm_accent(), 
    idade_media = url_champions_league |>
        rvest::html_nodes('.zentriert+ td.zentriert')|>
        rvest::html_text(),
    valor_mercado = url_champions_league |>
        rvest::html_nodes('.zentriert+ td.rechts') |>
        rvest::html_text()
  ) |>
  dplyr::mutate(idade_media = idade_media |>
                  stringr::str_replace(',','.') |>
                  as.numeric())


url_europa_league =  rvest::read_html('https://www.transfermarkt.com.br/europa-league/teilnehmer/pokalwettbewerb/EL/saison_id/2022')

web_scrap_europa_league = 
  data.frame(
    times = url_europa_league |>
        rvest::html_nodes('.hauptlink')|>
        rvest::html_text() |>
        tolower() |>
        stringr::str_remove_all('fc') |>
        stringr::str_remove_all('cf') |>
        stringr::str_trim() |>
        stringr::str_replace_all(' ', '_') |>
        abjutils::rm_accent(), 
    idade_media = url_europa_league |>
        rvest::html_nodes('.zentriert+ td.zentriert')|>
        rvest::html_text(),
    valor_mercado = url_europa_league |>
        rvest::html_nodes('.zentriert+ td.rechts') |>
        rvest::html_text()
  ) |>
  dplyr::mutate(
    idade_media = 
      idade_media |>
      stringr::str_replace(',','.') |>
      as.numeric()
    )

Dados La Liga

web_scrap_la_liga |>
  rmarkdown::paged_table()

Dados Liga dos Campeões

web_scrap_champions_league |>
  rmarkdown::paged_table()

Dados Liga Europa

web_scrap_europa_league |>
  rmarkdown::paged_table()

Com tabelas já construidas podemos realizar os cruzamentos

Times de La Liga que estiveram na Liga dos Campeões

dplyr::inner_join(web_scrap_champions_league, web_scrap_la_liga,
                  by = 'times')

        times idade_media  valor_mercado pts
1 real_madrid        25.4 1,03 bilhões \200  78
2   barcelona        24.0   862,00 mi. \200  88

Times de La Liga que estiveram na Liga Europa

dplyr::inner_join(web_scrap_la_liga, web_scrap_europa_league, 
                  by = 'times')

          times pts idade_media valor_mercado
1     barcelona  88        24.0  862,00 mi. \200
2 real_sociedad  71        24.5  432,60 mi. \200

Times que estiveram na Liga dos Campeões e na Liga Europa

dplyr::inner_join(web_scrap_champions_league, web_scrap_europa_league, 
                  by = 'times')

                times idade_media.x valor_mercado.x idade_media.y
1           barcelona          24.0    862,00 mi. \200          24.0
2 bayer_04_leverkusen          24.2    523,25 mi. \200          24.2
3            juventus          25.4    421,60 mi. \200          25.4
4         sporting_cp          23.5    280,30 mi. \200          23.5
5   red_bull_salzburg          22.1    219,80 mi. \200          22.1
6             sevilla          26.3    187,00 mi. \200          26.3
7              a_ajax          23.6    186,55 mi. \200          23.6
8    shakhtar_donetsk          24.6    113,00 mi. \200          24.6
  valor_mercado.y
1    862,00 mi. \200
2    523,25 mi. \200
3    421,60 mi. \200
4    280,30 mi. \200
5    219,80 mi. \200
6    187,00 mi. \200
7    186,55 mi. \200
8    113,00 mi. \200

2 Agrupamento por Variável

A função group_by tem como objetivo agrupamento de observações por alguma variável de correspondência, permitindo transformações de variáveis em observações já agrupadas.

Na etapa de agrupamento, as seguintes funções são as mais utilizadas

dplyr::group_by()
- Dado um tibble, as observações serão agrupadas por uma ou mais variáveis passadas como argumento

Tem a seguinte sintaxe

dados |>
  dplyr::group_by(variavel_1, variavel_2, ..., variavel_n)

dplyr::summarise
- Dado um tibble já agrupado via dplyr::group_by(), a função aplica alguma transformação como média, soma e etc em alguma variável de interesse

Tem a seguinte sintaxe

dados |>
  dplyr::group_by(variavel_1, variavel_2, ..., variavel_n) |>
  dplyr::summarise(nova_variavel = função(variavel_existente))

dplyr::ungroup
- Dado um tibble já agrupado via dplyr::group_by(), a função remove os grupos, retornando o o tibble padrão

dados |>
  dplyr::group_by(variavel_1, variavel_2, ..., variavel_n) |>
  dplyr::ungroup()

2.1 Exemplo - Atletismo nas Olimpíadas

O seguinte conjunto de dados tras informações sobre os tempos de eventos de atletismo nas olimpíadas

tsibbledata::olympic_running |>
  tibble::as.tibble() |>
  janitor::clean_names() |>
  rmarkdown::paged_table()

Calculando uma média por evento e por sexo

tsibbledata::olympic_running |>
  tibble::as.tibble() |>
  janitor::clean_names() |>
  dplyr::group_by(length, sex) |>
  dplyr::summarise(media_tempo = mean(time, na.rm = T))

# A tibble: 14 x 3
# Groups:   length [7]
   length sex   media_tempo
    <int> <chr>       <dbl>
 1    100 men          10.3
 2    100 women        11.2
 3    200 men          20.6
 4    200 women        22.5
 5    400 men          46.0
 6    400 women        49.6
 7    800 men         109. 
 8    800 women       119. 
 9   1500 men         226. 
10   1500 women       242. 
11   5000 men         827. 
12   5000 women       896. 
13  10000 men        1719. 
14  10000 women      1826.

Calculando o tempo mínimo por evento e por sexo

tsibbledata::olympic_running |>
  tibble::as.tibble() |>
  janitor::clean_names() |>
  dplyr::group_by(length, sex) |>
  dplyr::summarise(minimo_tempo = min(time, na.rm=T))

# A tibble: 14 x 3
# Groups:   length [7]
   length sex   minimo_tempo
    <int> <chr>        <dbl>
 1    100 men           9.63
 2    100 women        10.5 
 3    200 men          19.3 
 4    200 women        21.3 
 5    400 men          43.0 
 6    400 women        48.2 
 7    800 men         101.  
 8    800 women       114.  
 9   1500 men         212.  
10   1500 women       234.  
11   5000 men         778.  
12   5000 women       866.  
13  10000 men        1621.  
14  10000 women      1757.

Observando a evolução dos tempos conjuntos: masculinos e femininos por evento e por ano

tempo_cat = tsibbledata::olympic_running |>
  tibble::as.tibble() |>
  janitor::clean_names() |>
  dplyr::group_by(length, year) |>
  dplyr::summarise(evolucao_tempo = mean(time, na.rm = T))

tempo_cat |>
  ggplot(aes(x = year, y = evolucao_tempo)) +
  geom_line() +
  facet_wrap('length', scales = 'free')

3 Desafios

3.1 Dados - PRF Sudeste

O seguinte conjunto de dados foi baixado no site do Detran, se tratando de acidentes de transito de 2023

O conjunto de dados possui observações do Brasil inteiro, nosso objetivo é limpar esse conjunto, filtrando apenas pelas observações da região Sudeste

df_prf = readr::read_csv2(here::here('./conjunto_de_dados/datatran2023.csv'), 
                          locale = readr::locale(encoding = "latin1")) |>
  dplyr::select(-uf) |>
  dplyr::mutate(municipio = municipio |>
           tolower() |>
           stringr::str_replace_all(' ', "_"))


df_prf |>
  head() |>
  rmarkdown::paged_table()

Construindo a tabela de estados

library(rvest)
url = rvest::read_html('https://www.ibge.gov.br/explica/codigos-dos-municipios.php')

web_scrap_ufs = data.frame(
  uf = url|>
      rvest::html_nodes('.uf td:nth-child(1) a')|>
      rvest::html_text() |>
      stringr::str_replace_all(' ', "_"),
  cod_uf = url|>
      rvest::html_nodes('.numero a')|>
      rvest::html_text()
) |>
  dplyr::mutate(
    cod_uf = cod_uf |> 
      stringr::str_remove('ver municípios') |>
      as.numeric(),
    uf = uf |> 
      tolower() |>
      abjutils::rm_accent()
    
    )

web_scrap_ufs |> head()

        uf cod_uf
1     acre     12
2  alagoas     27
3    amapa     16
4 amazonas     13
5    bahia     29
6    ceara     23

Construindo a tabela de municípios

web_scrap_mun = 
  data.frame(
    municipio = url|>
      rvest::html_nodes('.municipio a')|>
      rvest::html_text() |>
      tolower() |> 
      abjutils::rm_accent() |>
      stringr::str_replace_all(' ', "_"),
    cod_mun = url |>
      rvest::html_nodes('.municipio .numero')|>
      rvest::html_text() |>
      as.numeric()
    ) |>
  dplyr::mutate(cod_uf = cod_mun |>
                  as.character() |>
                  stringr::str_sub(1, 2) |>
                  as.numeric()) 

web_scrap_mun |> head()

        municipio cod_mun cod_uf
1      acrelandia 1200013     12
2    assis_brasil 1200054     12
3       brasileia 1200104     12
4          bujari 1200138     12
5        capixaba 1200179     12
6 cruzeiro_do_sul 1200203     12

Com as funções que vimos hoje de junção de tabelas, podemos finalmente juntar a tabela de município, com tabela de ufs e a tabela de acidentes

Junção municípios com ufs

df_mun_uf = web_scrap_mun |>
  left_join(web_scrap_ufs, by = 'cod_uf')

Junção dados acidente com municípios_ufs

df_prf |>
  left_join(df_mun_uf, by = 'municipio')

# A tibble: 54,113 x 32
       id data_inversa dia_semana horario    br    km municipio   causa_acidente
    <dbl> <date>       <chr>      <time>  <dbl> <dbl> <chr>       <chr>         
 1 496519 2023-01-01   domingo    02:00     101  114  sooretama   Ausência de r~
 2 496543 2023-01-01   domingo    03:40     116  113. taubate     Entrada inopi~
 3 496590 2023-01-01   domingo    01:40     163 1112  guaranta_d~ Reação tardia~
 4 496610 2023-01-01   domingo    10:40     376  315. ortigueira  Velocidade In~
 5 496659 2023-01-01   domingo    14:55     116  569. manhuacu    Acumulo de ág~
 6 496671 2023-01-01   domingo    15:45     262  570. corrego_da~ Condutor Dorm~
 7 496673 2023-01-01   domingo    18:10     116  152  mandirituba Desrespeitar ~
 8 496686 2023-01-01   domingo    20:00     381  897. cambui      Demais falhas~
 9 496709 2023-01-01   domingo    21:54     116  106. taubate     Transitar na ~
10 496711 2023-01-01   domingo    21:50     116  366  serrinha    Velocidade In~
# i 54,103 more rows
# i 24 more variables: tipo_acidente <chr>, classificacao_acidente <chr>,
#   fase_dia <chr>, sentido_via <chr>, condicao_metereologica <chr>,
#   tipo_pista <chr>, tracado_via <chr>, uso_solo <chr>, pessoas <dbl>,
#   mortos <dbl>, feridos_leves <dbl>, feridos_graves <dbl>, ilesos <dbl>,
#   ignorados <dbl>, feridos <dbl>, veiculos <dbl>, latitude <dbl>,
#   longitude <dbl>, regional <chr>, delegacia <chr>, uop <chr>, ...

Por organização, não trabalhamos com dados dos nomes das cidades e das ufs na tabela de dados de , utilizamos apenas as chaves: cod_mun e cod_uf

df_prf_geo = df_prf |>
  left_join(df_mun_uf, by = 'municipio') |>
  dplyr::select(-municipio, -uf)


df_prf_geo |> 
  rmarkdown::paged_table()

Assim, agora com a tabela de acidentes ja contendo informações de cidade e ufs, podemos filtrar pela região Sudeste

df_prf_geo |>
  dplyr::mutate(cod_uf = 
                  cod_uf |> as.character()) |>
  dplyr::filter(cod_uf |>
                  stringr::str_starts('3'))

# A tibble: 16,224 x 30
       id data_inversa dia_semana    horario    br    km causa_acidente         
    <dbl> <date>       <chr>         <time>  <dbl> <dbl> <chr>                  
 1 496519 2023-01-01   domingo       02:00     101  114  Ausência de reação do ~
 2 496543 2023-01-01   domingo       03:40     116  113. Entrada inopinada do p~
 3 496659 2023-01-01   domingo       14:55     116  569. Acumulo de água sobre ~
 4 496671 2023-01-01   domingo       15:45     262  570. Condutor Dormindo      
 5 496686 2023-01-01   domingo       20:00     381  897. Demais falhas mecânica~
 6 496709 2023-01-01   domingo       21:54     116  106. Transitar na contramão 
 7 496712 2023-01-01   domingo       19:30     381  365  Demais falhas mecânica~
 8 496731 2023-01-01   domingo       22:20     465   18  Acessar a via sem obse~
 9 496789 2023-01-02   segunda-feira 10:20     101  330. Manobra de mudança de ~
10 496795 2023-01-02   segunda-feira 08:25     365  376  Reação tardia ou inefi~
# i 16,214 more rows
# i 23 more variables: tipo_acidente <chr>, classificacao_acidente <chr>,
#   fase_dia <chr>, sentido_via <chr>, condicao_metereologica <chr>,
#   tipo_pista <chr>, tracado_via <chr>, uso_solo <chr>, pessoas <dbl>,
#   mortos <dbl>, feridos_leves <dbl>, feridos_graves <dbl>, ilesos <dbl>,
#   ignorados <dbl>, feridos <dbl>, veiculos <dbl>, latitude <dbl>,
#   longitude <dbl>, regional <chr>, delegacia <chr>, uop <chr>, ...

Se por exemplo, quisesemos filtrar pelas observações da baixada santista, que possue as cidades: Santos, Praia Grande, São Vicente, Mongagua e Guarujá

cidades_baixada = c('praia_grande',
                    'santos', 
                    'guaruja',
                    'mongagua')

df_mun_uf |>
  dplyr::filter(municipio %in% cidades_baixada & uf == 'sao_paulo' ) |>
  dplyr::left_join(df_prf_geo, by = 'cod_mun')

     municipio cod_mun cod_uf.x        uf id data_inversa dia_semana horario br
1      guaruja 3518701       35 sao_paulo NA         <NA>       <NA>      NA NA
2     mongagua 3531100       35 sao_paulo NA         <NA>       <NA>      NA NA
3 praia_grande 3541000       35 sao_paulo NA         <NA>       <NA>      NA NA
4       santos 3548500       35 sao_paulo NA         <NA>       <NA>      NA NA
  km causa_acidente tipo_acidente classificacao_acidente fase_dia sentido_via
1 NA           <NA>          <NA>                   <NA>     <NA>        <NA>
2 NA           <NA>          <NA>                   <NA>     <NA>        <NA>
3 NA           <NA>          <NA>                   <NA>     <NA>        <NA>
4 NA           <NA>          <NA>                   <NA>     <NA>        <NA>
  condicao_metereologica tipo_pista tracado_via uso_solo pessoas mortos
1                   <NA>       <NA>        <NA>     <NA>      NA     NA
2                   <NA>       <NA>        <NA>     <NA>      NA     NA
3                   <NA>       <NA>        <NA>     <NA>      NA     NA
4                   <NA>       <NA>        <NA>     <NA>      NA     NA
  feridos_leves feridos_graves ilesos ignorados feridos veiculos latitude
1            NA             NA     NA        NA      NA       NA       NA
2            NA             NA     NA        NA      NA       NA       NA
3            NA             NA     NA        NA      NA       NA       NA
4            NA             NA     NA        NA      NA       NA       NA
  longitude regional delegacia  uop cod_uf.y
1        NA     <NA>      <NA> <NA>       NA
2        NA     <NA>      <NA> <NA>       NA
3        NA     <NA>      <NA> <NA>       NA
4        NA     <NA>      <NA> <NA>       NA

Não tivemos valores correspondentes na tabela de acidentes, indicando que nenhum acidente nessas cidades foi registrado

Filtrando pelas cidades da Zona da Mata

cidades_zona_mata = c('juiz_de_fora',
                      'santos_dumont', 
                      'vicosa', 
                      'rio_pomba',
                      'lima_duarte')

df_mun_uf |>
  dplyr::filter(municipio %in% cidades_zona_mata & uf == 'minas_gerais' ) |>
  dplyr::inner_join(df_prf_geo, by = 'cod_mun') |>
  rmarkdown::paged_table()

Podemos calcular uma média de pessoas mortas por acidente na Região da Zona da Mata divido por cidade

df_mun_uf |>
  dplyr::filter(municipio %in% cidades_zona_mata & uf == 'minas_gerais' ) |>
  dplyr::inner_join(df_prf_geo, by = 'cod_mun') |>
  dplyr::group_by(cod_mun,
                  municipio
                  ) |>
  dplyr::summarise(media_mortos = mean(mortos)) |>
  rmarkdown::paged_table()