Processando N-gramas

rll307 / / R, script

Neste caderno discutiremos algumas metodologias de análise de n-gramas. No caso, bigramas.

Ele foi produzido de forma a auxiliar colegas que atuam na área de Linguística do Corpus e Linguística Sistêmico Funcional, como forma de utilizar R em suas pesquisas. Ele é parte do meu projeto financiado pelo CNPq e busca tornar ferramentas de corpus e análise de redes acessíveis.

É baseado no livro:

Silge, Julia, and David Robinson. 2017. Text Mining with R: A Tidy Approach. First edition. Beijing/Boston: O’Reilly.

Algumas modificações foram feitas de forma a:

  1. Possibilitar o uso de ferramentas em português
  2. Facilitar a navegação pelo público a que se destina.

Este documento é baseado no uso do pacote tidyr. Em outra ocasião, este mesmo processo de pesquisa será realizado com outro pacote e código.

Por favor, me mande um email, caso precisar de ajuda ou para algum contato de pesquisa. O Script com a função final se encontra no rodapé desta página.

Analisando Bigramas

Neste caderno criaremos uma análise de bigramas a partir de textos em Língua Portuguesa, estudando textos de Eça de Queiros e Camões, dois autores que particularmente gosto.

Pacotes do R

Para realizarmos este exercício percisaremos do seguintes pacotes, aqui já executados para que se possam ver suas mensagens:

library(tidytext)
library(janeaustenr)
library(tidyr)
library(ggplot2)
library(gutenbergr)
library(readr)
library(ggraph)
library(stringr)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(igraph)
## 
## Attaching package: 'igraph'
## The following objects are masked from 'package:dplyr':
## 
##     as_data_frame, groups, union
## The following object is masked from 'package:tidyr':
## 
##     crossing
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union

Cada pacote tem um função, mas cabe notar:

  • library(tidytext): Manipulação do texto
  • library(tidyr): Manipulação do texto
  • library(ggplot2): Visualização dos gráficos
  • library(gutenbergr): Baixar dados do projeto Gutemberg
  • library(readr): Importar daods textuais
  • library(ggraph): Visualização dos gráficos
  • library(stringr): Manipulação de texto
  • library(dplyr): Manipulação de texto
  • library(igraph): Visualização dos gráficos

Importanto os textos e linpando-os:

Os textos serão importados do Projeto Gutemberg, usando-se o comando a seguir. Os números no comando são os números de cada livro. É possível encontrá-los nos meta dados dos livros desejados no site do projeto Projeto Gutemberg. Os livros estão sendo organizados pelo seu título, único metadado que baixei dos arquivos. Os dados serão salvos dentro do objeto eca.bruto.

eca.bruto <- gutenberg_download(c(40409, 31971, 17515, 42942,16384, 23145),
                                meta_fields = "title")
## Determining mirror for Project Gutenberg from http://www.gutenberg.org/robot/harvest
## Using mirror http://aleph.gutenberg.org

Feito isso, é necessário ajustar os padrões de caracteres de cada texto. Isso por causa dos acentos em nossa língua. O comando a seguir transforma-os em UFT-8, funcinais para português. Note que os dados foram salvos em um novo objeto, o eca.books.

eca.livros <- eca.bruto %>% 
  mutate(text=iconv(text, from = "latin1", to = "UTF-8"))

Criando os bigramas

O comando a seguir, criará os bigramas. Note que eles estarão brutos, sem contagens ou manipulações. Por questões de estilo, eu sempre crio objetos novos e preservo os antigos.

eca.livros.bigramas.bruto <- eca.livros %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2)
eca.livros
## # A tibble: 89,383 x 3
##    gutenberg_id text                   title     
##           <int> <chr>                  <chr>     
##  1        16384 EÇA DE QUEIROZ         O Mandarim
##  2        16384 ""                     O Mandarim
##  3        16384 ""                     O Mandarim
##  4        16384 O MANDARIM             O Mandarim
##  5        16384 ""                     O Mandarim
##  6        16384 ""                     O Mandarim
##  7        16384 ""                     O Mandarim
##  8        16384 LIVRARIA INTERNACIONAL O Mandarim
##  9        16384 ""                     O Mandarim
## 10        16384 DE                     O Mandarim
## # … with 89,373 more rows

Feito isso, é ora de contar os bigramas. Vamos criar um novo objeto, agora contando (count()) cada um dos bigramas e organizando-os pela ordem de frequência (sort = TRUE).

