Trabalho 1

Computação em Estatística 2 - 2/2022

Abstract

Manipulações de dados num banco referente a avaliações de consumidores a produtos adquiridos no site Americanas.com entre Janeiro e Maio de 2018

1) Para os 10 produtos mais comprados nesse período, retorne uma tabela contendo: nome do produto,número de compradores para cada sexo e nota média do produto por sexo.

if (!require("pacman")) install.packages("pacman")
p_load(doParallel)
threads=round(as.numeric(detectCores()*0.8))

pasta <- "dados"

if (file.exists(pasta)) {
  
  print("A pasta já existe")
  rm(pasta)
  
} else {
  
  dir.create(pasta)
  rm(pasta)
  
}

[1] "A pasta já existe"

link <- c("https://raw.githubusercontent.com/americanas-tech/b2w-reviews01/main/B2W-Reviews01.csv")
nome_destino <- c("./dados/df.csv")
download.file(link, nome_destino)

rm(link,nome_destino,pasta)

p_load(vroom)

df <- vroom("./dados/df.csv", 
               locale = locale("br", encoding = "UTF-8"),
               num_threads = threads)

p_load(tidyverse)

dados <- df %>%
  select(product_id,product_name,overall_rating,reviewer_gender) %>%
  mutate(product_id = factor(product_id)) %>%
  mutate(product_name = factor(product_name)) %>%
  mutate(reviewer_gender = factor(reviewer_gender))

filtro <- dados %>%
  count(product_id,sort=T) %>%
  head(n=10L) %>%
  select(product_id)

dados <- semi_join(dados, filtro)

tabela1 <- dados %>%
  select(product_name,overall_rating,reviewer_gender) %>%
  group_by(product_name,reviewer_gender) %>%
  summarise(nota_media = mean(overall_rating)) %>%
  drop_na(reviewer_gender)

tabela2 <- dados %>%
  select(product_name,reviewer_gender) %>%
  group_by(product_name,reviewer_gender) %>%
  count(reviewer_gender) %>%
  drop_na(reviewer_gender)

tabela_questao1 <- full_join(tabela1,tabela2)

rm(filtro,tabela1,tabela2,dados)

colnames(tabela_questao1) <- c("nome do produto","sexo do comprador","nota média do produto","número de compradores")

tabela_questao1

# A tibble: 20 × 4
# Groups:   nome do produto [10]
   `nome do produto`                                     sexo …¹ nota …² númer…³
   <fct>                                                 <fct>     <dbl>   <int>
 1 "Aspirador de Pó Philco Rapid 1000N Vermelho/Preto -… F          4.43     528
 2 "Aspirador de Pó Philco Rapid 1000N Vermelho/Preto -… M          4.28     218
 3 "Smart TV LED 32\" Samsung 32J4300 HD com Conversor … F          4.05     205
 4 "Smart TV LED 32\" Samsung 32J4300 HD com Conversor … M          3.71     282
 5 "Smartphone Moto G 5S Dual Chip Android 7.0 Tela 5.2… F          4.25     174
 6 "Smartphone Moto G 5S Dual Chip Android 7.0 Tela 5.2… M          4.18     225
 7 "Smartphone Motorola Moto G 5S Dual Chip Android 7.1… F          4.11     292
 8 "Smartphone Motorola Moto G 5S Dual Chip Android 7.1… M          4.11     248
 9 "Smartphone Motorola Moto G 5S Dual Chip Android 7.1… F          4.05     274
