Técnicas para análise de textos
Prof. Steven Dutt-Ross
Hoje vamos discutir agrupamento (cluster) de textos e Topic modeling com o pacote textmineR. Parte desse texto é uma tradução deste documento
PARTE 1
Agrupamento/Cluster de textos
Uma tarefa comum na mineração de texto é o agrupamento/cluster de documentos. Existem várias maneiras de agrupar documentos. O exemplo abaixo mostra o método usando o TF-IDF e a distância de cosseno.
Vamos carregar um banco dados e fazer uma matriz de termos de documento (document term matrix - DTM) e carregar o pacote para começar.
Tenho que admitir uma derrota aqui: o processamento acabou com a memória do meu computador. Por causa disso, vamos fazer a análise com apenas 150 textos do twitter sobre a Lei Aldir Blanc - LAB. Uma observação importante é que o cluster não funciona com NA nem com NaN. Por causa disso, vamos excluir os tweets sem texto e os pequenos demais (que agrega pouco valor aos modelos).
# semente para reproduzir as simulacoes
set.seed(12345)
# carregar a biblioteca
library(textmineR)
# carregar o banco de dados
banco_lab <- readRDS("C:/Users/Hp/Documents/GitHub/Lei_Aldir_Blanc/tweet/dados/banco_completo_lemma_27_02_2021.RDS")
#----------------------------------------------------------------
# criando uma identificacao unica (id) para cada tweet
#----------------------------------------------------------------
banco_lab$id <-1:dim(banco_lab)[1]
#----------------------------------------------------------------
# selecionando aleatoriamente 150 tweets do banco de dados
#----------------------------------------------------------------
library(dplyr)
banco_lab <- banco_lab %>% select(text,id)%>% sample_n(150)
#----------------------------------------------------------------
# eliminando os tweet pequenos demais
#----------------------------------------------------------------
banco_lab<- banco_lab %>% filter(nchar(text)>10)
dim(banco_lab)[1] 146 2#----------------------------------------------------------------
# criando o document term matrix
#----------------------------------------------------------------
dtm <- CreateDtm(doc_vec = banco_lab$text, # character vector of documents
doc_names = banco_lab$status_id, # document names
ngram_window = c(1, 2), # minimum and maximum n-gram length
stopword_vec = c(stopwords::stopwords("pt"), # stopwords from tm
stopwords::stopwords(source = "smart")), # this is the default value
lower = TRUE, # lowercase - this is the default value
remove_punctuation = TRUE, # punctuation - this is the default
remove_numbers = TRUE, # numbers - this is the default
verbose = FALSE, # Turn off status bar for this demo
cpus = 2) # default is all available cpus on the system
# construct the matrix of term counts to get the IDF vector
tf_lab <- TermDocFreq(dtm)
kable(head(tf_lab))| term | term_freq | doc_freq | idf |
|---|---|---|---|
| aberta_lei | 1 | 1 | 4.983607 |
| aberta_passagens | 1 | 1 | 4.983607 |
| aberta_publico | 1 | 1 | 4.983607 |
| abertura | 1 | 1 | 4.983607 |
| abertura_xi | 1 | 1 | 4.983607 |
| abra | 1 | 1 | 4.983607 |
TF-IDF
Primeiro, devemos pensar na contagem de palavras na matriz de termos do documento (document term matrix - DTM). Fazemos isso multiplicando a frequência do termo/palavra por um vetor de frequência inversa do documento (IDF). O resultado é um índice chamado TF-IDF. A fórmula para calcular IDF (segundo componente do TF-IDF) para o i-ésima palavra como
\[\begin{align} IDF_i = ln\big(\frac{N}{\sum_{j = 1}^N C(word_i, doc_j)}\big) \end{align}\]
onde N
é o número de documentos no corpus/twetter.
O TF-IDF (term frequency–inverse document frequency) é uma medida estatística que tem o intuito de indicar a importância de uma palavra de um documento/tweet em relação a uma coleção de documentos. Escrito de outra forma, temos?
\[\begin{equation*} TF(t) = \frac{nº\ de\ vezes\ que\ t\ aparece\ no\ texto}{total\ de\ termos\ no\ texto} \end{equation*}\] \[\begin{equation*} IDF(i) = log_e(\frac{quantidade\ total\ de\ textos}{numero\ de\ textos\ em\ que\ i\ aparece}) \end{equation*}\]
Este método se resume a contar a frequência de uso de palavras e realizar um cálculo que gere uma estimativa de uso/importância da palavra no texto.
Todavia, quando você multiplica uma matriz por um vetor, devemos multiplica o vetor para cada coluna da matriz. Por esse motivo, precisamos da matriz transposta do DTM antes de multiplicar o vetor IDF. Em seguida, fazemos a transposta de volta para a orientação original.
# TF-IDF
tfidf <- t(dtm[ , tf_lab$term ]) * tf_lab$idf
tfidf <- t(tfidf)O próximo passo é calcular a similaridade por cosseno e alterá-la para uma distância. A similaridade por cosseno é uma medida da similaridade entre dois vetores num espaço vetorial que avalia o valor do cosseno do ângulo compreendido entre eles.
Similaridade por cosseno
O algoritmo de similaridade por cosseno foi o que utilizei para comparar duas frases. Ele compara as palavras de 2 textos, ignorando a ordem, e cria um vetor com as palavras mais repetidas. Depois devemos aplicar a fórmula. Por exemplo:
- O projeto foi aprovado na Lei Aldir_Blanc (estou tratando Aldir_Blanc como uma palavra)
- O projeto foi aprovado na Lei Rouanet
Quebramos em palavras, então teremos o seguinte vetor:
palavras <- c("o", "projeto,", "foi", "aprovado", "na", "lei", "Aldir_Blanc", "Rouanet")Agora vamos contar quantas palavras do vetor tem em cada frase
exemplo <- data.frame(palavras =c("o", "projeto,", "foi", "aprovado", "na", "lei", "Aldir_Blanc", "Rouanet"),
vetor1 = c(1,1,1,1,1,1,1,0),
vetor2 = c(1,1,1,1,1,1,0,1))
kable(exemplo)| palavras | vetor1 | vetor2 |
|---|---|---|
| o | 1 | 1 |
| projeto, | 1 | 1 |
| foi | 1 | 1 |
| aprovado | 1 | 1 |
| na | 1 | 1 |
| lei | 1 | 1 |
| Aldir_Blanc | 1 | 0 |
| Rouanet | 0 | 1 |
Agora é só aplicar a fórmula nesses dois vetores binários:
\[\begin{equation*} similaridade\_cosseno = \frac{\sqrt{\sum{vetor1 * vetor2}}}{\sqrt{\sum{vetor1^2}} * \sqrt{\sum{vetor2^2}}} \end{equation*}\]
Nesse exemplo, temos 6/7 = 0,85 de similaridade por cosseno entre os dois textos.
A ideia de similaridade de cossenos é parecida com a distância euclidiana. O motivo de preferirmos usar a similaridade de cossenos no lugar da distância euclidiana é que ele funciona melhor para textos (em textos, os ângulos ficam mais bem preservados que as distâncias).
Como estamos trabalhando com um banco de dados de texto, vamos usar a álgebra linear para fazer isso. O produto escalar de dois vetores de comprimento unitário de valor positivo é a similaridade do cosseno entre os dois vetores.
# similaridade por cosseno
csim <- tfidf / sqrt(rowSums(tfidf * tfidf))
# %*% is matrix multiplication
csim <- csim %*% t(csim)Para fazer cluster, precisamos de distâncias, não de semelhanças. Por esse motivo, convertemos a similaridade do cosseno em distância do cosseno subtraindo o valor de 1. Isso funciona porque a similaridade do cosseno é limitada entre 0 e 1. assim, converteremos a matriz em um objeto dist para fazer o cluster.
cdist <- as.dist(1 - csim)A última etapa é o agrupamento/cluster. Existem muitos algoritmos de agrupamento. Se quiser, dá uma olhada no meu texto sobre os tipos de clusters
Aqui vamos utilizar o agrupamento hierárquico aglomerativo usando o método de Ward como regra. Comparado com os outros métodos, o agrupamento hierárquico não exige muito computacionalmente.
No exemplo abaixo, escolho cortar a árvore em 10 clusters. Esta é uma escolha um tanto arbitrária. Muitas vezes prefiro usar o coeficiente de silhueta. Você pode ler sobre este método aqui.
hc <- hclust(cdist, method="ward.D")
clustering <- cutree(hc, 8)
plot(hc, main = "agrupamento hierárquico dos 150 tweers da LAB",
ylab = "", xlab = "", yaxt = "n")
rect.hclust(hc, 8, border = "red")
Devemos ter uma ideia do que está em cada um desses clusters. assim,
p_words <- colSums(dtm) / sum(dtm)
cluster_words <- lapply(unique(clustering), function(x){
rows <- dtm[ clustering == x , ]
# for memory's sake, drop all words that don't appear in the cluster
rows <- rows[ , colSums(rows) > 0 ]
colSums(rows) / sum(rows) - p_words[ colnames(rows) ]
})O código abaixo cria uma tabela de resumo de cada um dos clusters. O tamanho de cada cluster e as 5 palavras principais estão representadas.
# create a summary table of the top 5 words defining each cluster
cluster_summary <- data.frame(cluster = unique(clustering),
size = as.numeric(table(clustering)),
top_words = sapply(cluster_words, function(d){
paste(
names(d)[ order(d, decreasing = TRUE) ][ 1:5 ],
collapse = ", ")
}),
stringsAsFactors = FALSE)
kable(cluster_summary)| cluster | size | top_words |
|---|---|---|
| 1 | 120 | nao, dia, voce, youtube, pandemia |
| 2 | 6 | prestacao, prestacao_contas, contas, prazo_prestacao, prazo |
| 3 | 2 | adotara, adotara_cotas, aplicacao, aplicacao_lei, cotas |
| 4 | 2 | lei, lei_aldir, blanc_gravatai, blanc_saberesefazerescultura, contemplado_financiado |
| 5 | 6 | cultura, auxilio, auxilio_emergencial, crispinianoneto, emergencial |
| 6 | 6 | edital, inscricoes, aldir_blanc, aldir, blanc |
| 7 | 2 | aldir_blanc, aldir, blanc, blanc_derrubaovetopl, derrubaovetopl |
| 8 | 2 | nesta, terca, terca_feira, feira, blanc_junte |
Aqui poderiamos colocar um rótulo para cada grupo.
Grupo 1 - pandemia
Grupo 2 - prestação de contas
Grupo 3 - aplicação da lei
Grupo 4 - nome generico (geral demais de classificar)
Grupo 5 - auxilio emergencial
Grupo 6 - edital LAB
Grupo 7 - derruba o veto da LAB Grupo 8 - chamada para eventos LAB
(nessa terca feira)
Podemos cria uma nuvem de palavras para visualizar cada cluster.
# plot a word cloud of one cluster as an example
wordcloud::wordcloud(words = names(cluster_words[[ 5 ]]),
freq = cluster_words[[ 5 ]],
max.words = 50,
random.order = FALSE,
colors = c("red", "yellow", "blue"),
main = "100 palavras mais utilizadas (Top words)")
PARTE 2
Topic modeling/Modelagem de tópicos
Nessa parte vamos fazer a modelagem de tópicos via alocação de dirichlet latente (Latent Dirichlet Allocation-LDA). No processamento de linguagem natural, a alocação latente de Dirichlet (LDA) é um modelo estatístico. Ele permite que conjuntos de observações sejam explicados por variáveis latentes que explicam por que algumas partes dos dados são semelhantes.
dtm <- dtm[,colSums(dtm) > 2]Desenvolvendo o LDA com o amostrador de Gibbs
Para fazer um modelo LDA, vamos usar a função FitLdaModel. A entrada é uma matriz document term matrix - DTM. O textmineR implementa 2 métodos para LDA, amostrador de Gibbs (Gibbs sampling) e EM variacionais (variational expectation maximization também conhecidos como variational Bayes). O padrão/default é o amostrador de Gibbs.
# Fit a Latent Dirichlet Allocation model
# note the number of topics is arbitrary here
model <- FitLdaModel(dtm = dtm,
k = 10,
iterations = 500, # I usually recommend at least 500 iterations or more
burnin = 180,
alpha = 0.1,
beta = 0.05,
optimize_alpha = TRUE,
calc_likelihood = TRUE,
calc_coherence = TRUE,
calc_r2 = TRUE,
cpus = 2) O output desse modelo é um objeto do R de classe lda_topic_model. Contém vários objetos. Os mais importantes são as três matrizes:
theta dá \(P(topic_k|document_d)\),
phi dá \(P(token_v|topic_k)\), e
gama dá \(P(topic_k|token_v)\).
As outras informações são:
1- o DTM usado para treinar o modelo. 2 - alfa e beta são as priores de
Dirichlet para tópicos sobre documentos e tokens sobre os tópicos (alpha
and beta are the Dirichlet priors for topics over documents and tokens
over topics, respectively).
3 - O log_likelihood é \(P(tokens|tópicos)\) em cada iteração. 4 -
coherence dá a coerência probabilística de
cada tópico. 5- r2 é o R-quadrado do modelo dado a informação do banco
de dados.
str(model)List of 9
$ phi : num [1:10, 1:135] 0.000142 0.001047 0.000678 0.002466 0.000784 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:10] "t_1" "t_2" "t_3" "t_4" ...
.. ..$ : chr [1:135] "aberta" "ai" "apenas" "apoio_lei" ...
$ theta : num [1:146, 1:10] 0.11 0.122 0.175 0.586 0.42 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:146] "1" "2" "3" "4" ...
.. ..$ : chr [1:10] "t_1" "t_2" "t_3" "t_4" ...
$ gamma : num [1:10, 1:135] 0.03 0.0414 0.038 0.6389 0.0284 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:10] "t_1" "t_2" "t_3" "t_4" ...
.. ..$ : chr [1:135] "aberta" "ai" "apenas" "apoio_lei" ...
$ data :Formal class 'dgCMatrix' [package "Matrix"] with 6 slots
.. ..@ i : int [1:1256] 28 36 38 3 52 92 44 108 114 30 ...
.. ..@ p : int [1:136] 0 3 6 9 12 15 18 20 23 26 ...
.. ..@ Dim : int [1:2] 146 135
.. ..@ Dimnames:List of 2
.. .. ..$ : chr [1:146] "1" "2" "3" "4" ...
.. .. ..$ : chr [1:135] "aberta" "ai" "apenas" "apoio_lei" ...
.. ..@ x : num [1:1256] 1 1 1 1 1 1 1 1 1 1 ...
.. ..@ factors : list()
$ alpha : Named num [1:10] 0.3565 0.0554 0.0686 0.2768 0.0303 ...
..- attr(*, "names")= chr [1:10] "t_1" "t_2" "t_3" "t_4" ...
$ beta : Named num [1:135] 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 0.05 ...
..- attr(*, "names")= chr [1:135] "aberta" "ai" "apenas" "apoio_lei" ...
$ log_likelihood:'data.frame': 50 obs. of 2 variables:
..$ iteration : num [1:50] 0 10 20 30 40 50 60 70 80 90 ...
..$ log_likelihood: num [1:50] -6754 -6345 -6236 -6211 -6200 ...
$ coherence : Named num [1:10] 0.0397 0.1955 0.2203 0.0397 0.0127 ...
..- attr(*, "names")= chr [1:10] "t_1" "t_2" "t_3" "t_4" ...
$ r2 : num 0.266
- attr(*, "class")= chr "lda_topic_model"Uma vez que criamos um modelo, precisamos avaliá-lo. Para a qualidade do ajuste, o textmineR tem R2. O R2 é interpretável como a proporção de variabilidade nos dados explicados pelo modelo, exatamente igual a regressão linear.
# R-squared
model$r2[1] 0.2660877# log Likelihood (does not consider the prior)
plot(model$log_likelihood, type = "l")
Vamos ver a coerência(coherence) depois de criar mais alguns objetos no R. Para isso vamos:
- Retirar os 5 melhores termos para cada tópico,
- Calcular os tópicos mais frequentes (prevalentes) no corpus,
- Obter alguns rótulos de tópicos bi-grama de um algoritmo de rotulagem ingênuo (Esses rótulos ingênuos são baseados em \(P(bi-grama|tópico)−P(bi-grama)\).
Em seguida, vamos juntá-los em uma tabela que resume o topic model.
# Get the top terms of each topic
model$top_terms <- GetTopTerms(phi = model$phi, M = 5)
head(t(model$top_terms)) [,1] [,2] [,3] [,4] [,5]
t_1 "aldir" "aldir_blanc" "blanc" "lei" "lei_aldir"
t_2 "recursos" "recursos_lei" "governo" "parana" "pandemia"
t_3 "cultura" "auxilio" "setor" "cultura_lei" "setor_cultura"
t_4 "aldir" "blanc" "aldir_blanc" "lei" "lei_aldir"
t_5 "voce" "aldir_blanc" "aldir" "blanc" "lei"
t_6 "cultura" "secretaria" "projeto" "estado" "secretaria_cultura"# Get the prevalence of each topic
# You can make this discrete by applying a threshold, say 0.05, for
# topics in/out of docuemnts.
model$prevalence <- colSums(model$theta) / sum(model$theta) * 100
# prevalence should be proportional to alpha
plot(model$prevalence, model$alpha, xlab = "prevalence", ylab = "alpha")
# textmineR has a naive topic labeling tool based on probable bigrams
model$labels <- LabelTopics(assignments = model$theta > 0.05,
dtm = dtm,
M = 1)
head(model$labels) label_1
t_1 "lei_aldir"
t_2 "recursos_lei"
t_3 "cultura_lei"
t_4 "lei_aldir"
t_5 "lei_aldir"
t_6 "secretaria_cultura"# put them together, with coherence into a summary table
model$summary <- data.frame(topic = rownames(model$phi),
label = model$labels,
coherence = round(model$coherence, 3),
prevalence = round(model$prevalence,3),
top_terms = apply(model$top_terms, 2, function(x){
paste(x, collapse = ", ")
}),
stringsAsFactors = FALSE)
model$summary[ order(model$summary$prevalence, decreasing = TRUE) , ][ 1:10 , ] topic label_1 coherence prevalence
t_4 t_4 lei_aldir 0.040 35.590
t_1 t_1 lei_aldir 0.040 30.458
t_3 t_3 cultura_lei 0.220 5.697
t_9 t_9 derrubavetolei_aldir 0.332 4.640
t_5 t_5 lei_aldir 0.013 4.410
t_6 t_6 secretaria_cultura 0.167 4.296
t_2 t_2 recursos_lei 0.196 4.151
t_7 t_7 canal_youtube 0.265 3.995
t_10 t_10 prestacao_contas 0.519 3.706
t_8 t_8 paulo_gustavo 0.507 3.057
top_terms
t_4 aldir, blanc, aldir_blanc, lei, lei_aldir
t_1 aldir, aldir_blanc, blanc, lei, lei_aldir
t_3 cultura, auxilio, setor, cultura_lei, setor_cultura
t_9 feira, nesta, pl, prorroga, derrubavetolei
t_5 voce, aldir_blanc, aldir, blanc, lei
t_6 cultura, secretaria, projeto, estado, secretaria_cultura
t_2 recursos, recursos_lei, governo, parana, pandemia
t_7 sempre, youtube, canal, canal_youtube, pessoas
t_10 contas, prestacao, prestacao_contas, prazo, contemplados
t_8 brasil, gustavo, paulo, paulo_gustavo, rouanetOk, construimos o topic model. Também decidimos o quão bem ele se encaixa nos dados. Examinamos a coerência, as principais palavras (top word), e assim por diante. Agora vamos obter distribuições de tópicos para novos documentos. (Lembre-se, só usamos 150 de nossos 5.000 documentos para treinar o modelo).
A abordagem bayesiana é usando o amostrador de Gibbs. A maneira é usar o objeto gama devolvido quando executamos FitLdaModel. Para calcular isso, precisamos do teorema de Bayes.
As linhas de phi ou Φ são P(token|tópico). No entanto, para obter previsões para novos documentos, precisamos de P(tópico|token). Lembrando o teorema de Bayes, nós temos
\[\begin{align} P(\text{topic}|\text{token}) &= \frac{P(\text{token}|\text{topic})P(\text{topic})}{P(\text{token})} \end{align}\]
Lembrando da aula de probabilidade, podemos substituir \(P(topic)\) por meio de
\[\begin{align} \sum_j P(\text{topic}|\text{document}_j)P(\text{document}_j) \end{align}\]
Uma vez que você tenha , um produto simples dele com o DTM de novos documentos(A) criará as novas previsões de tópicos.
\[\begin{align} \Theta_{new} &= A \cdot \Gamma^T \end{align}\]
Ambos os métodos estão disponíveis através de predict.lda_topic_model com o argumento do método (“ponto” ou “gibbs”). Que método você deve usar? Na maioria dos casos, eu recomendaria “gibbs”. No entanto, “ponto” é mais rápido. Além disso, gama pode ser examinada juntamente com phi para análise de corpus.
# predictions with gibbs
assignments <- predict(model, dtm,
method = "gibbs",
iterations = 200,
burnin = 180,
cpus = 2)
# predictions with dot
assignments_dot <- predict(model, dtm,
method = "dot")
# compare
barplot(rbind(assignments[10,], assignments_dot[10,]),
col = c("red", "blue"), las = 2, beside = TRUE)
legend("topright", legend = c("gibbs", "dot"), col = c("red", "blue"),
fill = c("red", "blue"))
Maravilha. fico por aqui. Abraços