eca.livros.bigramas.bruto.contagem <- eca.livros.bigramas.bruto  %>%
  count(bigram, sort = TRUE)
eca.livros.bigramas.bruto.contagem
## # A tibble: 332,707 x 2
##    bigram     n
##    <chr>  <int>
##  1 com o   1454
##  2 o seu   1392
##  3 a sua   1320
##  4 com a   1280
##  5 que o   1228
##  6 com um  1143
##  7 e o     1101
##  8 para o  1031
##  9 e a     1000
## 10 que se   938
## # … with 332,697 more rows

Agora vamos separar estes bigramas em duas colunas de palavras. Essa separação nos permitirá algumas coisas:

  • Observar as palavras individualmente, algo importante para percepção dos textos.
  • Limpar os textos com uma lista de stopwords, ou palavras que não desejamos neste estudo.

No comando abaixo, separamos os bigramas usando separate(), que qbebrará o texto em 2 colunas (word1, word2), separadas por espaço.

bigramas.separados.eca <- eca.livros.bigramas.bruto %>%
  separate(bigram, c("word1", "word2"), sep = " ")
bigramas.separados.eca 
## # A tibble: 692,159 x 4
##    gutenberg_id title      word1         word2        
##           <int> <chr>      <chr>         <chr>        
##  1        16384 O Mandarim eça           de           
##  2        16384 O Mandarim de            queiroz      
##  3        16384 O Mandarim queiroz       o            
##  4        16384 O Mandarim o             mandarim     
##  5        16384 O Mandarim mandarim      livraria     
##  6        16384 O Mandarim livraria      internacional
##  7        16384 O Mandarim internacional de           
##  8        16384 O Mandarim de            ernesto      
##  9        16384 O Mandarim ernesto       chardron     
## 10        16384 O Mandarim chardron      editor       
## # … with 692,149 more rows

Agora vamos importar a lista de stopwords. Venho criando uma lista há tempos, a medida que preciso limpar meus textos.É bom criar uma sua, atendendo a suas necessidades. No comando de criação, estou importanto uma lsita csv.

minhas.stopwords <- read_csv("stop_port2.csv")
## Parsed with column specification:
## cols(
##   word = col_character()
## )

Agora finalmente vamos filtrar as palavras que não desejo neste estudo:

eca.filtrado <- bigramas.separados.eca %>%
  filter(!word1 %in% minhas.stopwords$word) %>%
  filter(!word2 %in% minhas.stopwords$word)
eca.filtrado
## # A tibble: 130,092 x 4
##    gutenberg_id title      word1     word2        
##           <int> <chr>      <chr>     <chr>        
##  1        16384 O Mandarim mandarim  livraria     
##  2        16384 O Mandarim livraria  internacional
##  3        16384 O Mandarim ernesto   chardron     
##  4        16384 O Mandarim chardron  editor       
##  5        16384 O Mandarim editor    porto        
##  6        16384 O Mandarim braga     1880         
##  7        16384 O Mandarim mandarim  prologo      
##  8        16384 O Mandarim amigo     _bebendo     
##  9        16384 O Mandarim _bebendo  cognac       
## 10        16384 O Mandarim d'arvores n'um         
## # … with 130,082 more rows

Agora vamos contar os filtrados, para ver a difereça, usando o mesmo comando acima, apenas mudando o nome dos objetos

filtrados.contados.eca <- eca.filtrado %>%
  count(word1, word2, sort = TRUE)

Agora vamos unir estes bigramas para análise:

eca.filtrado.unido <- eca.filtrado %>%
  unite(bigram, word1, word2, sep = " ")
eca.filtrado.unido
## # A tibble: 130,092 x 3
##    gutenberg_id title      bigram                
##           <int> <chr>      <chr>                 
##  1        16384 O Mandarim mandarim livraria     
##  2        16384 O Mandarim livraria internacional
##  3        16384 O Mandarim ernesto chardron      
##  4        16384 O Mandarim chardron editor       
##  5        16384 O Mandarim editor porto          
##  6        16384 O Mandarim braga 1880            
##  7        16384 O Mandarim mandarim prologo      
##  8        16384 O Mandarim amigo _bebendo        
##  9        16384 O Mandarim _bebendo cognac       
## 10        16384 O Mandarim d'arvores n'um        
## # … with 130,082 more rows

Contando frequências relativas