10 "Smartphone Motorola Moto G 5S Dual Chip Android 7.1… M          4.07     501
11 "Smartphone Samsung Galaxy J5 Prime Dual Chip Androi… F          3.85     276
12 "Smartphone Samsung Galaxy J5 Prime Dual Chip Androi… M          3.92     223
13 "Smartphone Samsung Galaxy J5 Pro Dual Chip Android … F          4.15     219
14 "Smartphone Samsung Galaxy J5 Pro Dual Chip Android … M          4.08     207
15 "Smartphone Samsung Galaxy J7 Metal Dual Chip Androi… F          4.24     343
16 "Smartphone Samsung Galaxy J7 Metal Dual Chip Androi… M          4.04     319
17 "Smartphone Samsung Galaxy J7 Metal Dual Chip Androi… F          4.19     142
18 "Smartphone Samsung Galaxy J7 Metal Dual Chip Androi… M          4.11     250
19 "Smartphone Samsung Galaxy J7 Prime Dual Chip Androi… F          4.02     280
20 "Smartphone Samsung Galaxy J7 Prime Dual Chip Androi… M          3.96     230
# … with abbreviated variable names ¹​`sexo do comprador`,
#   ²​`nota média do produto`, ³​`número de compradores`

2) Escreva uma função para fazer uma limpeza no texto de 1 review: transformação do texto em minúsculae retirada de todos os sinais de pontuação, caracteres especiais e acentos. Teste para vários reviews ofuncionamento da função criada.

p_load(stringi)

emburrecer <- function(x=1){
df %>%
  select(review_text) %>%
  sample_n(size=x) %>%
  str_to_lower() %>%
  stri_trans_general("Latin-ASCII") %>%
  str_replace_all(pattern="[ç]", replacement="c") %>%
  str_replace_all(pattern="[!@#$%¨&*()?;:.\'\",\\|\\-/]", replacement=" ")
}

emburrecer()

[1] "muito bom super recomendo otimo meu filho ta adorando"

emburrecer()

[1] "no primeiro uso  soltou duas vezes do engate rapido e na terceira estourou a mangueira com a pressao da agua  e tomei banho todas as vezes ate desligar e molhou toda minha lavanderia "

emburrecer()

[1] "tamanho ruim e muito vulneravel  achei que tivesse pelo menos a mesma qualidade de um  perfex  "

emburrecer()

[1] "produto excelente  preco justo e produto funcional  relogio sem frescuras e extremamente duravel "

emburrecer()

[1] "excelente produto  leve compacto recomendo o produto sim"

3) Utilizando apenas a informação contida na variávelproduct_name, retorne uma tabela com todas astelevisões compradas no período (1 compra por linha) e o número de polegadas correspondente da TV. Emseguida, retorne outra tabela contendo o total de TVs compradas de cada polegada.

dados <- as_tibble(str_subset(df$product_name,pattern="Smart TV",negate=F))
dados <- as_tibble(str_subset(dados$value,pattern="Acessório",negate=T))
dados <- as_tibble(str_subset(dados$value,pattern="Suporte",negate=T))

dados$polegadas <- as_tibble(str_extract(dados$value, "[0-9]+"))

colnames(dados) <- c("Televisão","Polegadas")
tabela1_questao3 <- dados
rm(dados)

tabela1_questao3$Polegadas <- as.numeric(unlist(tabela1_questao3$Polegadas))

tabela2_questao3 <- tabela1_questao3 %>%
  select(Polegadas) %>%
  group_by(Polegadas) %>%
  drop_na() %>%
  filter(Polegadas > 5) %>%
  tally()

colnames(tabela2_questao3) <- c("Polegadas","Quantidade vendida")

tabela1_questao3

# A tibble: 5,469 × 2
   Televisão                                                             Poleg…¹
   <chr>                                                                   <dbl>
 1 "Smart TV LED 43\" LG 43UJ6525 Ultra HD 4K com Conversor Digital 4 H…      43
 2 "Smart TV LED 65\" Samsung 65MU6100 UHD 4K HDR Premium com Conversor…      65
 3 "Smart TV Android LED 49\" TCL C2 49C2US Ultra HD 4K com Conversor D…      49
 4 "Smart TV LED Philips 43\" 43pfg5102/78 com Conversor Digital Wi-Fi …      43
 5 "Smart TV LED 43\" Philips 43PUG6102/78 Ultra HD 4k com Conversor Di…      43
 6 "Smart TV LED 43\" AOC LE43U7970 Ultra HD 4k com Conversor Digital 3…      43
 7 "Smart TV LED 39\" Philco PH39N86DSGW HD com Conversor Digital 3 HDM…      39
 8 "Smart TV LED  32\" LG 32LJ600B  HD  com Conversor Digital Wi-Fi int…      32
 9 "Smart TV LED LG 55\" SUPER ULTRA HD 55SJ8000 Conversor Digital Wi-F…      55
