Paixão por Dados

Topic Modeling: Um algoritmo consegue entender sobre o que fala a youtuber Nathalia Arcuri?

Sat, 14 Apr 2018 00:00:00 +0000

No meu último post sobre Mineração de Texto, usei algumas ferramentas do R para analisar textos clássicos da literatura brasileira. Desta vez, o foco da análise será algo mais contemporâneo: uma youtuber. Mais precisamente, a Nathalia Arcuri, responsável por um dos principais canais de educação financeira, o Me Poupe.

Além do objeto da análise, a abordagem aqui também é diferente: vou mostrar como Topic Modeling pode ser usado para descobrir temas gerais em um conjunto de dados textuais.

Assim, este post se dedica ao seguinte problema de pesquisa: é possível identificar, por meio de um algoritmo de inteligência artificial, temas gerais que uma youtuber com mais de 300 vídeos publicados fala sobre?

library(reticulate)
reticulate::use_python("/home/sillas/anaconda3/bin/python", required = TRUE)
library(lexiconPT)
library(tidytext)
library(tidyverse)
library(magrittr)
library(stm)
library(tm)
library(ggridges)
library(formattable)
options(scipen = 999)

Coleta dos dados

Para analisar o conteúdo de vídeos de youtube, precisamos das legendas dos vídeos. Alguns (bem poucos) canais produzem suas próprias legendas manualmente, mas a grande maioria, como o Me Poupe, o canal da Nathalia Arcuri, não o faz. Sendo assim, precisamos nós mesmo produzir essas legendas.

Isso seria uma tarefa muito árdua, mas felizmente o próprio Youtube tem seu próprio serviço de inteligência artifical de reconhecimento de fala, que cria automaticamente legendas para um vídeo. Apesar de algumas vezes as legendas produzidas pelo algoritmo do Youtube não serem muito fiéis, elas serão usadas como dados brutos para a modelagem por tópicos. Os resultados apresentados no post mostram que essas legendas automáticas podem sim serem usadas para fins de estudo.

Para coletar as legendas dos vídeo, eu uso um utilitário de linha de comando chamado youtube-dl, que é bem simples de usar. No código abaixo, que mistura R com shell script, eu mostro como montar uma query para baixar as legendas do vídeo em arquivos de texto cujos nomes contem alguns metadados do vídeo, descritos na variável fields_raw. Caso você deseje realizar este mesmo estudo com outro youtuber, basta atribuir a url do canal na variável channel_url.

fields_raw <- c("id", "title", "alt_title", "creator", "release_date",
                "timestamp", "upload_date", "duration", "view_count",
                "like_count", "dislike_count", "comment_count")

fields <- fields_raw %>% 
  map_chr(~paste0("%(", ., ")s")) %>% 
  # usar &&& como separador de fields
  paste0(collapse = "&&&") %>% 
  # acrescentar aspas no inicio e no final do string
  paste0('"', ., '"')

# canal do me poupe
channel_url <- "https://www.youtube.com/channel/UC8mDF5mWNGE-Kpfcvnn0bUg"

# montar query (comando) do youtube-dl
cmd_ytdl <- str_glue("youtube-dl -o {fields} -i -v -w --skip-download --write-auto-sub --sub-lang pt {channel_url}")

# acrescentar diretorio
pasta_captions <- "/home/sillas/R/Projetos/paixaopordados-blogdown/data/mepoupe"
fs::dir_create(pasta_captions)
cmd <- str_glue("cd {pasta_captions} && {cmd_ytdl}")

# imprimir comando para ver como ficou
cat(cmd)

## cd /home/sillas/R/Projetos/paixaopordados-blogdown/data/mepoupe && youtube-dl -o "%(id)s&&&%(title)s&&&%(alt_title)s&&&%(creator)s&&&%(release_date)s&&&%(timestamp)s&&&%(upload_date)s&&&%(duration)s&&&%(view_count)s&&&%(like_count)s&&&%(dislike_count)s&&&%(comment_count)s" -i -v -w --skip-download --write-auto-sub --sub-lang pt https://www.youtube.com/channel/UC8mDF5mWNGE-Kpfcvnn0bUg

Portanto, temos o comando para baixar as legendas dos vídeos na pasta indicada. Para rodar o comando, basta a variável cmd como argumento da função system() ou o copiar e colar no terminal.

Uma amostra dos arquivos baixados:

dir(pasta_captions)[1:3]

## [1] "039orzgCUt0&&&10 DILEMAS MAIS FREQUENTES SOBRE TESOURO DIRETO! Tire as dúvidas e invista!&&&NA&&&NA&&&NA&&&NA&&&20170424&&&642&&&272848&&&33970&&&137&&&NA.pt.vtt"                 
## [2] "0bqZrSaitDo&&&PLANILHA DE INDEPENDÊNCIA FINANCEIRA! Aprenda a usar! Série especial_ Office 365 #AjudaaNath&&&NA&&&NA&&&NA&&&NA&&&20170328&&&988&&&260474&&&18439&&&206&&&NA.pt.vtt"
## [3] "0eSSqsHSr2A&&&Série empreendedorismo na veia Ep 3_ EXPERIENTES TAMBÉM FALHAM!&&&NA&&&NA&&&NA&&&NA&&&20161225&&&282&&&32361&&&2307&&&21&&&NA.pt.vtt"

Limpeza dos dados

O Youtube tem um formato próprio de arquivos para legendas chamado vtt. Veja como são os arquivos de texto baixados na etapa anterior:

arquivos_captions <- dir(pasta_captions, pattern = '*.vtt', full.names = TRUE)
amostra <- arquivos_captions[1]

read_lines(amostra)[1:30]

##  [1] "WEBVTT"                                                                                                                                                                                                    
##  [2] "Kind: captions"                                                                                                                                                                                            
##  [3] "Language: pt"                                                                                                                                                                                              
##  [4] "Style:"                                                                                                                                                                                                    
##  [5] "::cue(c.colorCCCCCC) { color: rgb(204,204,204);"                                                                                                                                                           
##  [6] " }"                                                                                                                                                                                                        
##  [7] "::cue(c.colorE5E5E5) { color: rgb(229,229,229);"                                                                                                                                                           
##  [8] " }"                                                                                                                                                                                                        
##  [9] "##"                                                                                                                                                                                                        
## [10] ""                                                                                                                                                                                                          
## [11] "00:00:00.000 --> 00:00:02.419 align:start position:0%"                                                                                                                                                     
## [12] " "                                                                                                                                                                                                         
## [13] "olha<00:00:00.329><c> o</c><00:00:00.420><c> data</c><c.colorE5E5E5><00:00:00.840><c> mtow</c><00:00:01.260><c> que</c><00:00:01.350><c> apurou</c><00:00:01.709><c> que</c><00:00:01.979><c> esta</c></c>"
## [14] ""                                                                                                                                                                                                          
## [15] "00:00:02.419 --> 00:00:02.429 align:start position:0%"                                                                                                                                                     
## [16] "olha o data<c.colorE5E5E5> mtow que apurou que esta"                                                                                                                                                       
## [17] " </c>"                                                                                                                                                                                                     
## [18] ""                                                                                                                                                                                                          
## [19] "00:00:02.429 --> 00:00:04.640 align:start position:0%"                                                                                                                                                     
## [20] "olha o data<c.colorE5E5E5> mtow que apurou que esta</c>"                                                                                                                                                   
## [21] "<c.colorCCCCCC>pergunta</c><c.colorE5E5E5><00:00:03.210><c> este</c><00:00:03.389><c> dilema</c><00:00:03.780><c> é</c><00:00:04.170><c> o</c><00:00:04.259><c> mais</c></c>"                              
## [22] ""                                                                                                                                                                                                          
## [23] "00:00:04.640 --> 00:00:04.650 align:start position:0%"                                                                                                                                                     
## [24] "<c.colorCCCCCC>pergunta</c><c.colorE5E5E5> este dilema é o mais"                                                                                                                                           
## [25] " </c>"                                                                                                                                                                                                     
## [26] ""                                                                                                                                                                                                          
## [27] "00:00:04.650 --> 00:00:06.650 align:start position:0%"                                                                                                                                                     
## [28] "<c.colorCCCCCC>pergunta</c><c.colorE5E5E5> este dilema é o mais</c>"                                                                                                                                       
## [29] "<c.colorE5E5E5>freqüente<00:00:05.190><c> de</c><00:00:05.310><c> tudo</c><00:00:05.700><c> o</c><00:00:05.790><c> que</c></c><c.colorCCCCCC><00:00:05.970><c> investiu</c><00:00:06.509><c> uma</c></c>"  
## [30] ""

Temos vários problemas de dados não estruturados aí, como timestamps, formatação de estilo como cor e alinhamento e repetição de frases em diferentes linhas (note como as frases nas linhas 24 e 28 são as mesmas). Entretanto, limpar esses dados é mais simples que se imagina. Segue o passo-a-passo:

Começando pelo mais crítico, vamos remover toda a formatação de legendas do texto, deixando apenas as frases. Para isso, uso um módulo Python (sim, eu me rendi, esta é a primeira vez que uso Python no blog) chamado webvtt:

from webvtt import WebVTT
def caption_to_vector(file):
  x = WebVTT().read(file)
  txt = [caption.text for caption in x]
  return(txt)

Vejam com essa função faz todo o trabalho bruto de limpar os metadados da legenda:

x <- amostra %>% caption_to_vector()
x[1:20]

##  [1] " \nolha o data mtow que apurou que esta"                                      
##  [2] "olha o data mtow que apurou que esta\n "                                      
##  [3] "olha o data mtow que apurou que esta\npergunta este dilema é o mais"          
##  [4] "pergunta este dilema é o mais\n "                                             
##  [5] "pergunta este dilema é o mais\nfreqüente de tudo o que investiu uma"          
##  [6] "freqüente de tudo o que investiu uma\n "                                      
##  [7] "freqüente de tudo o que investiu uma\nvez só ou possa investir todo mês"      
##  [8] "vez só ou possa investir todo mês\n "                                         
##  [9] "vez só ou possa investir todo mês\nfilho olha esse aqui se não ficar nos"     
## [10] "filho olha esse aqui se não ficar nos\n "                                     
## [11] "filho olha esse aqui se não ficar nos\nvídeos em alta do yuan subir é"        
## [12] "vídeos em alta do yuan subir é\n "                                            
## [13] "vídeos em alta do yuan subir é\nmarmelada hoje vou falar para você"           
## [14] "marmelada hoje vou falar para você\n "                                        
## [15] "marmelada hoje vou falar para você\nquais são os dez maiores dilemas de"      
## [16] "quais são os dez maiores dilemas de\n "                                       
## [17] "quais são os dez maiores dilemas de\nquem quer investir no tesouro direto mas"
## [18] "quem quer investir no tesouro direto mas\n "                                  
## [19] "quem quer investir no tesouro direto mas\nainda não sabe muito bem como fazer"
## [20] "ainda não sabe muito bem como fazer\n "

Ainda temos alguns problemas, como as linhas repetidas, mas isso é o de menos. Resolvemos todos os problemas de limpeza de dados com a função abaixo:

limpar_caption <- function(arquivo){
  caption_raw <- caption_to_vector(arquivo)
  n <- length(caption_raw)
  # remover \n das linhas com exceção da ultima
  caption <- c(stringr::str_remove_all(caption_raw[-n], "[\n].*"),
               caption_raw[n])
  # remover duplicatas
  caption <- unique(caption)
  # remover acentos
  caption <- iconv(caption, from = "UTF-8", to = "ASCII//TRANSLIT")
  # juntar todo o vector em um so
  caption <- paste0(caption, collapse = "\n")
  caption
}

# exemplo
# amostra %>% limpar_caption()

Além disso, precisamos também extrair os metadados dos vídeos salvos nos nomes dos arquivos:

# funcao para extrair metadados do video baseado no titulo
extrair_metadados <- function(arquivo, pasta = pasta_captions,
                              fields = fields_raw){
  mat <- str_split(arquivo, "&{3}", simplify = TRUE)
  # substituir elemento da primeira coluna por id (remover pasta do nome)
  mat[1,1] <- mat[1,1] %>% str_remove_all(pasta) %>% str_remove_all("/")
  
  # renomear colunas
  cols <- fields[1:ncol(mat)]
  colnames(mat) <- cols
  as.tibble(mat)
}

Finalmente, a função abaixo cria um dataframe com as colunas de metadados e de legenda, que chamo de caption:

# funcao para juntar tudo num dataframe so
caption_to_df <- function(arquivo, ...){
  
  caption <- limpar_caption(arquivo)
  meta <- extrair_metadados(arquivo, ...)
  meta <- meta %>% mutate(caption = caption)
  
  meta
}

### gerar dataframe para todos os videos
df <- arquivos_captions %>% 
  map_df(caption_to_df) %>% 
  # remover coluna que nao uso
  select(-comment_count) %>% 
  # converter a classe de algumas colunas
  mutate(upload_date = lubridate::ymd(upload_date)) %>% 
  mutate_at(vars(duration:dislike_count), as.numeric)

# vendo como ficou
glimpse(df)

