Definições da sessão
#-----------------------------------------------------------------------
# Pacotes.
library(jsonlite)
library(tm)
library(tidytext)
library(tidyverse)
library(DT)
library(wordcloud)
# Dicionários léxicos em PT.
library(lexiconPT)
ls("package:lexiconPT")
## [1] "get_word_sentiment" "oplexicon_v2.1" "oplexicon_v3.0"
## [4] "sentiLex_lem_PT02"
Importação do arquivo de avaliações
#-----------------------------------------------------------------------
# Importação do texto.
# Endereço de arquivo JSON com avaliação de veículos.
url <- paste0("https://github.com/leg-ufpr/hackathon/blob/master",
"/opinioes.json?raw=true")
# Importa reviews de veículos.
txt <- fromJSON(url)
str(txt)
## chr [1:5329, 1:10] "e2b9dc08" "3b9dcf63" "9f62a709" "0e6c8d29" ...
# Conteúdo está na forma de matriz.
# txt[1, ]
# Passando para tabela.
colnames(txt) <- c("id", "title", "model", "owner", "condition", "good",
"bad", "defect", "general", "ts")
tt <- as_tibble(txt)
glimpse(tt)
## Observations: 5,329
## Variables: 10
## $ id <chr> "e2b9dc08", "3b9dcf63", "9f62a709", "0e6c8d29", "3c958…
## $ title <chr> "\"MELHOR POPULAR DO MERCADO ATÉ 2012\"", "\"Ótimo car…
## $ model <chr> "Chevrolet Celta LT 1.0 2011/2012", "Chevrolet Celta L…
## $ owner <chr> "João - Brasília DF", "Hugo - São Pedro SP", "Ivan - S…
## $ condition <chr> "Dono há 6 anos - 35.200 kmCarro anterior: Fiat Uno", …
## $ good <chr> "Prós:ECONOMIA DE COMBUSTÍVEL, PEÇAS BARATAS, RESISTEN…
## $ bad <chr> "Contras:UM POUCO BAIXO.. AS VEZES QUANDO ESTÁ CARREGA…
## $ defect <chr> "Defeitos apresentados:NENHUM", "Defeitos apresentados…
## $ general <chr> "Opinião Geral:O CARRO É 10 ESTOU COM ELE A 7 ANOS E R…
## $ ts <chr> "09/03/2018 17:40:00", "02/03/2018 21:27:00", "27/02/2…
# Modelos de veículos contidos nas avaliações.
tt$product <- tt$model %>%
str_extract("^([[:alpha:]]+ +[[:alpha:]]+)") %>%
str_to_upper()
# Tipos únicos.
# tt$product %>% unique() %>% dput()
tt %>%
count(product, sort = TRUE)
## # A tibble: 8 x 2
## product n
## <chr> <int>
## 1 VOLKSWAGEN GOL 1486
## 2 FIAT PALIO 758
## 3 RENAULT SANDERO 712
## 4 VOLKSWAGEN FOX 613
## 5 FIAT UNO 591
## 6 CHEVROLET CELTA 496
## 7 HYUNDAI HB 452
## 8 CHEVROLET ONIX 221
# Aplica filtro para reter apenas um modelo de carro.
mod <- c("CHEVROLET CELTA",
"CHEVROLET ONIX",
"FIAT PALIO",
"FIAT UNO",
"HYUNDAI HB",
"RENAULT SANDERO",
"VOLKSWAGEN FOX",
"VOLKSWAGEN GOL")[4]
texto <- tt %>%
filter(str_detect(product, mod)) %>%
select(id, general)
texto
## # A tibble: 591 x 2
## id general
## <chr> <chr>
## 1 9e2ad4ae Opinião Geral:
## 2 88d69bb3 Opinião Geral:Por isso é usado por empresas, é um carro pra an…
## 3 77661a4f Opinião Geral:Considerando os pontos positivos e negativos ain…
## 4 6c29ce19 Opinião Geral:É um bom carro para o dia a dia, faz jus aos 6 m…
## 5 aa02db7a Opinião Geral:Carro guerreiro, muito bem feito em relação a me…
## 6 9e28e0e0 Opinião Geral:Não é um ótimo custo benefício como todos dizem.…
## 7 704ef231 Opinião Geral:Tenho grande apreço pelo meu carro. Não me deixa…
## 8 2a1789ae Opinião Geral:Recomendo muito carro muito bom para quem quiser…
## 9 a1512795 Opinião Geral:Comprei p/ minha esposa aprende a dirigi por ter…
## 10 fa05d377 Opinião Geral:Em geral o uno é excelente, simples, guerreiro, …
## # … with 581 more rows
Preprocessamento e tokenização
#-----------------------------------------------------------------------
# Preprocessamento do texto para análise de sentimentos.
# Faz o preproceamento padrão do texto.
texto$general <- texto$general %>%
str_replace("Opinião Geral:", "") %>% # Remove começo.
str_to_lower() %>% # Caixa baixa.
str_replace_all(" *-+ *", "") %>% # Remove hífen.
str_replace_all("[[:punct:]]", " ") %>% # Pontuação por espaço.
removeNumbers() %>% # Remove números.
trimws() # Sem espaços nas bordas.
# Stop words padrão do idioma português.
stopwords(kind = "pt")
## [1] "de" "a" "o" "que"
## [5] "e" "do" "da" "em"
## [9] "um" "para" "com" "não"
## [13] "uma" "os" "no" "se"
## [17] "na" "por" "mais" "as"
## [21] "dos" "como" "mas" "ao"
## [25] "ele" "das" "à" "seu"
## [29] "sua" "ou" "quando" "muito"
## [33] "nos" "já" "eu" "também"
## [37] "só" "pelo" "pela" "até"
## [41] "isso" "ela" "entre" "depois"
## [45] "sem" "mesmo" "aos" "seus"
## [49] "quem" "nas" "me" "esse"
## [53] "eles" "você" "essa" "num"
## [57] "nem" "suas" "meu" "às"
## [61] "minha" "numa" "pelos" "elas"
## [65] "qual" "nós" "lhe" "deles"
## [69] "essas" "esses" "pelas" "este"
## [73] "dele" "tu" "te" "vocês"
## [77] "vos" "lhes" "meus" "minhas"
## [81] "teu" "tua" "teus" "tuas"
## [85] "nosso" "nossa" "nossos" "nossas"
## [89] "dela" "delas" "esta" "estes"
## [93] "estas" "aquele" "aquela" "aqueles"
## [97] "aquelas" "isto" "aquilo" "estou"
## [101] "está" "estamos" "estão" "estive"
## [105] "esteve" "estivemos" "estiveram" "estava"
## [109] "estávamos" "estavam" "estivera" "estivéramos"
## [113] "esteja" "estejamos" "estejam" "estivesse"
## [117] "estivéssemos" "estivessem" "estiver" "estivermos"
## [121] "estiverem" "hei" "há" "havemos"
## [125] "hão" "houve" "houvemos" "houveram"
## [129] "houvera" "houvéramos" "haja" "hajamos"
## [133] "hajam" "houvesse" "houvéssemos" "houvessem"
## [137] "houver" "houvermos" "houverem" "houverei"
## [141] "houverá" "houveremos" "houverão" "houveria"
## [145] "houveríamos" "houveriam" "sou" "somos"
## [149] "são" "era" "éramos" "eram"
## [153] "fui" "foi" "fomos" "foram"
## [157] "fora" "fôramos" "seja" "sejamos"
## [161] "sejam" "fosse" "fôssemos" "fossem"
## [165] "for" "formos" "forem" "serei"
## [169] "será" "seremos" "serão" "seria"
## [173] "seríamos" "seriam" "tenho" "tem"
## [177] "temos" "tém" "tinha" "tínhamos"
## [181] "tinham" "tive" "teve" "tivemos"
## [185] "tiveram" "tivera" "tivéramos" "tenha"
## [189] "tenhamos" "tenham" "tivesse" "tivéssemos"
## [193] "tivessem" "tiver" "tivermos" "tiverem"
## [197] "terei" "terá" "teremos" "terão"
## [201] "teria" "teríamos" "teriam"
# Efeito de remover as stop words.
head(texto$general, n = 1) %>%
str_wrap(72) %>%
cat("\n")
head(texto$general, n = 1) %>%
removeWords(words = stopwords(kind = "pt")) %>%
str_wrap(72) %>%
cat("\n")
# Remoção das stop words.
texto$general <- texto$general %>%
removeWords(words = c("bom", "muito", "pouco",
stopwords(kind = "pt")))
# Faz tokenização nas palavras individuais e empilha as palavras.
texto_un <- texto %>%
unnest_tokens(output = "words", input = general)
texto_un
## # A tibble: 12,013 x 2
## id words
## <chr> <chr>
## 1 88d69bb3 é
## 2 88d69bb3 usado
## 3 88d69bb3 empresas
## 4 88d69bb3 é
## 5 88d69bb3 carro
## 6 88d69bb3 pra
## 7 88d69bb3 andar
## 8 88d69bb3 estourar
## 9 88d69bb3 trocar
## 10 88d69bb3 vale
## # … with 12,003 more rows
Calculo da polaridade
#-----------------------------------------------------------------------
# Operações para determinar a polaridade.
# Uma amostra do dicionário de termos rotulados.
sample_n(oplexicon_v3.0, size = 20) %>%
arrange(polarity)
## term type polarity polarity_revision
## 1 abusiva adj -1 M
## 2 desassossegada adj -1 A
## 3 arisco adj -1 A
## 4 traido adj -1 A
## 5 cabecudo adj -1 A
## 6 informe adj -1 A
## 7 atingido adj -1 A
## 8 apertado adj -1 M
## 9 soar vb 0 A
## 10 sacramentado adj 0 A
## 11 formosear vb 0 A
## 12 budistas adj 0 A
## 13 macios adj 0 A
## 14 meter-se vb 0 A
## 15 designar vb 0 A
## 16 abalroar vb 0 A
## 17 superprotectoras adj 0 A
## 18 chocarrear vb 1 A
## 19 luciluzir vb 1 A
## 20 descuidar vb 1 A
# Contagem por polaridade.
oplexicon_v3.0 %>%
count(polarity, sort = TRUE)
## # A tibble: 3 x 2
## polarity n
## <int> <int>
## 1 -1 14569
## 2 0 9002
## 3 1 8620
# Contagem por classe gramatical.
oplexicon_v3.0 %>%
count(type, sort = TRUE)
## # A tibble: 8 x 2
## type n
## <chr> <int>
## 1 adj 24475
## 2 vb 6889
## 3 htag 471
## 4 vb det n prp 103
## 5 vb n prp 91
## 6 vb adj 74
## 7 emot 66
## 8 vb adv 22
# Faz o a junção por interseção.
tb_sen <- inner_join(texto_un,
oplexicon_v3.0[, c("term", "polarity")],
by = c("words" = "term"))
# Agora o termos tem sua polaridade presente na tabela.
sample_n(tb_sen, size = 20)
## # A tibble: 20 x 3
## id words polarity
## <chr> <chr> <int>
## 1 0bab665b superior 1
## 2 88659e80 unos 0
## 3 67fb630e melhor 1
## 4 2aed764e dirigir 1
## 5 5f95f0cc baratas 1
## 6 62c8b6ee precisa 1
## 7 4f062789 economico 0
## 8 6bbf224a otimo 1
## 9 ed3d193a atraente 1
## 10 e38f2a11 motor 0
## 11 a5f06a26 levar -1
## 12 6395d31e ruim -1
## 13 8bc5e81d satisfeito 1
## 14 3d1bc9f4 volante 0
## 15 26d0cacc raro 1
## 16 1d5be877 mexer 1
## 17 d62c0f61 otimo 1
## 18 f7ff7a70 baixa 0
## 19 304dc9c9 lata -1
## 20 612ff683 antigo 0
# Faz a agregação da polaridade por documento.
tb <- tb_sen %>%
group_by(id) %>%
summarise(soma = sum(polarity),
n = n(),
sentiment = soma/n)
tb
## # A tibble: 529 x 4
## id soma n sentiment
## <chr> <int> <int> <dbl>
## 1 00372114 -1 4 -0.25
## 2 012daaf9 0 2 0
## 3 022fa78c -1 4 -0.25
## 4 0321d966 0 6 0
## 5 0399ddcb 2 8 0.25
## 6 04ac2945 -1 4 -0.25
## 7 04c41d38 1 4 0.25
## 8 0531ddbe 1 4 0.25
## 9 0596484b 0 4 0
## 10 05d8f532 5 9 0.556
## # … with 519 more rows
# Desidade expírica kernel do escore de sentimento.
ggplot(tb, aes(x = sentiment)) +
geom_density(fill = "orange", alpha = 0.25) +
geom_rug() +
labs(x = "Polaridade", y = "Densidade")
# Frequência relativa acumulada.
ggplot(tb, aes(x = sentiment)) +
stat_ecdf() +
geom_rug() +
labs(x = "Polaridade", y = "Frequência")
# As avaliações mais positivas.
tb %>%
top_n(sentiment, n = 10) %>%
inner_join(tt[, c("id", "general")]) %>%
select(sentiment, general)
## Joining, by = "id"
## # A tibble: 49 x 2
## sentiment general
## <dbl> <chr>
## 1 1 Opinião Geral:um carro de bom custo-benefício, mas com aparen…
## 2 1 Opinião Geral:Carro relativamente barato, excelente pra quem …
## 3 1 Opinião Geral:Bom e barato. Super acessível.
## 4 1 Opinião Geral:Ótima opção dentre os carros baratos. O resto é…
## 5 1 Opinião Geral:O custo beneficio é bom pra quem quer um carrim…
## 6 1 Opinião Geral:excelente carro pra quem num faz tanta questão …
## 7 1 Opinião Geral:ÓTIMO CARRO, SÓ ESPERAVA SER MAIS ECONÔMICO...
## 8 1 Opinião Geral:Excelente carro, não tenho do que reclamar!
## 9 1 Opinião Geral:otimo para o dia a dia
## 10 1 Opinião Geral:Excelente carro.
## # … with 39 more rows
# As avaliações mais negativas.
tb %>%
top_n(sentiment, n = -10) %>%
inner_join(tt[, c("id", "general")]) %>%
select(sentiment, general)
## Joining, by = "id"
## # A tibble: 11 x 2
## sentiment general
## <dbl> <chr>
## 1 -1 Opinião Geral:Não sei se eu dei azar com o meu, pois muitas p…
## 2 -1 Opinião Geral:ruim
## 3 -1 Opinião Geral:UM LIXO!!! O pior carro que já tive. Não recome…
## 4 -1 Opinião Geral:ACHO QUE O PIOR CARRO QUE A FIAT FEZ
## 5 -1 Opinião Geral:Recomendo, sem dúvida nenhuma, um carro para nó…
## 6 -1 Opinião Geral:Bom carro, mas com muito plástico no painel e n…
## 7 -1 Opinião Geral:Não comprem esse carro. Façam um teste drive an…
## 8 -1 Opinião Geral:um bom carro para quem pensa em custo beneficio
## 9 -1 Opinião Geral:NÃO GASTE UM CENTAVO COM ESSE CARRO, NEM SE FOR…
## 10 -1 Opinião Geral:Muito bom, já estou negociando outro, só que de…
## 11 -1 Opinião Geral:Estou decepcionado com a Fiat.
Exibição das avaliações polarizadas
#-----------------------------------------------------------------------
# Exibição dos resultados.
# Tabela com as avaliações originais sem o preprocessamento.
tb_u <- tb %>%
inner_join(tt[, c("id", "general")]) %>%
select(id, sentiment, general) %>%
mutate(general = str_replace(general, "Opinião Geral:", ""))
## Joining, by = "id"
# Valores e cores para formatação condicional das cédulas da tabela.
vals <- seq(-1, 1, by = 0.1)
cols <- colorRampPalette(
RColorBrewer::brewer.pal(n = 6, name = "Spectral"))(length(vals))
# plot(vals, col = cols, pch = 19, cex = 5)
# Define o estilo de formatação condicional.
style <- styleInterval(cuts = head(vals[-1], n = -1),
values = cols[-1])
html_table <-
datatable(tb_u,
colnames = c("Avaliação",
"Sentimento",
"Opinião Geral")) %>%
formatRound(columns = "sentiment", digits = 2) %>%
formatStyle(columns = names(tb_u),
valueColumns = "sentiment",
target = "cell",
backgroundColor = style)
html_table
Termos mais frequentes por classe polar
#-----------------------------------------------------------------------
# Para poder melhorar o dicionário.
# Determina as frequências dos termos de polaridade não nula.
tb_words <- tb_sen %>%
count(words, polarity, sort = TRUE) %>%
filter(polarity != 0)
tb_cloud <- tb_words %>%
spread(key = "polarity", value = "n", fill = 0) %>%
rename("negative" = "-1", "positive" = "1")
tb_cloud
## # A tibble: 417 x 3
## words negative positive
## <chr> <dbl> <dbl>
## 1 abastecer 0 1
## 2 abrir 1 0
## 3 acabados 1 0
## 4 acabamento 0 22
## 5 aceito 0 1
## 6 acessivel 0 1
## 7 achar 0 3
## 8 acostumar 0 1
## 9 afirmar 0 2
## 10 afundada 1 0
## # … with 407 more rows
tb <- as.data.frame(tb_cloud[, c("negative", "positive")])
rownames(tb) <- tb_cloud$words
head(tb)
## negative positive
## abastecer 0 1
## abrir 1 0
## acabados 1 0
## acabamento 0 22
## aceito 0 1
## acessivel 0 1
# Faz núvem de palavras.
comparison.cloud(tb,
colors = c("red", "blue"),
max.words = min(nrow(tb), 200))
# Gráfico de barras para as palavras de maior ocorrência.
n_words <- 20
tb_bars <- tb_words %>%
mutate(score = polarity * n) %>%
group_by(polarity) %>%
top_n(n, n = n_words) %>%
ungroup()
ggplot(data = tb_bars,
mapping = aes(x = reorder(words, score),
y = score,
fill = score)) +
geom_col(color = "black") +
scale_fill_distiller(palette = "RdBu", direction = 1) +
coord_flip() +
theme_light() +
theme(legend.position = c(0.95, 0.5),
legend.justification = c(1, 0.5)) +
labs(y = "Frequência de ocorrência",
x = "Termo",
fill = "Frequência de\nocorrência")
Localização das avaliações
#-----------------------------------------------------------------------
# Carrega dados com localização dos municípios.
est <- "https://raw.githubusercontent.com/kelvins/Municipios-Brasileiros/master/csv/estados.csv"
mun <- "https://raw.githubusercontent.com/kelvins/Municipios-Brasileiros/master/csv/municipios.csv"
latlon <- inner_join(read_csv(est),
read_csv(mun),
by = "codigo_uf")
## Parsed with column specification:
## cols(
## codigo_uf = col_double(),
## uf = col_character(),
## nome = col_character()
## )
## Parsed with column specification:
## cols(
## codigo_ibge = col_double(),
## nome = col_character(),
## latitude = col_double(),
## longitude = col_double(),
## capital = col_double(),
## codigo_uf = col_double()
## )
latlon <- latlon %>%
rename("estado" = "nome.x", "municipio" = "nome.y")
str(latlon)
## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 5570 obs. of 8 variables:
## $ codigo_uf : num 11 11 11 11 11 11 11 11 11 11 ...
## $ uf : chr "RO" "RO" "RO" "RO" ...
## $ estado : chr "Rondônia" "Rondônia" "Rondônia" "Rondônia" ...
## $ codigo_ibge: num 1100015 1100379 1100403 1100346 1100023 ...
## $ municipio : chr "Alta Floresta D'Oeste" "Alto Alegre dos Parecis" "Alto Paraíso" "Alvorada D'Oeste" ...
## $ latitude : num -11.93 -12.13 -9.71 -11.35 -9.91 ...
## $ longitude : num -62 -61.8 -63.3 -62.3 -63 ...
## $ capital : num 0 0 0 0 0 0 0 0 0 0 ...
#-----------------------------------------------------------------------
# Seleciona dados de um tipo de veículo.
tb <- tt %>%
filter(str_detect(product, mod))
tb
## # A tibble: 591 x 11
## id title model owner condition good bad defect general ts
## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 9e2a… "\"V… Fiat… Dani… Dono há … Prós… Cont… Defei… Opiniã… 01/0…
## 2 88d6… "\"C… Fiat… Will… Dono há … Prós… Cont… Defei… Opiniã… 30/0…
## 3 7766… "\"V… Fiat… Alex… Dono há … Prós… Cont… Defei… Opiniã… 06/1…
## 4 6c29… "\"B… Fiat… Feli… Dono há … Prós… Cont… Defei… Opiniã… 10/0…
## 5 aa02… "\"C… Fiat… Joaq… Dono há … Prós… Cont… Defei… Opiniã… 20/0…
## 6 9e28… "\"f… Fiat… Dieg… Dono há … Prós… Cont… Defei… Opiniã… 24/0…
## 7 704e… "\"A… Fiat… Rein… Dono há … Prós… Cont… Defei… Opiniã… 03/0…
## 8 2a17… "\"m… Fiat… Feli… Dono há … Prós… Cont… Defei… Opiniã… 01/0…
## 9 a151… "\"Ó… Fiat… Marc… Dono há … Prós… Cont… Defei… Opiniã… 14/0…
## 10 fa05… "\"I… Fiat… Rafa… Dono há … Prós… Cont… Defei… Opiniã… 05/0…
## # … with 581 more rows, and 1 more variable: product <chr>
# Extração da localização.
tb$loc <- tb$owner %>%
str_extract("[^-]*$") %>%
str_trim()
# Extração da sigla do estado.
tb$uf <- tb$loc %>%
str_extract("[[:upper:]]{2}$")
# Extração do município.
tb$mun <- tb$loc %>%
str_replace("^(.*) [[:upper:]]{2}$", "\\1")
# Fazer a junção para incluir lat&lon das cidades.
tb <- inner_join(tb,
select(latlon, municipio, uf, latitude, longitude),
by = c("mun" = "municipio", "uf" = "uf"))
# Conta o número de avaliações por cidade.
tb_locs <- tb %>%
count(uf, mun, latitude, longitude)
#-----------------------------------------------------------------------
# Gráfico interativo.
library(leaflet)
leaflet(data = tb_locs) %>%
addProviderTiles(provider = "Stamen.TonerLite") %>%
addCircleMarkers(
lng = ~longitude,
lat = ~latitude,
radius = ~3 + 1.5 * abs(n),
color = "tomato",
fillOpacity = 0.75,
label = ~sprintf("%s/%s: %d", mun, uf, n),
labelOptions = labelOptions(textsize = "15px"),
stroke = TRUE)