10 "Smart TV LED 43\" LG 43lj5500 Full HD com Conversor Digital Wi-Fi i…      43
# … with 5,459 more rows, and abbreviated variable name ¹​Polegadas

tabela2_questao3

# A tibble: 18 × 2
   Polegadas `Quantidade vendida`
       <dbl>                <int>
 1        24                   57
 2        28                   78
 3        32                 1265
 4        39                  348
 5        40                  416
 6        42                  119
 7        43                 1092
 8        48                   15
 9        49                 1127
10        50                  136
11        55                  455
12        58                  297
13        60                    2
14        65                   24
15        75                    6
16        78                    1
17        82                    1
18        85                    6

4) Transforme a variável reviewer_state em categórica e faça um gráfico do número de compras por Estado da Federação. Em seguida, faça um gráfico do número de compras por Regiões do Brasil (Norte, Sul, Nordeste,Centro-Oeste e Sudeste).

dados <- df %>%
  select(reviewer_state) %>%
  drop_na()

dados$reviewer_state <- factor(dados$reviewer_state)  

comprasregiao <- dados
rm(dados)

ggplot(comprasregiao) +
  aes(x=reviewer_state) +
  geom_bar(colour="#A11D21",fill="#A11D21") +
  labs(x="Unidade Federativa", y="Quantidade de compras")

comprasregiao <- comprasregiao %>%
  mutate(regiao = case_when(
    
    reviewer_state == "AC" | reviewer_state == "AM" | reviewer_state == "AP" |
    reviewer_state == "PA" | reviewer_state == "RO" | reviewer_state == "RR" |
    reviewer_state == "TO" ~ "Norte",
    
    reviewer_state == "AL" | reviewer_state == "BA" | reviewer_state == "CE" |
    reviewer_state == "MA" | reviewer_state == "PI" | reviewer_state == "PE" |
    reviewer_state == "PB" | reviewer_state == "RN" | 
    reviewer_state == "SE" ~ "Nordeste",
    
    reviewer_state == "GO" | reviewer_state == "MT" | reviewer_state == "MS" | 
    reviewer_state == "DF" ~ "Centro-Oeste",
    
    reviewer_state == "ES" | reviewer_state == "MG" | reviewer_state == "RJ" |
    reviewer_state == "SP" ~ "Sudeste",
    
    reviewer_state == "PR" | reviewer_state == "RS" | 
    reviewer_state == "SC" ~ "Sul"
    
    ))

ggplot(comprasregiao) +
  aes(x=regiao) +
  geom_bar(colour="#A11D21",fill="#A11D21") +
  labs(x="Região", y="Quantidade de compras")

5) Considere apenas a informação da hora do dia em que a compra foi realizada. Faça um gráfico do número de compras em cada hora.

p_load(hms)

dados <- df %>%
  select(submission_date) %>%
  mutate(hora = as_hms(submission_date))

comprahora <- dados %>%
  select(hora)
rm(dados)  

comprahora$hora <- substr(comprahora$hora, start = 1, stop = 2)
comprahora$hora <- factor(comprahora$hora)

ggplot(comprahora) +
  aes(x=hora) +
  geom_bar(colour="#A11D21",fill="#A11D21") +
  labs(x="Hora do dia", y="Quantidade de compras")

6) Acrescente 1 coluna no banco de dados com a informação da data da compra no seguinte formato, exemplo:11 de Janeiro, 2018.

p_load(lubridate)

dados <- df %>%
  select(submission_date)

dados$submission_date[1] # 10 primeiros caracteres

[1] "2018-01-01 00:11:28 UTC"

dados$submission_date <- substr(dados$submission_date, start = 1, stop = 10)
dados$submission_date <- ymd(dados$submission_date)