## Observations: 319
## Variables: 12
## $ id            <chr> "039orzgCUt0", "0bqZrSaitDo", "0eSSqsHSr2A", "0G...
## $ title         <chr> "10 DILEMAS MAIS FREQUENTES SOBRE TESOURO DIRETO...
## $ alt_title     <chr> "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", ...
## $ creator       <chr> "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", ...
## $ release_date  <chr> "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", ...
## $ timestamp     <chr> "NA", "NA", "NA", "NA", "NA", "NA", "NA", "NA", ...
## $ upload_date   <date> 2017-04-24, 2017-03-28, 2016-12-25, 2016-02-15,...
## $ duration      <dbl> 642, 988, 282, 440, 670, 647, 574, 396, 615, 614...
## $ view_count    <dbl> 272848, 260474, 32361, 242366, 262462, 53146, 11...
## $ like_count    <dbl> 33970, 18439, 2307, 13163, 14439, 3868, 9369, 17...
## $ dislike_count <dbl> 137, 206, 21, 371, 453, 89, 110, 176, 87, 149, 1...
## $ caption       <chr> " \nolha o data mtow que apurou que esta\npergun...

Topic Modeling

Antes de partir para o código aplicado a Topic Modeling, uma brevíssima introdução teórica.

No contexto de Text Mining, um tópico $T$ é definido como um conjunto de palavras ou tokens ($w_1, w_2, ... w_n$) onde cada palavra possui uma probabilidade de pertencer a um tópico, e um documento é definido como um conjunto de tópicos, onde cada um possui uma proporção de presença dentro do documento. A soma da proporção de cada tópico dentro de um documento é igual a 1, assim como a soma das probabilidades de cada palavra para um dado tópico, que também é igual a 1. Nesta análise, um documento corresponde a cada vídeo lançado no canal Me Poupe.

Topic Modeling, portanto, é definido como uma ténica não-supervisionada de Machine Learning que busca que identica clusteres ou grupos de palavras que ocorrem juntas, descobrindo assim tópicos abstratos que ocorrem em um conjunto de documentos. O objetivo é descobrir subestruturas semânticas dentro de um conjunto de textos.

Existem alguns algoritmos de Topic Modeling, muitos deles presentes no pacote topicmodels. Apenas devido a preferência pessoal, vou usar neste post o algoritmo Structural Topic Models (STM), presente no pacote stm.

A qualidade de um tópico encontrado por um algoritmo pode ser medida por algumas métricas, como exclusividade e coerência semântica, cuja ideia é que, em um modelo de tópicos que é semanticamente coerente, as palavras que são mais prováveis de pertencer a um tópico devem ocorrer dentro de um mesmo documento. A formulação matemática dessas métricas é razoavelmente mais complicadas que essas explicações. Caso você deseja conhecer essas métricas com mais detalhes, confira as referências no final do post.

Pré-processamento

Mesmo após o processo de limpeza, é necessário realizar alguns pré-processamentos antes de aplicar o algoritmo de Topic Modeling.

Um dos procedimentos necessários é a remoção de stopwords, que são palavras que ocorrem tão frequentemente que não acrescentam nenhum valor semântico a um texto, como “e”, “vai”, “lá”, etc. O pacote tm fornece uma lista de stopwords em vários idiomas, incluindo Português.

O código abaixo retorna as palavras mais faladas nos vídeos do Me Poupe, após a remoção de stopwords:

# stopwords da lingua portuguesa sem acento
sw_pt_tm <- tm::stopwords("pt") %>% iconv(from = "UTF-8", to = "ASCII//TRANSLIT")

# criar dataframe com uma linha por palavra
df_palavra <- df %>% 
  unnest_tokens(palavra, caption) %>% 
  # filtrar fora stopword
  filter(!palavra %in% sw_pt_tm)

df_palavra %>% 
  count(palavra) %>% 
  arrange(desc(n)) %>% 
  head(20) %>% 
  formattable()

palavra	n
vai	5467
gente	3297
porque	3077
aqui	3047
pra	3001
dinheiro	2731
fazer	2373
entao	2256
pode	2119
la	2097
ter	1645
ai	1614
agora	1520
ser	1516
pessoas	1354
canal	1334
vou	1334
hoje	1319
video	1267
tudo	1243

Como muitas dessas palavras não possuem um grande valor semântico para a separação de tópicos, podemos as acrescentar à lista de stopwords.

minhas_sw <- c("vai", "porque", "vou", "ai", "pra", "entao")
sw_pt <- c(minhas_sw, sw_pt_tm)

Partimos então para o processamento de textos com as funções do pacote stm.

proc <- stm::textProcessor(df$caption, metadata = df, language = "portuguese",
                           customstopwords = sw_pt)

## Building corpus... 
## Converting to Lower Case... 
## Removing punctuation... 
## Removing stopwords... 
## Remove Custom Stopwords...
## Removing numbers... 
## Stemming... 
## Creating Output...

out <- stm::prepDocuments(proc$documents, proc$vocab, proc$meta,
                          lower.thresh = 10)

## Removing 14665 of 16857 terms (33357 of 129408 tokens) due to frequency 
## Your corpus now has 319 documents, 2192 terms and 96051 tokens.

Criação do modelo de tópicos e interpretação dos resultados

A quantidade de tópicos $K$ que desejamos extrair dos textos é, na verdade, escolhida pelo ser humano. Não há uma regra precisa que defina o número ótimo de clusteres. No entanto, é possível usar a função stm::searchK para rodar o STM para diferentes valores do parâmetro K para encontrar o valor que otimiza a exclusividade e a coerência semântica do modelo.

storage <- stm::searchK(out$documents, out$vocab, K = c(3:15),
                          data = out$meta)

Após uma inspeção manual, decidi usar $K = 10$ para encontrar 10 tópicos sobre os quais a Nathalia Arcuri mais fala.

fit <- stm(
  documents = out$documents, vocab = out$vocab, data = out$meta,  K = 10,
  max.em.its = 75, init.type = "Spectral", verbose = FALSE
  )

Após a construção do modelo, a melhor forma de visualizar os resultados é por meio de um gráfico:

plot(fit, "summary")

Ou mesmo por texto:

stm::labelTopics(fit)

## Topic 1 Top Words:
##       Highest Prob: gent, aqui, coisa, fazer, pode, assim, casa 
##       FREX: roupa, cabelo, peca, barato, economizar, comer, loja 
##       Lift: energia, cor, tratamento, sapato, ovo, armario, compro 
##       Score: energia, tratamento, ovo, cabelo, pared, loja, dica 
## Topic 2 Top Words:
##       Highest Prob: gent, aqui, pessoa, pergunta, agora, vamo, fazer 
##       FREX: milhao, hashtag, galera, pergunta, poup, job, inscrito 
##       Lift: bilhao, premio, jornalista, seguidor, contrata, hashtag, orgulho 
##       Score: bilhao, live, job, milhao, premio, hashtag, conteudo 
## Topic 3 Top Words:
##       Highest Prob: dinheiro, reai, ano, aqui, fazer, video, mil 
##       FREX: meta, planilha, tarefa, viver, aposentadoria, reai, poupar 
##       Lift: vitoria, offic, aposentar, caderno, planilha, metodo, produtividad 
##       Score: vitoria, caderno, meta, offic, planilha, joaquina, metodo 
## Topic 4 Top Words:
##       Highest Prob: dinheiro, coisa, mulher, vida, pessoa, pode, ser 
##       FREX: mulher, mae, present, crianca, casamento, maravilha, pai 
##       Lift: gostam, casamento, adulto, maravilha, honesto, casar, present 
##       Score: gostam, casamento, natal, present, maravilha, adulto, objetivo 
## Topic 5 Top Words:
##       Highest Prob: gent, cidad, aqui, rio, janeiro, fazer, candidato 
##       FREX: cidad, candidato, prefeitura, janeiro, rio, prefeito, municipio 
##       Lift: arrecadou, evasiva, habitacao, municipio, prefeitura, promovida, tocar 
##       Score: municipio, tocar, candidato, prefeitura, habitacao, corrupcao, prefeito 
## Topic 6 Top Words:
##       Highest Prob: tesouro, dinheiro, taxa, fundo, direto, aqui, investimento 
##       FREX: tesouro, selic, fundo, direto, taxa, titulo, corretora 
##       Lift: digit, garantidor, imobiliario, ipc, ipc-, cdi, tesouro 
##       Score: digit, tesouro, selic, imobiliario, corretora, taxa, rentabilidad 
## Topic 7 Top Words:
##       Highest Prob: empresa, pessoa, aqui, pode, fazer, dinheiro, valor 
##       FREX: aco, aplicativo, empresa, aluguel, mercado, bolsa, acao 
##       Lift: placa, aco, lucro, bolo, alugar, documento, moeda 
##       Score: placa, aco, investidor, alugar, bolo, empresa, lucro 
## Topic 8 Top Words:
##       Highest Prob: ponto, cartao, gent, credito, aqui, pode, fazer 
##       FREX: multiplus, ponto, acumular, multiplo, cartao, black, site 
##       Lift: milha, anuidad, multiplus, multiplo, passagen, acumular, acumula 
##       Score: multiplus, anuidad, multiplo, ponto, black, acumular, cartao 
## Topic 9 Top Words:
##       Highest Prob: divida, dinheiro, pagar, carro, credito, cartao, pode 
##       FREX: divida, carro, parcela, pagar, juro, credito, ajuda 
##       Lift: chequ, financiado, quitar, devendo, divida, parcelar, parcela 
##       Score: chequ, divida, credito, cartao, financiamento, parcela, consorcio 
## Topic 10 Top Words:
##       Highest Prob: pessoa, gent, fazer, ser, aqui, dinheiro, ter 
##       FREX: ingl, empreendedor, curso, faculdad, sucesso, segredo, negocio 
##       Lift: encontrei, mestr, ingl, atividad, consequencia, tecnico, milionaria 
##       Score: encontrei, live, faculdad, empreendedor, conteudo, ingl, chefe

Na tabela acima, existe para cada tópico uma lista de palavras-chave, de acordo com uma métrica de associação. As métricas mais interessantes a serem olhadas são Highest prob, que é basicamente uma contagem de cada palavra no tópico, e FREX, que é combina frequência e exclusividade para identificar palavras que mais representam o tópico.

Assim, a interpretação dos tópicos pode ser feita desta maneira:

Tópico 1: Dicas de economia doméstica, como que para reduzir despesas em casa;
Tópico 2: Genérico;
Tópico 3: Planejamento Financeiro, com temas como planilhas e aposentadoria;
Tópico 4: Vídeos focados para mulheres ou famílias;
Tópico 5: Política;
Tópico 6: Renda Fixa (este ficou bem claro);
Tópico 7: Dificil saber. Talvez renda variável;
Tópico 8: Cartão de cŕedito e temas afins, como programas de milhas;
Tópico 9: Dívidas e despesas;
Tópico 10: Empreendedorimo.

É possível representar visualmente a diferença entre um par de tópicos, como o 6 e o 9:

plot(fit, "perspective", topics = c(9, 6))

Percebe-se que as palavras “dívida” e “tesouro” separam bem esses dois tópicos.

Atribuição de tópicos a vídeos

Um dos possíveis produtos da análise de Topic Modeling é atribuir a cada documento (ou vídeo) um tópico, de acordo com a proporção de cada tópico nele.

O objeto fit possui internamente um elemento que é uma matriz $N \times K$, onde N é o número de documentos. Assim, para cada vídeo, existe um porcentual de participação de cada tópico, cuja soma é igual a 1.

Vejamos essa matriz para os cinco primeiros vídeos:

head(fit$theta)

##             [,1]        [,2]        [,3]         [,4]         [,5]
## [1,] 0.000273920 0.003253428 0.004040834 0.0009959664 0.0001388210
## [2,] 0.018310800 0.030741680 0.708967915 0.0118358411 0.0006963748
## [3,] 0.070843633 0.041732621 0.013845361 0.0304166112 0.0839133871
## [4,] 0.008194601 0.002381194 0.008008110 0.0033322595 0.0018488345
## [5,] 0.010782705 0.026464694 0.010263833 0.0477243086 0.1095574639
## [6,] 0.006023939 0.872040010 0.005714869 0.0059672704 0.0481083479
##             [,6]        [,7]         [,8]        [,9]        [,10]
## [1,] 0.985509536 0.002881037 0.0001246733 0.002037421 0.0007443629
## [2,] 0.183050228 0.005301315 0.0292175603 0.008811973 0.0030663133
## [3,] 0.010378165 0.176350442 0.0412429834 0.262069287 0.2692075093
## [4,] 0.001888864 0.106774265 0.8546355488 0.011153510 0.0017828124
## [5,] 0.047119628 0.504319587 0.0113556114 0.156215296 0.0761968712
## [6,] 0.019619518 0.011139023 0.0019899886 0.006333920 0.0230631152

Observando a primeira linha, nota-se que existe um claro predomínio do Tópico 6, que representa 98% da distribuição de tópicos. Qual é esse vídeo?

df %>% 
  filter(row_number() == 1) %>% 
  select(id, title)

## # A tibble: 1 x 2
##   id          title                                                       
##   <chr>       <chr>                                                       
## 1 039orzgCUt0 10 DILEMAS MAIS FREQUENTES SOBRE TESOURO DIRETO! Tire as dú…

Vemos que o algoritmo acertou na mosca, pois de fato o vídeo é sobre Renda Fixa.

A qual tópico pertence o vídeo mais assistido do Me Poupe?

# id do video Meu Primeiro Milhao
ind <- which(df$id == "4jaWDfTbytA")
t(fit$theta[ind,])