Agora vamos contar e visializar as frequências relativas de nosss livros. Primeiramente, colocamos a frquencia relativa em uma coluna:

eca_tf_idf <- eca.filtrado.unido %>%
  count(title, bigram) %>%
  bind_tf_idf(bigram, title, n) %>%
  arrange(desc(tf_idf))
eca_tf_idf
## # A tibble: 112,646 x 6
##    title                            bigram          n      tf   idf  tf_idf
##    <chr>                            <chr>       <int>   <dbl> <dbl>   <dbl>
##  1 O crime do padre Amaro, scenas … joão eduar…   269 0.0106   1.79 0.0191 
##  2 O Mandarim                       chin fú        41 0.00946  1.79 0.0169 
##  3 O Mandarim                       ti chin        41 0.00946  1.79 0.0169 
##  4 O crime do padre Amaro, scenas … senhor par…   216 0.00855  1.79 0.0153 
##  5 "O Primo Bazilio\nEpisodio Dome… d felicida…   184 0.00797  1.79 0.0143 
##  6 O Mandarim                       sá tó          26 0.00600  1.79 0.0107 
##  7 A Illustre Casa de Ramires       villa clara    91 0.00437  1.79 0.00784
##  8 A Illustre Casa de Ramires       santa iren…    88 0.00423  1.79 0.00758
##  9 O Mandarim                       tien hó        15 0.00346  1.79 0.00620
## 10 O crime do padre Amaro, scenas … d josepha     139 0.00550  1.10 0.00604
## # … with 112,636 more rows

Agora vamos criar um gráfico, com o número máximo de 10 bigramas mais frequentes:

eca_tf_idf  %>%
  arrange(desc(tf_idf)) %>%
  mutate(bigram = factor(bigram, levels = rev(unique(bigram)))) %>%
  group_by(title) %>%
  top_n(10) %>%
  ungroup %>%
  ggplot(aes(bigram, tf_idf, fill = title)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~title, ncol = 2, scales = "free") +
  coord_flip()
## Selecting by tf_idf

Relações entre bigramas

Nosso próximo passo será criar um gráfico com os bigramas mais frequentes. Para tal, primeiramente limitaremos às relações que ocorram, ao menos, 15 vezes.

grafico.eca <- filtrados.contados.eca %>%
  filter(n > 15) %>%
  graph_from_data_frame()

Agora vamos plotar o gráfico de rede.

set.seed(2)
ggraph(grafico.eca, layout = "fr") +
  geom_edge_link() +
  geom_node_point() +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1)

Agora vamos fazer esse gráfico um pouco mais bonito:

set.seed(2009)
a <- grid::arrow(type = "open", length = unit(.1, "inches"))
ggraph(grafico.eca, layout = "fr") +
  geom_edge_link(aes(edge_alpha = n), show.legend = TRUE,
                 arrow = a, end_cap = circle(.02, 'inches')) +
  geom_node_point(color = "lightgreen", size = 3) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  theme_void()

Transformando em funções

Caso queiramos utilizar funções, aqui uma sequência para analisar bigramas em os Lusíadas:

contar_n.gramas <- function(dataset) {
  dataset %>%
    unnest_tokens(bigram, text, token = "ngrams", n = 2) %>%
    separate(bigram, c("word1", "word2"), sep = " ") %>%
    filter(!word1 %in% minhas.stopwords$word,
           !word2 %in% minhas.stopwords$word) %>%
    count(word1, word2, sort = TRUE)
}

visualizacao_n.grams <- function(bigrams) {
  set.seed(2016)
  a <- grid::arrow(type = "closed", length = unit(.15, "inches"))
  bigrams %>%
    graph_from_data_frame() %>%
    ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = n), show.legend = TRUE, arrow = a) +
    geom_node_point(color = "lightblue", size = 5) +
    geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
    theme_void()
}

baixar_gutemberg <- function(texto){
  meus_arquivos <- gutenberg_download(texto) %>%
  mutate(text=iconv(text, from = "latin1", to = "UTF-8"))
}

Agora executando:

lusiadas <- baixar_gutemberg(3333)
  
lusiadas_bigrams <- lusiadas %>%
  contar_n.gramas()

lusiadas_bigrams %>%
  filter(n > 3,
         !str_detect(word1, "\\d"),
         !str_detect(word2, "\\d")) %>%
  visualizacao_n.grams()

Downloads

Fazendo Bigramas - PDF

 

Fazendo Bigramas - Scripts

Deixe um comentário