data <- dados %>%
  mutate(mes = format(submission_date, "%B")) %>%
  mutate(dia = day(submission_date)) %>%
  mutate(ano = year(submission_date))

rm(dados)

data <- data %>%
  mutate(data = str_glue('{dia} de {mes},{ano}')) %>%
  select(data)

df <- cbind(df,data)

as_tibble(df)

# A tibble: 132,373 × 15
   submission_date     reviewe…¹ produ…² produ…³ produ…⁴ site_…⁵ site_…⁶ revie…⁷
   <dttm>              <chr>       <dbl> <chr>   <chr>   <chr>   <chr>   <chr>  
 1 2018-01-01 00:11:28 d0fb1ca6…  1.33e8 "Noteb… <NA>    Inform… Notebo… Bom    
 2 2018-01-01 00:13:48 014d6dc5…  2.26e7 "Copo … <NA>    Utilid… Copos,… Preço …
 3 2018-01-01 00:26:02 44f2c8ed…  1.13e8 "Panel… philip… Eletro… Panela… ATENDE…
 4 2018-01-01 00:35:54 ce741665…  1.14e8 "Beton… roma j… Brinqu… Veícul… presen…
 5 2018-01-01 01:00:28 7d7b6b18…  1.32e8 "Smart… lg      TV e H… TV      Sem du…
 6 2018-01-01 01:27:23 28b1844e…  2.26e7 "Copo … <NA>    Utilid… Copos,… Produt…
 7 2018-01-01 01:54:38 48907a04…  2.26e7 "Copo … <NA>    Utilid… Copos,… ótimo  
 8 2018-01-01 01:58:17 e039cbff…  1.32e8 "Smart… <NA>    Celula… Smartp… Gostei…
 9 2018-01-01 02:02:13 a0fd1ad3…  1.23e8 "Venti… ventis… Casa e… Climat… Gostei…
10 2018-01-01 02:16:06 eb1cceab…  2.35e7 "Kit 1… <NA>    Casa e… Ilumin… NÃO RE…
# … with 132,363 more rows, 7 more variables: overall_rating <dbl>,
#   recommend_to_a_friend <chr>, review_text <chr>, reviewer_birth_year <dbl>,
#   reviewer_gender <chr>, reviewer_state <chr>, data <glue>, and abbreviated
#   variable names ¹​reviewer_id, ²​product_id, ³​product_name, ⁴​product_brand,
#   ⁵​site_category_lv1, ⁶​site_category_lv2, ⁷​review_title

7) Crie uma função para reordenar as linhas de um dataframe de modo que as linhas que contenham observações indisponíveis (NAs) sejam colocadas no final. Dê ao usuário a opção de eliminar as linhas com observações faltantes. Use a função para retornar uma lista com o dataframe reordenado (ou reduzido) e os índices das linhas com NAs. Por fim, teste sua função com alguns exemplos interessantes.

ordenar <- function(df, rna = F) {
  df$soma <- rowSums(is.na(df))
  
  df <- df %>%
    arrange(soma)
  df$soma <- NULL
  
  if (rna) {
    df <- df %>%
      filter(rowSums(is.na(df)) == 0)
  }
  
  return(list(df = df, linhas_na = which(rowSums(is.na(df)) > 0)))
  
}

# Aqui no HTML vou colocar apenas esse exemplo pequeno, para não poluir demais. Os outros testes se encontram no arquivo .R

df2 <- data.frame(x = c(1:5,NA,7:9,NA,11:15), y = c("ae", NA, "gi", NA, "k"))
ordenar(df2)

$df
    x    y
1   1   ae
2   3   gi
3   5    k
4   8   gi
5  11   ae
6  13   gi
7  15    k
8   2 <NA>
9   4 <NA>
10 NA   ae
11  7 <NA>
12  9 <NA>
13 NA    k
14 12 <NA>
15 14 <NA>

$linhas_na
[1]  8  9 10 11 12 13 14 15

ordenar(df2, rna=T)

$df
   x  y
1  1 ae
2  3 gi
3  5  k
4  8 gi
5 11 ae
6 13 gi
7 15  k

$linhas_na
integer(0)