##            [,1]       [,2]      [,3]       [,4]         [,5]        [,6]
## [1,] 0.05483404 0.03399528 0.5101044 0.01345342 0.0007212358 0.003021568
##             [,7]        [,8]        [,9]     [,10]
## [1,] 0.003167582 0.001051847 0.003699136 0.3759515

Os tópicos predominantes são 3 (Planejamento financeiro), com probabilidade de 51% e 10 (empreendedorismo), com 38%. Faz sentido, porque neste vídeo a Nathalia conta sua história como empreendedora para atingir seu primeiro milhão por meio de muito planejamento financeiro (não tô forçando, eu vi o vídeo).

Vamos então, para cada vídeo, extrair seu tópico predominante e contar a frequência de videos por tópico:

nomes_topicos <- c("economia_domestica", "generico", "plan_financeiro",
                   "mulher_familia", "politica", "renda_fixa", "renda_variavel",
                   "cartao_de_credito", "dividas", "empreendedorismo")
# extrair a maior probabilidade pra cada video
maior_prob <- apply(fit$theta, 1, max)
# extrair o nome do topico com a maior probabilidade
topico_video <- nomes_topicos[apply(fit$theta, 1, which.max)]

# acrescentar esses dados no dataframe principal
df_topico <- df %>% 
  mutate(maior_prob = maior_prob,
         topico = topico_video)

roxo <- "mediumpurple4"

# grafico da quantidade de videos por topico
df_topico %>% 
  count(topico) %>% 
  # classificar em ordem decrescente
  mutate(topico = forcats::fct_reorder(topico, n)) %>% 
  ggplot(aes(x = topico, y = n)) + 
  geom_col(fill = roxo) +
  theme_minimal() + 
  labs(x = NULL, y = "Vídeos",
       title = "Quantidade de vídeos por tópico") +
  coord_flip()

Os tópicos sobre os quais a Nathalia mais fala são Renda Fixa, Economia Doméstica e Dívidas. Quem acompanha seu canal não vai ficar surpreso com estes resultados, o que é um índicio da qualidade do modelo construído neste post.

Também é possível extrair os vídeos chaves de cada tópico, isto é, os vídeos com a maior probabilidade para cada tópico:

df_topico %>% 
  group_by(topico) %>% 
  filter(maior_prob == max(maior_prob)) %>% 
  select(id, title, topico, maior_prob) %>% 
  knitr::kable()

id	title	topico	maior_prob
_alsKxI3-TI	NATH AO VIVO! COMO VIAJAR SEM COLOCAR A MÃO NO BOLSO! Dicas preciosas dos viciados por pontos!	cartao_de_credito	0.9906875
eMQZRHoIgtQ	COMO EU TIRO AS METAS DO PAPEL! Técnica simples pra juntar mais dinheiro do que nunca!	plan_financeiro	0.9773071
FHqHW8-xvLQ	Dia das crianças - COMO FALAR QUE A GRANA TÁ CURTA	mulher_familia	0.9717965
iA9Iqx2uByo	Entrevista - Carlos Osório - Que Candidato é esse	politica	0.9907593
kddZm50Gluw	Perguntas e respostas #5 - Cartão de crédito e FIM DE NAMORO!	dividas	0.9629534
liIQENCBlF0	SE VOCÊ NÃO ENTENDER ISSO, NUNCA VAI INVESTIR NA BOLSA!_ Renda variável do jeito mais simples	renda_variavel	0.9695903
R0AQyTIvcvI	O que é SELIC E CDI Entenda isso HOJE e pare de PERDER DINHEIRO! _ SÉRIE INVESTIDORES INICIANTES	renda_fixa	0.9899924
SfG934AzjYU	COMO EU COMPRO ROUPAS DUAS VEZES AO ANO! Episódio final _ A negociação!	economia_domestica	0.9877744
WtFV03Suheg	A FINAL DA CONTRATAÇÃO QUE VOCÊ RESPEITA! Quem a Nath vai contratar (AGORA GRAVADO)	generico	0.9605720
Zla1-t3aOZw	3 ESCOLHAS QUE ENRIQUECERAM O CERBASI _ meu guru	empreendedorismo	0.9151230

Eu, pessoalmente, estou bastante satisfeito com os resultados. A modelagem de tópicos funcionou muito bem.

Vamos estão analisar algumas estatísticas básicas para cada tópico: quais têm os vídeos mais longos? Quais são os mais populares?

meu_grafico <- function(df, var){
  quo_var <- enquo(var)

  mediana_geral <- df %>% 
    summarise_at(vars(!!quo_var), median, na.rm = TRUE) %>% 
    pull()
  
  # obter grafico
  p <- df %>% 
    group_by(topico) %>% 
    summarise(m = median(!!quo_var, na.rm = TRUE)) %>% 
    ggplot(aes(x = topico, y = m)) +
    geom_col(fill = roxo) +
    geom_hline(yintercept = mediana_geral, linetype = "dashed") +
    theme_minimal() +
    coord_flip() +
    labs(x =  NULL, y = NULL)
  
  p
}
  
meu_grafico(df_topico, duration) + ggtitle("Média da duração dos vídeos por tópico do Me Poupe")

meu_grafico(df_topico, view_count) + ggtitle("Média de views por tópico do Me Poupe")

meu_grafico(df_topico, like_count) + ggtitle("Média de likes por tópico do Me Poupe")

Com estes gráficos, aprendemos que os vídeos sobre renda fixa, planejamento financeiro e empreendedorismo são os mais populares entre os “me poupeiros” (como a Nathalia chama quem acompanha o canal), pois possuem mais visualizações e curtidas. Outro fato interessante é que os vídeos categorizados como política são, por assim dizer, improdutivos, pois, apesar de serem os mais longos, possuem muitos poucos views. Existem alguns possíveis tipos de viés que poderiam explicar este dado, como o temporal.

Análise de Sentimento

Finalmente, vamos aplicar uma abordagem de análise de sentimento para analisar se os tópicos apresentam diferentes polaridades entre si. Quais tópicos são mais negativos?

data("sentiLex_lem_PT02")
dict <- unique(sentiLex_lem_PT02)

# criacao do dataframe de sentimento por topico
df_sent <- df %>% 
  unnest_tokens(palavra, caption) %>% 
  inner_join(sentiLex_lem_PT02, by = c("palavra" = "term")) %>% 
  group_by(id) %>% 
  summarise(
    sentimento_soma = sum(polarity),
    sentimento_media = mean(polarity)
  )

# acrescentar ao dafaframe principal
df_topico_sent <- inner_join(df_topico, df_sent, by = "id") 


# calcular sentimento geral dos videos
sent_medio_geral <- median(df_topico_sent$sentimento_media)

df_topico_sent %>% 
  mutate(topico = forcats::fct_reorder(topico, sentimento_media, median)) %>% 
  ggplot(aes(x = sentimento_media, y = topico)) +
  geom_density_ridges(fill = roxo) +
  geom_vline(xintercept = sent_medio_geral, linetype = "dashed") +
  theme_minimal() +
  labs(x = "Sentimento", y = NULL,
       title = "Distribuição dos sentimentos por tópico do Me Poupe")

## Picking joint bandwidth of 0.0756

Em novamente o que eu considero um acerto da metodologia, os vídeos de dívidas apresentaram polaridades mais baixas, ou sejas, um nível de sentimento mais negativo.

Conclusão

É relativamente difícil avaliar a acurácia e precisão de um algoritmo de topic modeling por essa técnica ser não-supervisionada, ou seja, os dados não possuírem um output com a resposta correta.

Contudo, os resultados apresentados neste post mostram que é possível sim usar esse tipo de técnica, com um certo auxílio de interpretação humana, para categorizar um conjunto de vídeos sem ser necessário os assistir ou mesmo sem saber seus títulos.

Referências

Antes das referências formais, gostaria de indicar o post do Júlio Trecenti, que é um outro exemplo de uso criativo de análise de dados para youtubers.

https://en.wikipedia.org/wiki/Topic_model

Mimno, D., Wallach, H. M., Talley, E., Leenders, M., & McCallum, A. (2011, July). “Optimizing semantic coherence in topic models.” In Proceedings of the Conference on Empirical Methods in Natural Language Processing (pp. 262-272). Association for Computational Linguistics. Chicago

Roberts, M., Stewart, B., Tingley, D., Lucas, C., Leder-Luis, J., Gadarian, S., Albertson, B., et al. (2014). “Structural topic models for open ended survey responses.” American Journal of Political Science, 58(4), 1064-1082

Margaret E. Roberts, Brandon M. Stewart and Dustin Tingley (2018). stm: R Package for Structural Topic Models. URL http://www.structuraltopicmodel.com.

Anunciando o lançamento de literaturaBR

Tue, 21 Nov 2017 00:00:00 +0000

Paixão por Dados de cara nova!

O blog está de cara nova! O endereço antigo do blog começou a apresentar alguns bugs bem chatos, então tomei a decisão de finalmente migrar para uma nova plataforma, utilizando o pacote blogdown, a mesma que o pessoal do Curso-R usa no site deles. Para comemorar essa migração, anuncio o lançamento do meu terceiro pacote R: o literaturaBR.

literaturaBR, o mais novo pacote da comunidade R Brasil

Após lançar o pacote lexiconPT, senti que a carência de datasets textuais na língua portuguesa poderia restringir seu potencial de alcance de desenvolvedores e cientistas de dados interessados em usar os léxicos para fazer análise de sentimento. Apesar de ter feito um post mostrando seu uso em dados obtidos do Facebook, eu admito que é complicado ter que fazer web scraping de algum site toda vez que se deseja praticar ou ensinar mineração de texto com textos em Português.

Esse problema me inspirou a desenvolver mais um pacote R para facilitar pequenas demonstrações de Text Mining. Assim como a Julia Silge criou o janeaustenr com livros clássicos da Jane Austen, eu criei o literaturaBR, um data package criado para disponibilizar livros clássicos da literatura brasileira já prontos para serem importados e manuseados no R. Para saber quais livros estão disponíveis na versão atual do pacote e outras informações úteis, visite seu repositório.

Este post se destina a apresentar algumas exemplos simples de tarefas de Text Mining, como:
* Análise de Sentimento;
* Complexidade Léxica;
* Analise de ocorrência de palavras em específico.

Introdução

Os pacotes usados neste post são:

library(literaturaBR) # meio obvio
library(tidytext) # excelente pacote de text mining
library(tidyverse) # <3
library(stringr) # indispensavel para manipulacao de texto
library(quanteda) # otimas funcoes para analise quantitativa de texto
library(qdap) # similar ao quanteda, embo ra eu nao me lembre exatamente se eu o uso neste post
library(forcats) # manipulacao de fatores
library(ggthemes) # temas para o ggplot2
library(lexiconPT)

Vamos então importar os datasets presentes no literaturaBR na data de hoje e os transformar em um dataset só:

data("memorias_de_um_sargento_de_milicias")
data("memorias_postumas_bras_cubas")
data("alienista")
data("escrava_isaura")
data("ateneu")

df <- bind_rows(memorias_de_um_sargento_de_milicias,
                memorias_postumas_bras_cubas,
                alienista,
                escrava_isaura,
                ateneu)


# Olhando a estrutura do dataframe
glimpse(df)

## Observations: 5,149
## Variables: 5
## $ book_name        <chr> "Memórias de um Sargento de Milícias", "Memór...
## $ chapter_name     <chr> "Capítulo 1 - Origem, nascimento e batismo", ...
## $ url              <chr> "https://pt.wikisource.org/wiki/Mem%C3%B3rias...
## $ paragraph_number <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2, ...
## $ text             <chr> "Era no tempo do rei.", "Uma das quatro esqui...

Todos os datasets fornecidos pelo literaturaBR possuem a mesma estrutura, onde cada linha corresponde a um parágrafo de um livro e contêm 5 variáveis:
* book_name: Nome original do livro;
* chapter_name: Nome original do capítulo do livro do parágrafo;
* url: Link para artigo do Wikisouce de onde o capítulo do parágrafo foi extraído;
* paragraph_number: Ordem do parágrafo em seu capítulo;
* text: Texto do parágrafo. Contem acentos e pontuação.

Um rápido adendo: os nomes das colunas está em inglês porque só tomei a decisão de escrever toda a documentação do pacote em Português meio tardiamente.

Análise básica

Para usar (parte) das funções do pacote quanteda, precisamos converter o dataframe dos livros em um objeto do tipo corpus.

df_corpus <- df %>% 
  # agrupar por livro
  group_by(book_name) %>% 
  # formatar o dataframe para que so tenha uma linha por livro
  summarise(text = paste0(text, sep = "", collapse = ". "))

dim(df_corpus)

## [1] 5 2

meu_corpus <- quanteda::corpus(df_corpus$text, docnames = df_corpus$book_name)
summary(meu_corpus)

## Corpus consisting of 5 documents:
## 
##                                 Text Types Tokens Sentences
##                     A escrava Isaura  9349  64929      1751
##  Memórias de um Sargento de Milícias  8703  71391      2287
##      Memórias Póstumas de Brás Cubas 11058  74223      3199
##                          O Alienista  4387  19977       770
##                             O Ateneu 15341  73063      3551
## 
## Source:  /home/sillas/R/Projetos/paixaopordados-blogdown/content/post/* on x86_64 by sillas
## Created: Wed Nov 22 20:34:35 2017
## Notes:

Como vemos, a função quanteda::corpus() identificou a quantidade de Types (número de palavras distintas em um corpus), Tokens (número total de palavras em um corpus) e Sentences (frases) em cada livro.

Vamos então criar uma document-feature matrix a partir desse corpus criado, tomando o cuidade de remover pontuações e stopwords:

corpus_dfm <- dfm(meu_corpus, remove_punct = TRUE,
                  remove = quanteda::stopwords("portuguese"),
                  groups = df_corpus$book_name)

# Analisando as 15 palavras mais comuns no geral por livro
dfm_sort(corpus_dfm)[, 1:15]

## Document-feature matrix of: 5 documents, 15 features (5.33% sparse).
## 5 x 15 sparse Matrix of class "dfm"
##                                      features
## docs                                    é casa tempo ainda tudo bem todos
##   A escrava Isaura                    424   98    81   121   78 175    78
##   Memórias de um Sargento de Milícias 305  193   207   131  192 126   139
##   Memórias Póstumas de Brás Cubas     492  107   108    89   98  65    69
##   O Alienista                          88  108    20    29   26  10    37
##   O Ateneu                            199   51    56    97   56  56    91
##                                      features
## docs                                  tão ser havia   d leonardo coisa
##   A escrava Isaura                    137  96    56  20        0    35
##   Memórias de um Sargento de Milícias  63  75   153 194      366   128
##   Memórias Póstumas de Brás Cubas      95  97    53  83        0   140
##   O Alienista                          31  25     7  44        0    23
##   O Ateneu                             47  78   101  26        0    38
##                                      features
## docs                                  disse dia
##   A escrava Isaura                       67  41
##   Memórias de um Sargento de Milícias   119 128
##   Memórias Póstumas de Brás Cubas       130  89
##   O Alienista                            30  21
##   O Ateneu                               11  77

A função dfm_sort() retorna a ocorrência de cada palavra (também chamado de token ou feature) em cada livro. Para pesquisar a ocorrência de alguma palavra específica nos documentos, use a função dfm_select():

# ocorrencias da palavra amor
dfm_select(corpus_dfm, "amor")

## Document-feature matrix of: 5 documents, 1 feature (0% sparse).
## 5 x 1 sparse Matrix of class "dfm"
##                                      features
## docs                                  amor
##   A escrava Isaura                      71
##   Memórias de um Sargento de Milícias   30
##   Memórias Póstumas de Brás Cubas       53
##   O Alienista                            3
##   O Ateneu                              45

Curioso para saber o contexto em que essa palavra aparece? Você pode usar a função kwic() para isso:

# usar a função head() para o output nao ficar mt grande
kwic(meu_corpus, "amor") %>% head()

##                                                              
##  [A escrava Isaura, 2011]    , bem pode conquistar o | amor |
##  [A escrava Isaura, 5090]    não se havia casado por | amor |
##  [A escrava Isaura, 5173]     o mais cego e violento | amor |
##  [A escrava Isaura, 6555] pudesse obter também o teu | amor |
##  [A escrava Isaura, 7215]          Ora, senhor, pelo | amor |
##  [A escrava Isaura, 7686]  disputar com o senhor por | amor |
##                         
##  de algum guapo mocetão,
##  , sentimento esse a que
##  , que de dia em        
##  !... És                
##  de Deus!..             
##  de uma escrava..

Para saber as palavras mais usadas, dentre os vários métodos possíveis para isso, pode-se usar a função topfeatures()

topfeatures(corpus_dfm, groups = df_corpus$book_name)

## $`A escrava Isaura`
##       é  isaura  senhor leôncio  álvaro escrava     bem     tão     pai 
##     424     344     243     205     188     180     175     137     127 
##   ainda 
##     121 
## 
## $`Memórias de um Sargento de Milícias`
## leonardo        é    maria  comadre    tempo    porém        d     casa 
##      366      305      231      209      207      205      194      193 
##     tudo    major 
##      192      179 
## 
## $`Memórias Póstumas de Brás Cubas`
##        é virgília    coisa    olhos    disse     nada    outro    outra 
##      492      199      140      138      130      125      122      116 
##     vida   porque 
##      116      113 
## 
## $`O Alienista`
##      casa alienista         é     verde bacamarte  barbeiro    câmara 
##       108       106        88        77        59        54        52 
##   itaguaí     simão  evarista 
##        49        49        45 
## 
## $`O Ateneu`
##         é     sobre aristarco   diretor     havia     ainda    ateneu 
##       199       167       148       104       101        97        93 
##     todos       ser      dois 
##        91        78        77

Análise comparativa entre os livros

Algo interessante a se fazer é quantificar a similaridade e a dissimilaridade ou distância entre os livros. As funções textstat_simil e textstat_dist implementam diversas técnicas e algoritmos para isso. Sugiro ler a documentação completa das funções e ler as referências indicadas para conhecer melhor os métodos de cálculo.

Vamos então calcular a similaridade entre os livros presentes no pacote:

# normalizar os livros pelo seu tamanho
corpus_dfm_norm <- dfm_weight(corpus_dfm, "relfreq")
corpus_simil <- textstat_simil(corpus_dfm_norm, method = "correlation",
                               margin = "documents", upper = TRUE,
                               diag = FALSE)
# ver os resultados individualmente para cada livro
round(corpus_simil, 3)

##                                     A escrava Isaura
## A escrava Isaura                                    
## Memórias de um Sargento de Milícias            0.524
## Memórias Póstumas de Brás Cubas                0.625
## O Alienista                                    0.431
## O Ateneu                                       0.512
##                                     Memórias de um Sargento de Milícias
## A escrava Isaura                                                  0.524
## Memórias de um Sargento de Milícias                                    
## Memórias Póstumas de Brás Cubas                                   0.642
## O Alienista                                                       0.502
## O Ateneu                                                          0.550
##                                     Memórias Póstumas de Brás Cubas
## A escrava Isaura                                              0.625
## Memórias de um Sargento de Milícias                           0.642
## Memórias Póstumas de Brás Cubas                                    
## O Alienista                                                   0.585
## O Ateneu                                                      0.631
##                                     O Alienista O Ateneu
## A escrava Isaura                          0.431    0.512
## Memórias de um Sargento de Milícias       0.502    0.550
## Memórias Póstumas de Brás Cubas           0.585    0.631
## O Alienista                                        0.450
## O Ateneu                                  0.450

Alguns resultados são bem interessantes. O Alienista é mais diferente de todos, tendo uma correlação superior a 0,51 apenas com o livro Memórias Póstumas de Brás Cubas, coincidentemente ou não ambos do mesmo autor. A maior correlação pertence aos livros Memórias Póstumas de Brás Cubas e Memórias de um Sargento de Milícias.

Passemos então para a análise da dissimilaridade ou distância entre os livros, com o auxílio de um dendograma:

corpus_dist <- textstat_dist(corpus_dfm_norm, method = "euclidean",
                               margin = "documents", upper = TRUE,
                               diag = FALSE)
# ver os resultados individualmente para cada livro
plot(hclust(corpus_dist))

Análise de Sentimento

Como já publiquei no blog um post sobre Análise de Sentimento, não vou me alongar em repetir conceitos sobre o tema. Segue o código comentado:

# Criar um dataframe em que cada linha corresponda a uma unica palavra
df.token <- df %>%
  unnest_tokens(term, text)

glimpse(df.token)

## Observations: 252,299
## Variables: 5
## $ book_name        <chr> "Memórias de um Sargento de Milícias", "Memór...
## $ chapter_name     <chr> "Capítulo 1 - Origem, nascimento e batismo", ...
## $ url              <chr> "https://pt.wikisource.org/wiki/Mem%C3%B3rias...
## $ paragraph_number <int> 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, ...
## $ term             <chr> "era", "no", "tempo", "do", "rei", "uma", "da...

# importar lexico de sentimentos
data("oplexicon_v3.0")
df.token <- df.token %>%
  inner_join(oplexicon_v3.0, by = "term")

Um pergunta muito interessante a se fazer é se o sentimento varia ao longo dos capítulos dos livros. Os livros ficam mais (ou menos) positivos a medida em que se aproximam do final?

Para isso, primeiro precisamos normalizar os livros, visto que eles apresentam tamanhos e quantidades de capítulos diferentes.

# extrair capitulos de cada livro
df_chapter_number <- df.token %>%
  distinct(book_name, chapter_name) %>%
  group_by(book_name) %>%
  # normalizar capitulo de acordo com sua posicao no livro
  mutate(chapter_number_norm = row_number()/max(row_number()))

glimpse(df_chapter_number)

## Observations: 252
## Variables: 3
## $ book_name           <chr> "Memórias de um Sargento de Milícias", "Me...
## $ chapter_name        <chr> "Capítulo 1 - Origem, nascimento e batismo...
## $ chapter_number_norm <dbl> 0.02083333, 0.04166667, 0.06250000, 0.0833...

Agora calculamos o sentimento de cada capítulo, que corresponde à soma da polaridade de suas palavras:

df.sentiment <- df.token %>%
  # calcular sentimento por capitulo
  group_by(book_name, chapter_name) %>%
  summarise(polarity = sum(polarity, na.rm = TRUE)) %>%
  ungroup() %>%
  # retornar posicao relativa (ou normalizada) do capitulo de cada livro
  left_join(df_chapter_number) %>%
  arrange(book_name, chapter_number_norm)

# grafico
df.sentiment %>%
  ggplot(aes(x = chapter_number_norm, y = polarity)) +
    geom_line() +
    facet_wrap(~ book_name, ncol = 5, labeller = label_wrap_gen(20)) +
    labs(x = "Posição relativa no livro", y = "Sentimento") +
    theme_bw()

Os resultados são muito interessantes: De acordo com esse método, A Escrava Isaura e O Ateneu são verdadeiras montanhas-russas de emoções, enquanto que livros os “dois Memórias” são mais estáveis. O Alienista apresenta um sentimento que tem uma tendência decrescente até a metade e crescente após ela.

Complexidade léxica e ocorrência de palavras

A função textstat_lexdiv traz várias métricas de complexidade e diversidade léxicas. Novamente, recomendo a leitura de sua documentação para conhecer as métricas disponíveis.

# aplicando a funcao no objeto sem stopwords e pontuação
lexdiv <- textstat_lexdiv(corpus_dfm, measure = "TTR")
lexdiv

##                    A escrava Isaura Memórias de um Sargento de Milícias 
##                           0.3062233                           0.2517707 
##     Memórias Póstumas de Brás Cubas                         O Alienista 
##                           0.3139269                           0.4291334 
##                            O Ateneu 
##                           0.4134223

#grafico
lexdiv %>% 
  as.data.frame() %>% 
  magrittr::set_colnames("TTR") %>% 
  tibble::rownames_to_column("livro") %>% 
  mutate(livro = forcats::fct_reorder(livro, TTR)) %>% 
  ggplot(aes(x = livro, y = TTR)) + 
    geom_col(fill = "cadetblue4") +
    coord_flip() + 
    labs(x = NULL, y = "TTR") +
    theme_minimal()

O livro que apresenta a maior diversidade léxica, de acordo com a métrica Type-Token Ratio (TTR), é O Alienista. Memórias de um Sargento de Milícias vem bem atrás dos demais.

De todas os gráficos que apresentei neste post, o mais legal vem a seguir. É possível plotar a ocorrência de uma determinada palavra ao longo dos livros analisados. Por exemplo, a ocorrência da palavra amor é uniformemente distribuída nos livros?

kwic(meu_corpus, "amor") %>% textplot_xray(scale = "relative")

Com o gráfico acima, é possível ver que a palavra amor aparece, no livro Ateneu, muito mais frequentemente na primeira metade do que na segunda. Nos demais livros, a ocorrência da palavra é mais uniforme.

Outro exemplo interessante surge com a busca da palavra fogo. Quem já leu O Ateneu já consegue imaginar como serão os resultados:

kwic(meu_corpus, "fogo") %>% textplot_xray(scale = "relative")

Conclusão

Eu realmente torço para que o literaturaBR e o lexiconPT atinjam seus potenciais e sejam dois grandes marcos em pesquisas em Text Mining com textos em português. Toda sugestão ou pedido de melhorias serão muitíssimos bem-vindos.

Mineração de textos em notícias de G1: O que diferencia notícias sobre Rio de Janeiro e São Paulo?

Sun, 15 Oct 2017 00:00:00 +0000

library(rvest)
library(tidyverse)
library(magrittr)
library(stringr)
library(Rfacebook)
library(tidytext)
library(tm)

Motivação para o post

Apesar de hoje em dia eu morar no Rio de Janeiro, morei e vivi (quase) a vida toda em Aracaju, a capital do menor estado do Brasil. Devido à irrelevância que a cidade tem (desculpa mas é verdade) no cenário político e econômico do país, era (e ainda é) muito raro ver qualquer notícia em um veículo de audiência nacional (como o Jornal Nacional ou a homepage do G1 ou Estadão) relacionada a Aracaju ou a Sergipe que não seja desgraça ou por um acontecimento inusitadamente ruim. Voltei a notar isso recentemente, quando saiu na homepage do G1 uma notícia de Sergipe sobre o desabamento de um camarote durante a Odonto Fantasy, uma das maiores festas a fantasia do Brasil.

Como bom entusiasta por Data Science, decidi não me ater ao senso comum de que Sergipe só tem destaque nacional por motivos de desgraça e sujei as mãos: é possível testar a hipótese de que certos temas são mais associados a algumas cidades que outras? O que destaca as notícias sobre estados menores que saem na homepage do G1 comparadas com as de estados maiores?

Consigo pensar em pelo menos dois (possivelmente existem mais) métodos para realizar essa análise: além da análise de frequência mencionada acima (a palavra X está mais associada a cidade Y1 do que a cidade Y2), poderia ser aplicada uma análise de sentimento para distinguir o sentimento de notícias relacionadas a Aracaju em comparação com o de cidades maiores. Neste post, o foco será na primeira alternativa.

Coleta dos dados

Vejam que fui enfático sobre a notícia em si ter saído na homepage do G1 ou não. Ou seja, não basta ela ter saído na página local do estado (como a de Sergipe). O primeiro problema é então ter um histórico de notícias que saíram na primeira página, o que não existe em nenhum lugar público na Internet. Não bastaria entrar na página de cada estado e coletar as notícias. Nesta análise, é fundamental ter a certeza de que pessoas de todo o Brasil puderam ter acesso fácil ao artigo.

Para resolver o problema, utilizei o pressuposto de que, se a notícia foi postada na página do G1 no Facebook, é porque ela saiu na home. Não sei o quanto que isso é verdade, mas acredito que seja uma hipótese válida.

Para extrair os links postados na página do G1 no Facebook, utilizamos o pacote Rfacebook:

token <- readRDS("/home/sillas/R/facebook_token.Rds")
g1 <- Rfacebook::getPage("180562885329138", token = token, n = 5000)

O intervalo pesquisado é:

range(sort(g1$created_time))

## [1] "2006-09-18T07:00:00+0000" "2017-10-14T20:46:01+0000"

g1_links <- g1$link

Nem todos os links postados pela página redirecionam ao G1: alguns são de vídeos postados no próprio Facebook. Por isso, é necessário limpar os dados:

# remover links de videos do facebook
g1_links <- g1_links[!str_detect(g1_links, "www.facebook.com")]

# ver links mais comuns
str_replace_all(g1_links, "http://|https://", "") %>% str_replace_all("/.*", "") %>% table()

## .
##                 bit.ly   fantastico.globo.com           g1.globo.com 
##                      8                      1                    717 
##                 glo.bo globoesporte.globo.com        media.giphy.com 
##                    895                      8                      1 
##          s2.glbimg.com 
##                      1

Ainda existem alguns links meio nebulosos. Vamos nos ater aos que são do G1 (g1.globo.com) e do encurtador de URLs da Globo.com (glo.bo). Para estes últimos, como precisamos extrair o estado da notícia da URL (de https://g1.globo.com/se/sergipe/noticia/camarote-desaba-durante-show-de-ivete-sangalo-em-aracaju.ghtml precisamos extrair “se”, a sigla de Sergipe), uso uma função postada no meu Gist para converter uma URL encurtada em normal:

# manter apenas links glo.bo e g1.globo.com
g1_links <- g1_links[str_detect(g1_links, "g1.globo.com|glo.bo") & !is.na(g1_links)]
# carregar funcao para transformar url encurtada
devtools::source_gist("2e92f880811f460c7edd0a622563a17a", filename = "getLongURL.R")
# converter links glo.bo para urls inteiras
ind <- str_which(g1_links, "glo.bo")
getLongURL.curl.possibly <- possibly(getLongURL.curl, otherwise = NA)
novos_links <- g1_links[ind] %>% map_chr(getLongURL.curl.possibly)
g1_links[ind] <- novos_links
# manter apenas links glo.bo e g1.globo.com (para remover links de outros sites da globo, como o Globoesporte.com)
g1_links <- g1_links[str_detect(g1_links, "g1.globo.com|glo.bo") & !is.na(g1_links)]

Tendo os links corrigidos, podemos então criar uma função que extraia o corpo da notícia do link. Como o foco deste post não é o Web Scraping em si e sim os dados resultantes dele, não vou descrever muito o que a função abaixo faz. Em caso de dúvidas, escreva nos comentários do post ou entre em contato comigo que eu responderei com grande prazer.

# criar função
extrair_g1 <- function(url_g1){
  # exemplo de url:
  # "https://g1.globo.com/rio-de-janeiro/noticia/imagens-mostram-acao-de-criminosos-durante-assalto-na-zona-norte-do-rio.ghtml"
  if (!str_detect(url_g1, "glo.bo") & !str_detect(url_g1, "g1.globo")){
    warning(paste0("Link inválido: ", url_g1))
    return(NA)
  }
  
  x <- url_g1 %>% read_html() 
  # extrair sessao da noticia
  css_nome_caderno <- ".header-editoria--link"
  caderno <- x %>% html_nodes(css_nome_caderno) %>% html_text()
  if (length(caderno) == 0) caderno <- NA
  # extrair corpo da noticia
  css_corpo_a <- ".content-text__container"
  css_corpo_b <- "#materia-letra p"
  css_corpo_c <- ".post-content p"
  
  corpo_noticia <- x %>% 
    html_nodes(css_corpo_a) %>% 
    html_text()
  # se o css selector nao funcionou, use outro:
  if (length(corpo_noticia) == 0) {
    corpo_noticia <- x %>% 
      html_nodes(css_corpo_b) %>% 
      html_text()
  } 
  
  if (length(corpo_noticia) == 0) {
    corpo_noticia <- x %>% 
      html_nodes(css_corpo_c) %>% 
      html_text()
  } 
  # colapsar corpo da noticia em um vetor de elemento unico
  corpo_noticia <- paste0(corpo_noticia, collapse = ". ")
  
  
  tibble(url = url_g1, caderno = caderno, corpo_noticia = corpo_noticia)
}

# agora sim extrair dados do g1:
df_g1 <- g1_links %>% map_df(extrair_g1)

# extrair caderno da url da noticia
df_g1$documento  <- df_g1$url %>% 
  str_replace_all("https", "http") %>% 
  str_replace_all("http://g1.globo.com/", "") %>% 
  str_replace_all("/.*", "")

Uma amostra mínima dos dados coletados:

str(df_g1[1,])

## Classes 'tbl_df', 'tbl' and 'data.frame':    1 obs. of  4 variables:
##  $ url          : chr "https://g1.globo.com/politica/operacao-lava-jato/noticia/occhi-tinha-meta-mensal-de-propina-para-distribuir-a-p"| __truncated__
##  $ caderno      : chr "Operação Lava Jato"
##  $ corpo_noticia: chr " O doleiro Lúcio Funaro afirmou em seu acordo de delação premiada com a Procuradoria Geral da República (PGR) q"| __truncated__
##  $ documento    : chr "politica"

Agora podemos partir para a análise. Mas antes, um pouco de contexto teórico:

tf-idf

O Fator de Frequência Inversa no Documento ou term’s inverse document frequency (tf-idf) é uma técnica de mineração de texto que calcula a frequência de um determinado elemento textual (como uma palavra ou um n-gram) em um documento, diminuindo o peso de palavras comumente usadas em vários contextos diferentes (como “a”, “o” e “de”) e aumentando o peso de palavras que não são usadas em outros documentos da coleção.

No glossário de mineração de texto, documento nada mais é do que uma coleção que categoriza um conjunto de textos. Pode ser um livro (inteiro ou apenas um ou mais capítulos), a letra de uma música, um poema, uma notícia, um conjunto de notícias, etc. No nosso contexto, definimos como documento as notícias do G1 coletadas nessa amostra sobre um determinado tema, como Rio de Janeiro, São Paulo, Política ou Economia. Daí o nome da última coluna.

O livro online Text Mining with R é uma ótima referência para tf-idf, tanto teórica quanto prática.

Resultados

Quais são os documentos mais comuns?

df_g1$documento %>% table() %>% sort() %>% rev()

## .
##                   mundo               sao-paulo          rio-de-janeiro 
##                     205                     158                     118 
##                pop-arte              tecnologia                economia 
##                     110                     102                      99 
##                politica                      sp         ciencia-e-saude 
##                      95                      73                      60 
##         planeta-bizarro                bemestar                  musica 
##                      37                      30                      29 
##        distrito-federal                      mg                      pr 
##                      28                      27                      26 
##                  carros   vestibular-e-educacao                   goias 
##                      24                      21                      21 
##                  brasil                educacao             rock-in-rio 
##                      21                      18                      17 
##                natureza          espirito-santo                      sc 
##                      17                      15                      13 
##                      rs           resumo-do-dia            minas-gerais 
##                      13                      13                      13 
##             mato-grosso          11-de-setembro                   bahia 
##                      13                      13                      12 
##                vc-no-g1                  parana           agenda-do-dia 
##                      10                      10                       9 
##                      pi         bienal-do-livro                      rj 
##                       8                       8                       7 
##                     swu              pernambuco                      pb 
##                       6                       6                       6 
##      mato-grosso-do-sul                loterias                      rn 
##                       6                       6                       5 
##                      to                      rr                      ro 
##                       4                       4                       4 
##           revolta-arabe                 paraiba                      pa 
##                       4                       4                       4 
##              fantastico        dia-das-criancas                      ac 
##                       4                       4                       4 
##        turismo-e-viagem       rihanna-no-brasil                   platb 
##                       3                       3                       3 
## justin-bieber-no-brasil              e-ou-nao-e                   ceara 
##                       3                       3                       3 
##                  videos                      se                      ma 
##                       2                       2                       2 
##                 loteria                      ap                      am 
##                       2                       2                       2 
##                      al                    spfw          reveillon-2012 
##                       2                       1                       1 
##    monitor-da-violencia   especial-publicitario               especiais 
##                       1                       1                       1 
##            dia-dos-pais       dia-dos-namorados     concursos-e-emprego 
##                       1                       1                       1 
##                amazonas 
##                       1

As sessões do G1 que mais marcam presença na homepage são, sem muita surpresa, Mundo, São Paulo e Rio de Janeiro. Você pode ter percebido que existe tanto um documento chamado “sao-paulo” como “sp”, assim como “rio-de-janeiro” e “rj”. Isso acontece porque o G1, para os maiores estados, tem sessões separadas para a capital e para o resto das cidades.

Os dois primeiros objetos de estudo são as cidades mais famosas do Brasil: Rio de Janeiro e São Paulo. O passo-a-passo da aplicação do tf-idf para essas duas cidades é descrito abaixo:

docs <- c("rio-de-janeiro", "sao-paulo")

df_filtro  <- df_g1 %>%
  #mutate(caderno_url = if_else(caderno %in% vetor_cadernos, "Selecionado", "Outros"))
  filter(documento %in% docs)

temp <- df_filtro %>% 
  # separar cada palavra do corpo da notícia em uma linha diferente, sem converter para minusculo
  unnest_tokens(palavra, corpo_noticia, token = "ngrams", n = 1, to_lower = FALSE) %>% 
  # remover as duplicatas, isto é, as palavras que aparecem mais de uma vez em uma mesma noticia
  distinct(url, palavra, .keep_all = TRUE) %>% 
  # contar a ocorrencia de cada palavra em cada doc
  count(documento, palavra) %>% 
  tidytext::bind_tf_idf(term = palavra, document = documento, n = n) %>%  
  # ordenar as palavras com menor tf_idf por documento
  group_by(documento) %>% 
  arrange(desc(tf_idf)) %>% 
  mutate(palavra = factor(palavra, levels = rev(unique(palavra)))) %>% 
  #filtrar as 20 de maior destaque
  filter(row_number() <= 20) %>% 
  ungroup() %>% 
  arrange(desc(tf_idf)) %>% 
  mutate(palavra = factor(palavra, levels = rev(unique(palavra))))
    

# construir grafico
temp %>% 
  ggplot(aes(palavra, tf_idf, fill = documento)) +
      geom_col(show.legend = FALSE) +
      geom_text(aes(label = n), hjust = 1.3) +
      labs(x = NULL, y = "tf-idf",
           title = "Termos mais frequentes associados a apenas uma das cidades",
           caption = "Fonte: Mineração de texto aplicada em notícias do G1.") +
      facet_wrap(~documento, ncol = 2, scales = "free") +
      coord_flip()

Algumas observações sobre os resultados precisam ser feitas:
* No Rio de Janeiro, aparecem alguns termos meio estranhos como Envie e VC. Isso acontece porque, durante um período, no final das reportagens, o G1 escrevia algo como “Envie VC também uma reportagem para o G1RJ pelo Whatsapp ou pelo Viber”.
* Alguns nomes próprios se destacam, o que é natural, visto que Dória é prefeito de SP e Cabral um ex-governador do RJ. Em mineração de texto, esse tipo de dado é chamado de Entidade.

Para limpar os resultados no segundo caso, são removidos os substantitos próprios. A maneira que eu bolei para isso talvez não seja a mais científica ou linguisticamente correta possível, mas aparenta ter funcionado. Ela se baseia em remover toda palavra que não é igual se escrita toda em minúsculo ou se escrita toda em maiúsculo. Por exemplo:

eh_substantivo_comum <- function(x) {x == str_to_lower(x) | x == str_to_upper(x)}
c(eh_substantivo_comum("tiroteio"), eh_substantivo_comum("RJTV"), eh_substantivo_comum("Doria"))

## [1]  TRUE  TRUE FALSE

Aproveitando o embalo da limpeza de dados, os termos mencionados acima como “Envie” e “VC” também serão removidos. Aplicando esta metodologia:

temp <- df_filtro %>% 
  unnest_tokens(palavra, corpo_noticia, token = "ngrams", n = 1, to_lower = FALSE) %>% 
  # aplicar regra do substantivo comum
  filter(eh_substantivo_comum(palavra)) %>% 
  # remover termos estranhos
  filter(!palavra %in% c("VC", "RJTV")) %>% 
  distinct(url, palavra, .keep_all = TRUE) %>% 
  count(documento, palavra) %>% 
  tidytext::bind_tf_idf(term = palavra, document = documento, n = n) %>%  
  group_by(documento) %>% 
  arrange(desc(tf_idf)) %>% 
  mutate(palavra = factor(palavra, levels = rev(unique(palavra)))) %>% 
  filter(row_number() <= 20) %>% 
  ungroup() %>% 
  arrange(desc(tf_idf)) %>% 
  mutate(palavra = factor(palavra, levels = rev(unique(palavra))))
    

# construir grafico
temp %>% 
  ggplot(aes(palavra, tf_idf, fill = documento)) +
      geom_col(show.legend = FALSE) +
      geom_text(aes(label = n), hjust = 1.3) +
      labs(x = NULL, y = "tf-idf",
           title = "Termos mais frequentes associados a apenas uma das cidades",
           caption = "Fonte: Mineração de texto aplicada em notícias do G1.") +
      facet_wrap(~documento, ncol = 2, scales = "free") +
      coord_flip()

Agora é possível notar resultados mais interessantes: termos relacionados ao tráfico de drogas como tiroteio, rival, UPP e propinas possui uma frequência relativa muito maior em notícias sobre a cidade do Rio de Janeiro que na capital paulista. Por outro lado, notícias sobre estupro e abuso parecem ser mais comuns na terra onde biscoito é chamado de bolacha.

Também é possível realizar essa mesma análise por expressões compostas por mais de uma palavra, que são os chamados n-grams, onde n é a quantidade de termos. Analisando os 2-grams:

temp <- df_filtro %>% 
  unnest_tokens(palavra, corpo_noticia, token = "ngrams", n = 2, to_lower = FALSE) %>% 
  # aplicar regra do substantivo comum
  filter(eh_substantivo_comum(palavra)) %>% 
  distinct(url, palavra, .keep_all = TRUE) %>% 
  count(documento, palavra) %>% 
  tidytext::bind_tf_idf(term = palavra, document = documento, n = n) %>%  
  group_by(documento) %>% 
  arrange(desc(tf_idf)) %>% 
  mutate(palavra = factor(palavra, levels = rev(unique(palavra)))) %>% 
  filter(row_number() <= 20) %>% 
  ungroup() %>% 
  arrange(desc(tf_idf)) %>% 
  mutate(palavra = factor(palavra, levels = rev(unique(palavra))))
    

# construir grafico
temp %>% 
  ggplot(aes(palavra, tf_idf, fill = documento)) +
      geom_col(show.legend = FALSE) +
      geom_text(aes(label = n), hjust = 1.3) +
      labs(x = NULL, y = "tf-idf") +
      facet_wrap(~documento, ncol = 2, scales = "free") +
      coord_flip()

E Sergipe?

Conforme foi mostrado um pouco acima, existem apenas 2 notícias de Sergipe na amostra coletada. O Sudeste é o grande monopolizador da primeira página do G1. Mesmo se aplicássemos o tf-idf comparando o Rio de Janeiro com Sergipe, os resultados seriam enviesados devido à baixíssima quantidade de dados do último. Por isso, Norte e Nordeste são agregadas como uma:

Vamos então criar mais uma coluna para identificar a região do Brasil a qual a notícia se refere:

df_g1 %<>% 
  mutate(regiao = case_when(
    documento %in% c("ac", "am", "amazonas", "ap", "pa", "ro", "rr") ~ "Norte",
    documento %in% c ("al", "bahia", "ceara", "ma", "paraiba", "pb", "pernambuco", "pi", "rn", "se", "to") ~ "Nordeste",
    documento %in% c("distrito-federal", "goias", "mato-grosso", "mato-grosso-do-sul") ~ "Centro-Oeste",
    documento %in% c("espirito", "mg", "minas-gerais", "rio-de-janeiro", "rj", "sao-paulo", "sp") ~ "Sudeste",
    documento %in% c("parana", "rs", "sc") ~ "Sul",
    #caderno_url %in% "mundo" ~ "Mundo",
    TRUE ~ NA_character_
  ))

df_g1$regiao[df_g1$regiao %in% c("Norte", "Nordeste")] <- "Norte-Nordeste"

# regioes mais comuns:
df_g1$regiao %>% table() %>% sort() %>% rev()

## .
##        Sudeste Norte-Nordeste   Centro-Oeste            Sul 
##            396             75             68             36

Para não ter de repetir o código que constrói os gráficos acima, salvei a função neste Gist, com direito a algumas parametrizações, como a opção de remover ou não substantivos próprios:

id_gist <- "2d626f33ee1b635a0aa3beeda31ae720"
devtools::source_gist(id_gist, filename = "grafico_g1.R")

df_g1 %>% 
  mutate(documento = regiao) %>% 
  filter(!is.na(documento)) %>% 
  grafico_tfidf(n_grams = 1, remover_nomes_proprios = TRUE, agregar_por_noticia = TRUE)

Mesmo agregando os dados por região, o desbalanceamento da quantidade de notícias por região prejudicou os resultados. Seria necessário coletar muito mais notícias para que os resultados fossem mais interessantes.

Bônus

A análise não precisa se restringir a regiões demográficas. Podemos, por exemplo, comparar notícias dos cadernos de Política e Ciência:

df_g1 %>% 
  filter(documento %in% c("politica", "ciencia-e-saude")) %>% 
  grafico_tfidf(n_grams = 1, remover_nomes_proprios = TRUE, agregar_por_noticia = TRUE)

O Sensacionalista e Text Mining: Análise de sentimento usando o lexiconPT

Sat, 23 Sep 2017 00:00:00 +0000

De volta à ativa no blog!

Recentemente, quando precisei fazer pela primeira vez algum tipo de análise em cima de textos (o chamado Text Mining ou Mineração de Texto) em Português, senti falta de ter um acesso fácil a um léxico na linguagem. O R já tem a sua disposição vários recursos para quem quer fazer Text Mining em inglês, como os pacotes tokenizer, tidytext, tm e lexicon, além de vários blog posts sobre Sentiment Analysis que você encontra no R-bloggers. Contudo, existe uma séria escassez de material de referência na língua portuguesa.

O pacote lexiconPT, que eu lancei em 20/09/2017 no Github (e em breve no CRAN também) nasceu para resolver parte desse problema. Até o momento, o lexiconPT possui três datasets de léxicos: o OpLexicon (versões 2.1 e 3.0) e o SentiLex-PT02. Não pretendo (nem tenho competência para tal, pois sou iniciante em Text Mining - sem falsa modéstia) destrinchar como cada um deles funciona e em quê eles diferem. Para isso, sugiro ler as referências citadas na documentação dos próprios datasets (ex.: help("oplexicon_v2.1")).

Mas ter o léxico em mãos só resolve parte dos problemas: ainda faltam os textos em si para serem analisados. Algumas ideias de datasets poderiam ser notícias, letras de músicas, livros (tem vários em Domínio Público), tweets, etc. Para demonstrar um simples uso do pacote, eu decidi por analisar comentários feitos por usuários na página do Sensacionalista, uma das mais populares do Facebook. A coleta dos dados foi relativamente fácil graças ao pacote Rfacebook.

Com o pacote lexiconPT, podemos responder a perguntas como:
* Os comentários no Sensacionalista são mais negativos ou positivos?
* Qual termo está mais associado a comentários negativos? PT ou PSDB? Temer ou Dilma? Bolsonaro ou Lula?
* Qual o comentário feito por um usuário mais negativo da história do Sensacionalista (dentro da amostra coletada)? E qual o mais positivo?

Vamos ao código.

Coleta dos dados

library(Rfacebook) # usado para extrair dados do facebook
library(tidyverse) # pq nao da pra viver sem
library(ggExtra)
library(magrittr) # <3
library(lubridate)
library(stringr) # essencial para trabalhar com textos
library(tidytext) # um dos melhores pacotes para text mining
library(lexiconPT)

Este post só foi possível graças ao Rfacebook. Para aprender como ele funciona, leia a documentação presente em seu repo no Github. Para este primeiro, primeiro usei a função getPage() para extrair as últimas 5000 publicações do Sensacionalista.

# token que eu gerei com minha API key.
# Essa parte vc obviamente nao vai conseguir reproduzir.
# leia o README do Rfacebook para saber como obter seu token
fb_token <- readRDS("/home/sillas/R/data/facebook_token.Rds") 

# demora cerca de 10 min pra rodar:
pg <- getPage("sensacionalista", fb_token, n = 5000)

É necessário corrigir o encoding do corpo da publicação para o R parar de reclamar sobre isso:

# corrigir encoding do texto do post
pg$message %<>% iconv(to = "ASCII//TRANSLIT")
# remover emojis
pg$message %<>% iconv(sub="", 'UTF-8', 'ASCII')
# visualizar dataframe
glimpse(pg)

## Observations: 4,666
## Variables: 11
## $ from_id        <chr> "108175739225302", "108175739225302", "10817573...
## $ from_name      <chr> "Sensacionalista", "Sensacionalista", "Sensacio...
## $ message        <chr> "Apos liminar da Justica do DF permitir o trata...
## $ created_time   <chr> "2017-09-18T18:58:53+0000", "2017-09-18T17:25:0...
## $ type           <chr> "link", "link", "link", "link", "video", "link"...
## $ link           <chr> "http://www.sensacionalista.com.br/2017/09/18/l...
## $ id             <chr> "108175739225302_1638598099516384", "1081757392...
## $ story          <chr> NA, NA, NA, NA, "Sensacionalista shared Gshow -...
## $ likes_count    <dbl> 10172, 2162, 2503, 5793, 4676, 2585, 821, 766, ...
## $ comments_count <dbl> 230, 164, 285, 221, 329, 104, 32, 58, 493, 586,...
## $ shares_count   <dbl> 2290, 453, 410, 2751, 0, 930, 26, 36, 900, 92, ...

Só esse dataset por si só já renderia (e renderá) análises interessantes, mas vou as deixar para um futuro post para não deixar este aqui grande demais.

A coluna id é a que usaremos como referência como input na função getPost() para extrair os comentários dos usuários na publicação. Infelizmente, a API do Facebook apresenta uma certa instabilidade para requests de dados muito grandes. Em várias tentativas que fiz, o máximo de dados que consegui extrair foram 200 comentários de 500 publicações da página. Portanto, vou usar esses parâmetros:

# roda em cerca de 8 minutos:
df_posts <- pg$id[1:500] %>% map(getPost, fb_token, n = 200, comments = TRUE, likes = FALSE,
                            reactions = FALSE)

A função getPost() fornece o seguinte output:

str(df_posts)

## List of 500
##  $ :List of 2
##   ..$ post    :'data.frame': 1 obs. of  10 variables:
##   .. ..$ from_id       : chr "108175739225302"
##   .. ..$ from_name     : chr "Sensacionalista"
##   .. ..$ message       : chr "Após liminar da Justiça do DF permitir o tratamento da homossexualidade como doença"
##   .. ..$ created_time  : chr "2017-09-18T18:58:53+0000"
##   .. ..$ type          : chr "link"
##   .. ..$ link          : chr "http://www.sensacionalista.com.br/2017/09/18/liminar-que-chancela-cura-gay-permite-tratar-justica-brasileira-como-doenca/"
##   .. ..$ id            : chr "108175739225302_1638598099516384"
##   .. ..$ likes_count   : num 11340
##   .. ..$ comments_count: num 248
##   .. ..$ shares_count  : num 2590
##   ..$ comments:'data.frame': 200 obs. of  7 variables:
##   .. ..$ from_id       : chr [1:200] "1437254732976789" "1445900342154501" "10209941046899919" "173469923210786" ...
##   .. ..$ from_name     : chr [1:200] "Sérgio Henrique Reis" "Renata Gil" "Lucas Ferreira" "Leonardo Wesley" ...
##   .. ..$ message       :

## Error in strtrim(encodeString(object, quote = "\"", na.encode = FALSE), : string multibyte inválida em '<a0><be>\xed<b4>\u0094  Ahh do Distrito Federal.... Quando Juscelino Kubitschek fundou Brasília, será que ele tinha a mínima ideia do que sairia de lá?"'

Para extrair os dataframes relativos aos comentários e aos metadados das publicações, o purrr é uma mão na roda:

df_comments <- df_posts %>% map_df("comments")
df_posts <- df_posts %>% map_df("post")
# repetir procedimento de consertar o encoding
df_comments$message %<>% iconv(to = "ASCII//TRANSLIT") %>% iconv(sub="", 'UTF-8', 'ASCII')
df_posts$message %<>% iconv(to = "ASCII//TRANSLIT") %>% iconv(sub="", 'UTF-8', 'ASCII')
# por questoes de anonimizacao, vou remover os dados pessoais referentes aos usuarios
df_comments %<>% select(-from_id, -from_name)

# olhar estrutura dos dataframes
str(df_comments)

## 'data.frame':    72100 obs. of  5 variables:
##  $ message       : chr  "Entao pode faltar no servico, ligar pro chefe(a), levar atestado e dizer que acordou com vontade de chupar rola?" "Nunca o sensacionalista foi tao verdadeiro. Pq a justica brasileira se demonstrou uma verdadeira praga na socie"| __truncated__ "O unico que precisa de tratamento e o sr juiz que autorizou." "Isso viola todas os acordos internacionais e uma aberracao contra qqr liberdade individual e humana. Logo essa liminar cai." ...
##  $ created_time  : chr  "2017-09-18T19:01:21+0000" "2017-09-18T19:03:57+0000" "2017-09-18T19:01:26+0000" "2017-09-18T19:00:54+0000" ...
##  $ likes_count   : num  575 392 270 227 310 145 113 73 38 50 ...
##  $ comments_count: num  58 5 4 3 12 16 10 0 0 8 ...
##  $ id            : chr  "1638598099516384_1638600206182840" "1638598099516384_1638602159515978" "1638598099516384_1638600266182834" "1638598099516384_1638599869516207" ...

str(df_posts)

## 'data.frame':    500 obs. of  10 variables:
##  $ from_id       : chr  "108175739225302" "108175739225302" "108175739225302" "108175739225302" ...
##  $ from_name     : chr  "Sensacionalista" "Sensacionalista" "Sensacionalista" "Sensacionalista" ...
##  $ message       : chr  "Apos liminar da Justica do DF permitir o tratamento da homossexualidade como doenca" "Ja recebeu encomendas de quarteis" "Aparelho esta sendo oferecido por importadores por ate 6 mil reais" "Temer desembarcou nos Estados Unidos para jantar com Trump e participacao na Assembleia Geral da ONU" ...
##  $ created_time  : chr  "2017-09-18T18:58:53+0000" "2017-09-18T17:25:00+0000" "2017-09-18T17:05:41+0000" "2017-09-18T17:00:02+0000" ...
##  $ type          : chr  "link" "link" "link" "link" ...
##  $ link          : chr  "http://www.sensacionalista.com.br/2017/09/18/liminar-que-chancela-cura-gay-permite-tratar-justica-brasileira-como-doenca/" "http://www.sensacionalista.com.br/2017/09/18/fabricante-de-pau-de-arara-comemora-falta-de-resposta-a-general-qu"| __truncated__ "http://www.sensacionalista.com.br/2017/09/18/empresa-lanca-servico-de-escolta-armada-para-quem-comprar-o-iphone-x/" "http://www.sensacionalista.com.br/2017/09/18/coreia-do-norte-nega-ter-lancado-temer-nos-eua/" ...
##  $ id            : chr  "108175739225302_1638598099516384" "108175739225302_1638510679525126" "108175739225302_1638503796192481" "108175739225302_1638456466197214" ...
##  $ likes_count   : num  11340 2271 2826 6361 4990 ...
##  $ comments_count: num  248 167 315 242 347 106 32 58 494 590 ...
##  $ shares_count  : num  2590 478 441 3008 0 ...

Só pode ser trollagem da API do Facebook retornar aquela mensagem logo no topo do dataframe, mas enfim.

O dataframe df_comments, o objeto da nossa análise, não possui alguns dados que serão valiosos para a análise, como o link para o artigo no site do Sensacionalista. Por isso, vamos um left_join com o df_posts.

Percebeu que nas colunas df_comments$id e df_posts$id existe um traço separando dois conjuntos numéricos? Por alguma razão que beira a imbecilidade, não é possível combinar imediatamente essas duas colunas para formatar um dataframe só com o left_join. A sintaxe de identificação do Facebook funciona assim: O post é identificado IDPAGINA_IDPUBLICAÇÃO e o comentário na publicação é identificado como IDPUBLICAÇÃO_IDCOMENTÁRIO. Ou seja, para poder juntar os dois dataframes, vamos ter que combinar a sequência númerica à esquerda do underline (acho que esse traço tem algum outro nome, mas não me lembro no momento) em df_comments$id e à direita em df_posts$id.

# consertar colunas de id: no df_comments, deixar à esquerda do underline. no df_posts, deixar à direita.
df_comments$id_post_real <- df_comments$id
df_comments$id %<>% str_replace_all("_.*", "")
df_posts$id %<>% str_replace_all(".*_", "")

# juntar as duas tabelas
df_posts %<>% dplyr::select(id, post_message = message, horario_post = created_time,
                     type, post_comments_count = comments_count, post_link = link,
                     post_type = type, post_likes_count = likes_count)
df_comments %<>% rename(horario_comentario = created_time)

df_comments %<>% left_join(df_posts, by = "id")
# remover NAs (nao sao muitos casos)
df_comments %<>% filter(!is.na(horario_post))
# converter colunas de horario
df_comments$horario_comentario %<>% str_sub(1, 19) %>% str_replace_all("T", "") %>% ymd_hms()
df_comments$horario_post %<>% str_sub(1, 19) %>% str_replace_all("T", "") %>% ymd_hms()
# Como ficou:
glimpse(df_comments)

## Observations: 71,891
## Variables: 12
## $ message             <chr> "Entao pode faltar no servico, ligar pro c...
## $ horario_comentario  <dttm> 2017-09-18 19:01:21, 2017-09-18 19:03:57,...
## $ likes_count         <dbl> 575, 392, 270, 227, 310, 145, 113, 73, 38,...
## $ comments_count      <dbl> 58, 5, 4, 3, 12, 16, 10, 0, 0, 8, 69, 3, 0...
## $ id                  <chr> "1638598099516384", "1638598099516384", "1...
## $ id_post_real        <chr> "1638598099516384_1638600206182840", "1638...
## $ post_message        <chr> "Apos liminar da Justica do DF permitir o ...
## $ horario_post        <dttm> 2017-09-18 18:58:53, 2017-09-18 18:58:53,...
## $ post_type           <chr> "link", "link", "link", "link", "link", "l...
## $ post_comments_count <dbl> 248, 248, 248, 248, 248, 248, 248, 248, 24...
## $ post_link           <chr> "http://www.sensacionalista.com.br/2017/09...
## $ post_likes_count    <dbl> 11340, 11340, 11340, 11340, 11340, 11340, ...

Uso do lexiconPT

Agora temos o dataset em mãos para usar o lexiconPT. Acho muito importante ressaltar que Text Mining é uma atividade razoavelmente complexa que envolve uma extensa etapa de limpeza e tratamento de dados, como remover (ou não) acentos e corrigir palavras com letras duplicadas (tristee) ou erros gramaticais (infelismente). Para fins de simplicidade, não vou me ater muito a esses detalhes e pular direto para a utilização dos léxicos portugueses e apresentação dos resultados.

# carregar datasets
data("oplexicon_v3.0")
data("sentiLex_lem_PT02")

op30 <- oplexicon_v3.0
sent <- sentiLex_lem_PT02

glimpse(op30)

## Observations: 32,191
## Variables: 4
## $ term              <chr> "=[", "=@", "=p", "=P", "=x", "=d", "=D", ";...
## $ type              <chr> "emot", "emot", "emot", "emot", "emot", "emo...
## $ polarity          <int> -1, -1, -1, -1, -1, 1, 1, 1, 1, -1, -1, -1, ...
## $ polarity_revision <chr> "A", "A", "A", "A", "A", "A", "A", "A", "A",...

glimpse(sent)

## Observations: 7,014
## Variables: 5
## $ term                    <chr> "a-vontade", "abafado", "abafante", "a...
## $ grammar_category        <chr> "N", "Adj", "Adj", "Adj", "Adj", "Adj"...
## $ polarity                <dbl> 1, -1, -1, -1, -1, 1, -1, 1, 1, -1, -1...
## $ polarity_target         <chr> "N0", "N0", "N0", "N0", "N0", "N0", "N...
## $ polarity_classification <chr> "MAN", "JALC", "MAN", "JALC", "JALC", ...

Ambos os datasets possuem colunas de polaridade de sentimento, que é a que usaremos para quantificar o quão negativo ou positivo é um comentário.

# criar ID unica para cada comentario
df_comments %<>% mutate(comment_id = row_number())
# usar funçao do tidytext para criar uma linha para cada palavra de um comentario
df_comments_unnested <- df_comments %>% unnest_tokens(term, message)

df_comments_unnested %>%
  select(comment_id, term) %>%
  head(20)

##      comment_id     term
## 1             1    entao
## 1.1           1     pode
## 1.2           1   faltar
## 1.3           1       no
## 1.4           1  servico
## 1.5           1    ligar
## 1.6           1      pro
## 1.7           1    chefe
## 1.8           1        a
## 1.9           1    levar
## 1.10          1 atestado
## 1.11          1        e
## 1.12          1    dizer
## 1.13          1      que
## 1.14          1  acordou
## 1.15          1      com
## 1.16          1  vontade
## 1.17          1       de
## 1.18          1   chupar
## 1.19          1     rola

De novo esse comentário…

Enfim, veja que foi criada uma linha para cada palavra presetnte no comentário. Será essa nova coluna term que usaremos como referência para quantificar o sentimento de um comentário.

df_comments_unnested %>% 
  left_join(op30, by = "term") %>% 
  left_join(sent %>% select(term, lex_polarity = polarity), by = "term") %>% 
  select(comment_id, term, polarity, lex_polarity) %>% 
  head(10)

##    comment_id    term polarity lex_polarity
## 1           1   entao       NA           NA
## 2           1    pode       NA           NA
## 3           1  faltar        1           NA
## 4           1      no       NA           NA
## 5           1 servico       NA           NA
## 6           1   ligar       -1           NA
## 7           1     pro       NA           NA
## 8           1   chefe       NA           NA
## 9           1       a       NA           NA
## 10          1   levar       -1           NA

A amostra acima mostra que nem toads as palavras possuem uma polaridade registrada nos léxicos. Não só isso, mas algumas palavras (como faltar, ligar e levar) estão presentes no OpLexicon mas não no SentiLex. A polaridade 1 em faltar significa que, de acordo com esse léxico, a palavra está associada a comentários positivos. Saber essa diferença é fundamental, pois a escolha do léxico pode ter uma grande influência nos resultados da análise.

Vamos então manter no dataframe apenas as palavras que possuem polaridade tanto no OpLexicon como no SentiLex:

df_comments_unnested <- df_comments_unnested %>% 
  inner_join(op30, by = "term") %>% 
  inner_join(sent %>% select(term, lex_polarity = polarity), by = "term") %>% 
  group_by(comment_id) %>% 
  summarise(
    comment_sentiment_op = sum(polarity),
    comment_sentiment_lex = sum(lex_polarity),
    n_words = n()
    ) %>% 
  ungroup() %>% 
  rowwise() %>% 
  mutate(
    most_neg = min(comment_sentiment_lex, comment_sentiment_op),
    most_pos = max(comment_sentiment_lex, comment_sentiment_op)
  )

head(df_comments_unnested)

## # A tibble: 6 x 6
##   comment_id comment_sentiment_op comment_sentiment_lex n_words most_neg
##        <int>                <int>                 <dbl>   <int>    <dbl>
## 1          2                    0                     0       2        0
## 2          7                   -2                    -3       3       -3
## 3          8                    1                     1       2        1
## 4          9                    0                     0       3        0
## 5         11                   -1                    -1       3       -1
## 6         12                   -3                    -3       3       -3
## # ... with 1 more variables: most_pos <dbl>

Apresentação dos resultados

O gráfico de pontos abaixo mostra a distribuição de polaridade para cada léxico:

df_comments_unnested %>% 
  ggplot(aes(x = comment_sentiment_op, y = comment_sentiment_lex)) +
    geom_point(aes(color = n_words)) + 
    scale_color_continuous(low = "green", high = "red") +
    labs(x = "Polaridade no OpLexicon", y = "Polaridade no SentiLex") +
    #geom_smooth(method = "lm") +
    geom_vline(xintercept = 0, linetype = "dashed") +
    geom_hline(yintercept = 0, linetype = "dashed")

Existem pelo menos três outliers nos dados, todos causados pela grande quantidade de palavras do comentário, o que pode ser um indício de que simplesmente somar a polaridade de cada palavra do comentário pode não ser um bom método. Outra informação revelada pelo gráfico é que existem palavras que possuem sentimentos diferentes de acordo com o léxico usado. Ter isso em mente é fundamental para a análise.

Após remover os outliers, já é possível descobrir quais os comentários mais positivos e mais negativos da amostra coletada:

df_comments_unnested %<>% filter(between(comment_sentiment_op, -10, 10))

# comentario mais positivo da historia do sensacionalista
most_pos <- which.max(df_comments_unnested$most_pos)
most_neg <- which.min(df_comments_unnested$most_neg)

# mais positivo
cat(df_comments$message[df_comments$comment_id == df_comments_unnested$comment_id[most_pos]])

## O mundo a esquerda e sempre melhor. A musica, o pincel, a pena e a talha. Sempre esteve para a esquerda. As grandes mentes criativas, os grandes pensadores, os humanistas, os geniais. Tudo que e original e belo e oriundo da esquerda.
## E tendencia natural do ser humano, ao passo q alcanca um minimo de consciencia critica do mundo sempre tender a esquerda.
## Todavia o mundo tambem precisa de mentes computacionais, a esse papel a direita tem seu valor. A direita funciona bem quando o objetivo e produzir o fisico, o tangivel e operacional. Embora isso tambem pudesse ser feito por maquinas, robos, ou mesmo por animais adestrados.
## A exemplo, os EUA, onde o cidadao comum e um ser vegetativo, destinado a operar, produzir e consumir. Sao seres incapazes de formular um pensamento critico e original. Uma nacao que por forca do capital tem seu vies ideologico voltado pra direita. Ainda q por vezes elejam um presidente com vies de esquerda, nunca irao evoluir sua consciencia. Sera sempre uma nacao de dementes e ignorantes.
## Nao por acaso que o capital, na sua forma economica ou politica sempre se poe sobre a direita quando tem por objetivo o ganho, financeiro ou de poder. E sobre a direita q se faz os movimentos de massa imbecilizada, pois como seres roboticos sao facilmente levados aonde se quer levar.
## A esquerda liga-se ao mundo das ideias, ao pensamento critico, a modelagem do ser humano como ser consciente. A esquerda e a construcao do pensamento, e o
## individuo pensante e critico, tudo que evolui e eleva o ser humano a um patamar de consciencia superior, provem da esquerda.
## Nacoes capitalistas, ainda q direitista, mas q sua massa possui em sua construcao um vies ideologico de esquerda serao sempre nacoes ricas financeiramente e ricas de estado de consciencia critica. Observa se isto em paises europeus, onde o
## capital existe por forca do consumo, mas coexiste com o estado de bem estar social, com a beleza das artes e com tudo aquilo e natural da esquerda, enquanto consciencia e beleza.
## A direita tem por tendencia natural, o simples, o computacional e robotizado. O argumento da direita e sempre algoritmo, linear e raso. A direita sera sempre um universo de seres ocos, massivos e imbecilizados.
## A.L.C.

# mais negativo
cat(df_comments$message[df_comments$comment_id == df_comments_unnested$comment_id[most_neg]])

## No ultimo domingo foi ao ar o programa do Silvio Santos, onde Maisa foi ridiculamente feita de idiota por duas pessoas na frente do Brasil todo. Onde mesmo ela pedindo pra parar, nao pararam. Mas eu to aqui apenas pra falar a verdade sobre uma dessas pessoas: DUDU CAMARGO. 
## Muitos o conhecem como o cara chato que apresenta o jornal da manha, mas eu o conheco como o EX ABUSIVO QUE FEZ COISAS IMPERDOAVEIS. 
## Tudo comecou quando nos conhecemos na escola, quando ele fez de tudo pra me conquistar, e eu era bobo. Cai. Comecamos a namorar e era tudo incrivel e flores, mesmo com o preconceito, era bom ter alguem com quem contar e gostar. 
## As coisas foram andando, e mesmo com todas as pessoas dizendo pra eu nao continuar esse relacionamento, eu continuei. Meus professores, meus amigos, e ate gente desconhecida tentaram abrir meus olhos. Mas ja era tarde. Eu estava apaixonado! Ia fazer de tudo pra ficar com ele!
## O terror comeca. 
## Estava tudo bem, ate ele comecar a ser agressivo e babaca. Gritava, ficava de cara feia, falava merda, e eu tambem, mas ele foi ao extremo. Ele estava vidrado em ser um astro da tv que esqueceu que tinha um relacionamento e comecou a me tratar como lixo, ate que ele me machucou feio, arranhou meu braco e deixou uma cicatriz em uma de nossas brigas. Nao sou santo, claro que tentei revidar para me defender. Mas apenas UMA vez.
## As brigas e abusos tornaram-se serios, ele cada dia era mais estourado, e nao so comigo, com todos, ate com a familia, que por sinal sempre o apoiou. Mas ele sempre queria ser mais que todos.
## Nao contente em 1, ele bateu 2, 3, 4... Varias vezes. Ja cheguei em casa com o rosto machucado e tive que mentir pra minha mae, mas ela nao era e nem e burra, sabia o que tinha acontecido. 
## Na escola, todos perguntavam e eu mentia, achando que estava tudo bem, mas nao estava. Eu estava tao apaixonado que nao conseguia sair daquele pesadelo.
## Outro ponto: ABUSO SEXUAL. Isso e bem serio, e se fosse brincadeira, eu nao estaria me expondo assim. Em um relacionamento voce consequentemente transa com a pessoa, e no comeco era bom, era normal. Mas depois das agressoes, eu fiquei tao em choque que inventava que estava doente para nao ter que fazer nada com ele. E ele reclamava, e bla bla bla, e dizia que sexo nao era nada, mas era. Ate que ele comecou a falar coisas horriveis para mim, comecou ficar tao frustrado que comecou a forcar coisas dizendo que se eu nao fizesse, era pra eu ir embora e nunca mais voltar, e que se eu voltasse, ele me trataria pior do que ja estava tratando. Mas eu fiquei, nao sei o porque, mas fiquei, com todo o medo e receio. 
## Toda vez que eu queria conversar com ele sobre algo, ele ia direto me mandando ficar quieto e me chamava pra fazer coisas... Quando ele nao estava no instagram ou implorando para alguma aparicao na tv. 
## Eu estava louco e assustado, a escola chamou minha mae pra conversar pois estavam com medo de que eu fizesse algo comigo mesmo, meu psicologico estava destruido e eu fiquei com depressao. 
## Algumas pessoas vao dizer que eu quem quis, ja que nao fui embora, mas nao e bem assim. 
## Nao tenho tudo registrado, - e acho que nem preciso - mas eu vivi, as pessoas viram e tentaram me ajudar, mas eu recusei, com medo. 
## Passei muitas coisas boas no comeco, mas depois eu vi o monstro que ele era/e. Ele pode se fazer de santo na tv, mas muita gente sabe quem ele realmente e. E eu sei o que eu sofri. 
## Vao dizer que e tudo mentira, e que eu quero fama. Talvez que sou louco, mas felizmente tenho testemunhas e nao tenho mais medo de me esconder. Depois de domingo, ele provou ser a pessoa mais falsa e artificial que existe. Engessado, segundo a Maisa. 
## Nao e porque ele e uma pessoa publica que pode fazer o que quer sem pagar. Sei das consequencias que posso ter, mas nada tira a paz que sinto sabendo que tenho pessoas incriveis que me apoiaram e apoiam ate hoje. 
## Espero que entendam e ajudem as pessoas que precisam. Se voce sabe alguem que esteja nessa vida, ajude-a a sair... Nao importa quem seja. Chega de abuso!

Por incrível que pareça, tanto o comentário mais positivo quanto o mais negativo falam sobre a esquerda.

Para prosseguir com a análise, usaremos o léxico OpLexicon para a análise de sentimento:

df_comments %<>% inner_join(
  df_comments_unnested %>% select(comment_id, sentiment = comment_sentiment_op),
  by = "comment_id"
  )
# criar coluna de data (variavel da classe Date)
df_comments$data <- as.Date(df_comments$horario_post)

Agora sim podemos demonstrar uma visualização de uma análise básica de sentimento: Como tem sido o sentimento geral dos comentários no Sensacionalista ao longo do tempo?

df_comments_wide <- df_comments %>% 
  # filtrar fora palavras neutras
  filter(sentiment != 0) %>% 
  # converter numerico para categorico
  mutate(sentiment = ifelse(sentiment < 0, "negativo", "positivo")) %>% 
  # agrupar os dados
  count(data, post_link, post_type, sentiment) %>% 
  # converter para formato wide
  spread(sentiment, n, fill = 0) %>% 
  mutate(sentimento = positivo - negativo) %>% 
  ungroup() %>% 
  arrange(data)

head(df_comments_wide) %>% knitr::kable()

data	post_link	post_type	negativo	positivo	sentimento
2017-04-13	https://www.facebook.com/sensacionalista/photos/a.187587037950838.39557.108175739225302/1460990897277106/?type=3	photo	7	17	10
2017-04-13	http://www.sensacionalista.com.br/2017/04/13/temer-lula-e-fhc-articulam-pacto-de-nao-rir-de-brasileiro-que-desfez-amizade-no-facebook-por-politica/	link	32	34	2
2017-04-14	https://www.facebook.com/sensacionalista/photos/a.187587037950838.39557.108175739225302/1462221330487396/?type=3	photo	42	22	-20
2017-04-15	https://www.facebook.com/sensacionalista/photos/a.187587037950838.39557.108175739225302/1463589740350555/?type=3	photo	7	27	20
2017-04-16	https://www.sensacionalista.com.br/2016/03/25/laja-jato-diz-que-lula-comprou-ovo-da-kopenhagen-em-nome-de-amigo/	link	23	35	12
2017-04-16	http://www.sensacionalista.com.br/2017/04/10/as-18-melhores-coisas-com-sentimentos-a-nova-obsessao-da-internet/	link	17	16	-1

Por exemplo, o primeiro link coletado na amostra, uma foto, teve 9 palavras contadas como negativas e 13 como positivas. O score geral dos comentários nessa publicação foi 13 - 9 = 4.

Qual a publicação do Sensacionalista com maior nível de “positividade”? E o de “negatividade”?

df_comments_wide %>% 
  arrange(sentimento) %>% 
  filter(row_number() == 1 | row_number() == nrow(df_comments_wide)) %>% 
   knitr::kable()

data	post_link	post_type	negativo	positivo	sentimento
2017-09-11	http://www.sensacionalista.com.br/2017/09/11/projeto-do-mbl-pretende-vestir-obras-de-arte-em-museus-ao-redor-do-mundo/	link	95	39	-56
2017-06-05	http://www.sensacionalista.com.br/2017/06/05/festa-se-nada-der-certo-em-colegio-debocha-de-garis-e-faxineiras-e-mostra-que-ja-deu-tudo-errado/	link	29	86	57

A publicação que mais recebeu comentários negativos (não tenho certeza se é essa a interpretação mais correta dos resultados, mas enfim) é um link sobre o MBL, enquanto o mais positivo é sobre o famoso caso do “E se der errado”.

O gráfico abaixo mostra a evolução do sentimento dos comentários nas publicações do Sensacionalista ao longo do tempo:

df_comments_wide %>% 
  mutate(index = row_number()) %>% 
  ggplot(aes(x = index, y = sentimento)) +
    geom_col(aes(fill = post_type)) +
    scale_y_continuous(breaks = seq(-60, 60, 20), limits = c(-60, 60)) +
    labs(x = "Índice da publicação", y = "Sentimento",
         fill = NULL, title = "Evolução do sentimento em publicações do Sensacionalista")

Uma possível interpretação do gráfico é que a série temporal não possui uma clara tendência, apesar de os picos de negatividade serem bem mais frequentes que os de positividade.

Outra análise que dá para fazer é investigar o nível de sentimento de comentários associados a determinadas palavras. Por exemplo, o quão negativo costuma ser um comentário quando ele menciona a palavra bolsonaro?

# qual o sentimento mais associado a palavras em especifico
df_comments %>% 
  mutate(
    temer = str_detect(str_to_lower(message), "temer"),
    lula = str_detect(str_to_lower(message), "lula"),
    pmdb = str_detect(str_to_lower(message), "pmdb"),
    psdb = str_detect(str_to_lower(message), "psdb"),
    pt = str_detect(str_to_lower(message), "pt"),
    dilma = str_detect(str_to_lower(message), "dilma"),
    doria = str_detect(str_to_lower(message), "doria"),
    governo = str_detect(str_to_lower(message), "governo"),
    bolsonaro = str_detect(str_to_lower(message), "bolsonaro")
  ) %>% 
  gather(termo, eh_presente, temer:bolsonaro) %>% 
  filter(eh_presente) %>% 
  group_by(termo) %>% 
  summarise(sentiment = mean(sentiment)) %>% 
  ggplot(aes(x = termo, y = sentiment)) + 
    geom_col(fill = "#C10534")

Temer e Dilma, os dois presidentes com os piores níveis de popularidade de República, estarem associados a comentários positivos é bem surpreendente. Na verdade, isso ocorre porque a própria palavra temer possui polaridade positiva. Para consultar a polaridade de uma palavra nos datasets presentes no lexiconPT, use a função lexiconPT::get_word_sentiment().

get_word_sentiment("temer")

## $oplexicon_v2.1
##        term type polarity
## 28711 temer   vb        1
## 
## $oplexicon_v3.0
##        term type polarity polarity_revision
## 30160 temer   vb        1                 A
## 
## $sentilex
##       term grammar_category polarity polarity_target
## 6546 temer                V       -1           N0:N1
##      polarity_classification
## 6546                     MAN

Conclusão e chamada para futuros trabalhos

O pacote lexiconPT, apesar de simples, tem um enorme potencial para enriquecer o conteúdo de Text Mining em Português na comunidade brasileira de R. O exemplo dado nesse post pode ser considerado deveras simplório. Muitas etapas foram puladas ou desconsideradas com o intuito de fornecer a você uma rápida introdução às possibilidades criadas pelo pacote. Espero que o leitor deste post tenha se sentido motivado a fazer suas próprias análises de sentimento. As possibilidade são incontáveis.

Referências

Text Mining with R - A Tidy Approach: Livro online gratuito sobre Text Mining feito pela autora do pacote tidytext;
Single Word Analysis of Early 19th Century Poetry Using tidytext;
Texto no R;
A Fixação de Colbert;
Mineração de Texto - Prof. Walmes M. Zeviani;
Pacote tidytext;
Text Mining of Stack Overflow Questions;
Women in film