|
Mineração de Texto
|
Representações vetoriais de palavras (word embeddings)
Prof. Walmes M. Zeviani
2019-12-06
1 Conteúdo disponível
- Repositório de Word Embeddings do NILC: http://nilc.icmc.usp.br/embeddings.
- Word embeddings - introdução, motivação e exemplos (Felipe Almeida): https://pt.slideshare.net/queirozfcom/word-embeddings-introduo-motivao-e-exemplos.
2 Definições da sessão
#-----------------------------------------------------------------------
# Pacotes.
library(jsonlite) # Ler e escrever para JSON.
library(tidyverse) # Recursos para manipulação e visualização de dados.
library(tidytext) # Manipulação de texto a la tidyverse.
library(text2vec) # Para medidas de distância e Glove.
library(tm) # Recursos para mineração de texto.
library(wordcloud) # Nuvem de palavras.3 Avaliações de veículos
#-----------------------------------------------------------------------
# Importação do texto.
# Endereço de arquivo JSON com avaliação de veículos.
url <- paste0("https://github.com/leg-ufpr/hackathon/blob/master",
"/opinioes.json?raw=true")
# Importa reviews de veículos.
txt <- fromJSON(url)
str(txt)## chr [1:5329, 1:10] "e2b9dc08" "3b9dcf63" "9f62a709" "0e6c8d29" ...# Conteúdo está na forma de matriz.
# txt[1, ]
# Passando para tabela.
colnames(txt) <- c("id", "title", "model", "owner", "condition", "good",
"bad", "defect", "general", "ts")
tt <- as_tibble(txt)
glimpse(tt)## Observations: 5,329
## Variables: 10
## $ id <chr> "e2b9dc08", "3b9dcf63", "9f62a709", "0e6c8d29", "3c958…
## $ title <chr> "\"MELHOR POPULAR DO MERCADO ATÉ 2012\"", "\"Ótimo car…
## $ model <chr> "Chevrolet Celta LT 1.0 2011/2012", "Chevrolet Celta L…
## $ owner <chr> "João - Brasília DF", "Hugo - São Pedro SP", "Ivan - S…
## $ condition <chr> "Dono há 6 anos - 35.200 kmCarro anterior: Fiat Uno", …
## $ good <chr> "Prós:ECONOMIA DE COMBUSTÍVEL, PEÇAS BARATAS, RESISTEN…
## $ bad <chr> "Contras:UM POUCO BAIXO.. AS VEZES QUANDO ESTÁ CARREGA…
## $ defect <chr> "Defeitos apresentados:NENHUM", "Defeitos apresentados…
## $ general <chr> "Opinião Geral:O CARRO É 10 ESTOU COM ELE A 7 ANOS E R…
## $ ts <chr> "09/03/2018 17:40:00", "02/03/2018 21:27:00", "27/02/2…# Modelos de veículos contidos nas avaliações.
tt$product <- tt$model %>%
str_extract("^([[:alpha:]]+ +[[:alpha:]]+)") %>%
str_to_upper()
# Tipos únicos.
# tt$product %>% unique() %>% dput()
tt %>%
count(product, sort = TRUE)## # A tibble: 8 x 2
## product n
## <chr> <int>
## 1 VOLKSWAGEN GOL 1486
## 2 FIAT PALIO 758
## 3 RENAULT SANDERO 712
## 4 VOLKSWAGEN FOX 613
## 5 FIAT UNO 591
## 6 CHEVROLET CELTA 496
## 7 HYUNDAI HB 452
## 8 CHEVROLET ONIX 221# Aplica filtro para reter apenas um modelo de carro.
mod <- c("CHEVROLET CELTA",
"CHEVROLET ONIX",
"FIAT PALIO",
"FIAT UNO",
"HYUNDAI HB",
"RENAULT SANDERO",
"VOLKSWAGEN FOX",
"VOLKSWAGEN GOL")[7]
texto <- tt %>%
filter(str_detect(product, mod)) %>%
select(id, general)
texto## # A tibble: 613 x 2
## id general
## <chr> <chr>
## 1 704827a6 Opinião Geral:no geral é um carro muito bom, quando se faz um …
## 2 5ff3eee9 Opinião Geral:Apesar de ter apresentado a baixa de óleo aparen…
## 3 6c956410 Opinião Geral:Um carro bem equipado, com custo de manutenção b…
## 4 29056ebb Opinião Geral:O carro é bem bonito e o acabamento é muito bom,…
## 5 f0abda9b Opinião Geral:Carro razoável, caro pelo o preço, cheio de mimo…
## 6 7f1a8990 Opinião Geral:Recomendo muito. Ótimo custo beneficio. A versão…
## 7 68aaaffe Opinião Geral:Carro bom para quem pretende ficar uns 3 a 4 ano…
## 8 5721c9e2 Opinião Geral:Já é meu segundo FOX 0km.... Teria um terceiro. …
## 9 2d50b489 Opinião Geral:Carro é bom, bem econômico, dependendo de onde u…
## 10 39b5955c Opinião Geral:Carro muito bom! Mas com o tempo aparece alguns …
## # … with 603 more rows#-----------------------------------------------------------------------
# Cria o corpus a partir de um vetor.
preprocess <- function(x) {
x <- tolower(x)
x <- gsub(pattern = "[[:punct:]]+", replacement = " ", x = x)
x <- removeWords(x, words = stopwords("portuguese"))
x <- removeWords(x, words = c("opinião", "geral", "carro", "veículo"))
x <- removeNumbers(x)
x <- gsub(pattern = "[[:space:]]+", replacement = " ", x = x)
x <- iconv(x, to = "ASCII//TRANSLIT")
x <- trimws(x)
return(x)
}
# Aplica o preprocessamento.
system.time({
xx <- preprocess(texto$general)
xx <- xx[nchar(xx) >= 50]
})## user system elapsed
## 0.028 0.000 0.027#-----------------------------------------------------------------------
# Tokenização e criação do vocabulário.
# Faz a tokenização de cada documento.
tokens <- space_tokenizer(xx)
str(tokens, list.len = 4)## List of 455
## $ : chr [1:16] "e" "bom" "faz" "menos" ...
## $ : chr [1:25] "apesar" "ter" "apresentado" "baixa" ...
## $ : chr [1:30] "bem" "equipado" "custo" "manutencao" ...
## $ : chr [1:106] "e" "bem" "bonito" "acabamento" ...
## [list output truncated]# Cria iterador.
iter <- itoken(tokens)
class(iter)## [1] "itoken" "iterator" "iter" "abstractiter"
## [5] "R6"# Cria o vocabulário em seguida elimina palavras de baixa ocorrência.
vocab <- create_vocabulary(iter, ngram = c(1, 1))
vocab <- prune_vocabulary(vocab, term_count_min = 3)
str(vocab)## Classes 'text2vec_vocabulary' and 'data.frame': 854 obs. of 3 variables:
## $ term : chr "contar" "fique" "moto" "porcaria" ...
## $ term_count: int 3 3 3 3 3 3 3 3 3 3 ...
## $ doc_count : int 3 3 2 3 3 3 3 3 3 2 ...
## - attr(*, "ngram")= Named int 1 1
## ..- attr(*, "names")= chr "ngram_min" "ngram_max"
## - attr(*, "document_count")= int 455
## - attr(*, "stopwords")= chr
## - attr(*, "sep_ngram")= chr "_"# Cria a matriz de co-ocorrência de termos (term cooccurrence matrix).
vectorizer <- vocab_vectorizer(vocab)
tcm <- create_tcm(it = iter,
vectorizer = vectorizer,
skip_grams_window = 5)
str(tcm)## Formal class 'dgTMatrix' [package "Matrix"] with 6 slots
## ..@ i : int [1:21452] 291 343 52 200 114 459 285 113 724 592 ...
## ..@ j : int [1:21452] 651 687 844 524 581 833 838 829 796 841 ...
## ..@ Dim : int [1:2] 854 854
## ..@ Dimnames:List of 2
## .. ..$ : chr [1:854] "contar" "fique" "moto" "porcaria" ...
## .. ..$ : chr [1:854] "contar" "fique" "moto" "porcaria" ...
## ..@ x : num [1:21452] 0.2 0.2 0.833 0.5 0.2 ...
## ..@ factors : list()# Esparsidade da TCM.
1 - length(tcm@x)/prod(tcm@Dim)## [1] 0.9705861#-----------------------------------------------------------------------
# Aplica o GloVe.
# QUESTION: qual o tamanho de vetor usar?
# Inicializa objeto da classe.
glove <- GlobalVectors$new(word_vectors_size = 30,
vocabulary = vocab,
x_max = 10)
names(glove)
# glove$components
# glove$get_word_vectors
# Ajuste a rede neuronal e determinação dos word vectors.
# wv_main <- glove$fit_transform(tcm, n_iter = 90)
wv_main <- glove$fit_transform(tcm)
dim(wv_main)
wv_context <- glove$components
dim(wv_context)
word_vectors <- wv_main + t(wv_context)
dim(word_vectors)#-----------------------------------------------------------------------
# Uso dos vetores para medidas de similaridade.
# Termo alvo.
tgt <- rbind(word_vectors["consumo", ])
# Distância Euclidiana para com os demais termos.
euc <- text2vec::dist2(x = word_vectors, y = tgt)
# head(sort(euc[, 1]), n = 15) %>%
tb_fq <- euc[, 1] %>%
enframe("Termo", "Distância") %>%
mutate_at("Distância", round, digits = 5)
ggplot(top_n(tb_fq, Distância, n = 50)) +
geom_col(mapping = aes(x = reorder(Termo, Distância),
y = Distância)) +
coord_flip()
# Similaridade do coseno (convertida para distância em seguida).
sim <- sim2(x = word_vectors, y = tgt, method = "cosine")
sim <- (1 - sim)/2
tb_fq <- sim[, 1] %>%
enframe("Termo", "Distância") %>%
mutate_at("Distância", round, digits = 5)
ggplot(top_n(tb_fq, Distância, n = 50)) +
geom_col(mapping = aes(x = reorder(Termo, Distância),
y = Distância)) +
coord_flip()
4 Descrição de imóveis
#-----------------------------------------------------------------------
# Leitura e preprocessamento dos dados.
# Dataset com mais de 70 mil registros!
url <- paste0("http://leg.ufpr.br/~walmes/data",
"/TCC_Brasil_Neto/ImoveisWeb-Realty.csv")
tb <- read_csv2(url, locale = locale(encoding = "latin1"))
str(tb, give.attr = FALSE, vec.len = 1)## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 71316 obs. of 22 variables:
## $ id : num 1 2 ...
## $ url : chr "propriedades/excelente-oportunidade-no-boulevard-iguacu-2-quartos-2937271131.html" ...
## $ type : chr "Apartamento" ...
## $ title : chr "excelente oportunidade no boulevard iguaçu - 2 quartos semi mobiliado novo" ...
## $ description: chr "\nDescrição O Boulevard Iguaçu é um empreendimento completíssimo, na charmosa Avenida Iguaçu. Projeto paisagísi"| __truncated__ ...
## $ address : chr "Avenida Iguaçu, Água Verde, Curitiba" ...
## $ lat : num -25.4 ...
## $ lon : num -49.3 ...
## $ pictures : num 31 8 ...
## $ iptu : num 720 NA ...
## $ condominium: num 430 NA ...
## $ usefulArea : num 75 107 ...
## $ totalArea : num 95 107 ...
## $ bedroom : num 2 3 ...
## $ suite : num 1 1 ...
## $ bathroom : num 2 1 ...
## $ garage : num 2 1 ...
## $ price : num 649900 ...
## $ years : num 5 NA ...
## $ publishment: num 2 31 ...
## $ advertiser : chr "PRIME SOHO IMÓVEIS P33" ...
## $ CRECI : chr NA ...# Preprocessamento da descrição dos imóveis.
system.time({
xx <- tb$description
xx <- xx[nchar(xx) >= 80]
xx <- preprocess(xx)
})## user system elapsed
## 10.800 0.056 10.859#-----------------------------------------------------------------------
# Tokenização e criação da TCM.
# Faz a tokenização de cada documento.
tokens <- space_tokenizer(xx)
str(tokens, list.len = 4)## List of 71003
## $ : chr [1:117] "descricao" "boulevard" "iguacu" "e" ...
## $ : chr [1:45] "residencial" "mont" "bello" "residencial" ...
## $ : chr [1:49] "empreendimento" "recem" "lancado" "apartamentos" ...
## $ : chr [1:43] "terreno" "plano" "mts" "sendo" ...
## [list output truncated]# Cria iterador.
iter <- itoken(tokens)
class(iter)## [1] "itoken" "iterator" "iter" "abstractiter"
## [5] "R6"# Cria o vocabulário em seguida elimina palavras de baixa ocorrência.
vocab <- create_vocabulary(iter, ngram = c(1, 1))
vocab <- prune_vocabulary(vocab, term_count_min = 3)
str(vocab)## Classes 'text2vec_vocabulary' and 'data.frame': 16974 obs. of 3 variables:
## $ term : chr "otimizadasareas" "blood" "nosligue" "baterias" ...
## $ term_count: int 3 3 3 3 3 3 3 3 3 3 ...
## $ doc_count : int 3 3 3 3 3 3 3 3 3 3 ...
## - attr(*, "ngram")= Named int 1 1
## ..- attr(*, "names")= chr "ngram_min" "ngram_max"
## - attr(*, "document_count")= int 71003
## - attr(*, "stopwords")= chr
## - attr(*, "sep_ngram")= chr "_"# Cria a matriz de co-ocorrência de termos.
vectorizer <- vocab_vectorizer(vocab)
tcm <- create_tcm(it = iter,
vectorizer = vectorizer,
skip_grams_window = 5)
str(tcm)## Formal class 'dgTMatrix' [package "Matrix"] with 6 slots
## ..@ i : int [1:1532358] 13358 13387 12646 13111 16602 3731 16951 16430 6781 11750 ...
## ..@ j : int [1:1532358] 16967 16452 13431 16831 16948 16167 16968 16479 16833 14134 ...
## ..@ Dim : int [1:2] 16974 16974
## ..@ Dimnames:List of 2
## .. ..$ : chr [1:16974] "otimizadasareas" "blood" "nosligue" "baterias" ...
## .. ..$ : chr [1:16974] "otimizadasareas" "blood" "nosligue" "baterias" ...
## ..@ x : num [1:1532358] 4.7 0.5 0.2 0.333 55.583 ...
## ..@ factors : list()# Esparsidade da TCM.
1 - length(tcm@x)/prod(tcm@Dim)## [1] 0.9946815#-----------------------------------------------------------------------
# Ajuste do GloVe.
# O GloVe está implementado como programação orientada a objeto na
# arquitetura R6. O pacote R6 foi carregado.
s <- sessionInfo()
"R6" %in% union(names(s$otherPkgs), names(s$loadedOnly))
# Inicializa o objeto.
glove <- GlobalVectors$new(word_vectors_size = 50,
vocabulary = vocab,
x_max = 10)
# Ajuste a rede neuronal e determinação dos word vectors.
# wv_main <- glove$fit_transform(tcm, n_iter = 25)
wv_main <- glove$fit_transform(tcm)
wv_context <- glove$components
word_vectors <- wv_main + t(wv_context)#-----------------------------------------------------------------------
# Aplicação do GloVe.
nearest_terms <- function(word_vec, word_vectors, n = 10) {
tgt <- rbind(word_vec)
euc <- text2vec::dist2(x = word_vectors, y = tgt)
head(sort(euc[, 1]), n = n) %>%
enframe("Termo", "Distância") %>%
mutate_at("Distância", round, digits = 5)
}
nearest_terms(word_vectors["quarto", ], word_vectors, n = 10)## # A tibble: 10 x 2
## Termo Distância
## <chr> <dbl>
## 1 quarto 0
## 2 dormitorio 0.0816
## 3 suite 0.185
## 4 banheiro 0.198
## 5 bwc 0.203
## 6 armario 0.210
## 7 closet 0.212
## 8 armarios 0.223
## 9 terceiro 0.251
## 10 quartos 0.252nearest_terms(word_vectors["banheiro", ], word_vectors, n = 10)## # A tibble: 10 x 2
## Termo Distância
## <chr> <dbl>
## 1 banheiro 0
## 2 bwc 0.0979
## 3 social 0.114
## 4 cozinha 0.137
## 5 armarios 0.148
## 6 box 0.169
## 7 suite 0.172
## 8 blindex 0.176
## 9 sacada 0.177
## 10 armario 0.180nearest_terms(word_vectors["cozinha", ], word_vectors, n = 10)## # A tibble: 10 x 2
## Termo Distância
## <chr> <dbl>
## 1 cozinha 0
## 2 lavabo 0.109
## 3 armarios 0.121
## 4 ampla 0.132
## 5 banheiro 0.137
## 6 sacada 0.153
## 7 servico 0.153
## 8 lavanderia 0.159
## 9 planejados 0.166
## 10 ambientes 0.176# Álgebra.
a <- word_vectors["dormitorios", ] -
word_vectors["dormitorio", ] +
word_vectors["quarto", ]
a## [1] -0.215539649 0.539108694 0.640937649 -0.611621886 -0.324428987
## [6] 0.005778661 -0.228134528 0.128741633 0.595791325 0.882755437
## [11] -0.562076192 -0.288698405 -1.208000252 -0.958246334 0.769502521
## [16] 0.855073750 -0.253196552 -1.033058781 -1.209439039 0.199360512
## [21] 0.577096134 -0.493223851 0.740202434 -0.434253454 1.075507700
## [26] -0.382081628 -0.296610147 -0.710803564 -0.869079799 1.314478591
## [31] 0.599265067 -0.417250425 1.624676466 0.556092672 -0.105029950
## [36] -1.245600998 -0.265559948 1.552224636 -0.851269856 0.106476104
## [41] -0.429875097 -0.757275507 -0.924328446 -0.789049119 -1.681210160
## [46] -1.165551007 -0.027583504 -0.623986404 1.555777252 0.299718887nearest_terms(a, word_vectors, n = 4)## # A tibble: 4 x 2
## Termo Distância
## <chr> <dbl>
## 1 dormitorios 0.0556
## 2 quartos 0.0803
## 3 suite 0.103
## 4 sendo 0.1125 Notícias da UFPR
#-----------------------------------------------------------------------
# Carrega dados de binário.
# Carrega os dados.
load("../data/ufpr-news.RData")
length(ufpr)## [1] 8305str(ufpr[[1]])## List of 11
## $ id_noticia : chr "3224492166"
## $ str_midia : chr "Online"
## $ str_veiculo : chr "Gazeta do Povo - Economia"
## $ str_tipo_veiculo: chr "GRANDES REGIONAIS"
## $ str_cidade : chr "Curitiba"
## $ str_estado : chr "PARANÁ"
## $ str_pais : chr "Brasil"
## $ str_secao : chr "AUTOMÓVEIS"
## $ ts_publicacao : chr "2016-09-05 00:14:18"
## $ str_titulo : chr "MST ergue acampamento em frente ao Incra de Curitiba para exigir reforma agrária"
## $ conteudo_texto : chr "Cerca de 1,5 mil integrantes do Movimento dos Trabalhadores Rurais Sem Terra (MST) ocupam desde a manhã desta s"| __truncated__# Extrai títulos das notícias.
tit <- sapply(ufpr, "[[", "str_titulo")
dul <- duplicated(tolower(tit))
sum(dul)## [1] 3454# Removendo as duplicações com base nos títulos.
ufpr <- ufpr[!dul]
# Extrai o conteúdo das notícias.
x <- sapply(ufpr, FUN = "[", "conteudo_texto")
x <- unlist(x)
# Mostra o conteúdo dos primeiros documentos.
head(x, n = 2) %>%
map(str_sub, start = 1, end = 500) %>%
map(str_wrap, width = 60) %>%
walk(cat, "... <continua> ... \n\n")## Cerca de 1,5 mil integrantes do Movimento dos Trabalhadores
## Rurais Sem Terra (MST) ocupam desde a manhã desta segunda-
## feira (5) espaços em frente à sede do Instituto Nacional de
## Colonização e Reforma Agrária (Incra) em Curitiba, que fica
## na rua Dr. Faivre, no Centro. Por causa do protesto, a via
## foi bloqueada entre as avenidas Sete de Setembro e Visconde
## de Guarapuava. Equipes do BPTran e Setran já estão no local.
## A linha Circular Centro, que passa na região, registra um
## pouco de atraso nos horá ... <continua> ...
##
## A Prefeitura de Ponta Grossa lamenta o falecimento da
## arquiteta e urbanista Silvia Magali Contin, aos 61 anos,
## ocorrido nesta segunda-feira (5). Silvia foi a primeira
## presidente do Instituto de Pesquisa e Planejamento Urbano de
## Ponta Grossa (Iplan), permanecendo no cargo nos anos de 1999
## a 2000. Formada em Arquitetura pela Universidade Federal do
## Paraná (UFPR), vinha participando ativamente das reuniões
## públicas do Iplan para a elaboração do Plano Diretor
## Municipal 2016, e foi membro integrante ... <continua> ...#-----------------------------------------------------------------------
# Preprocessamento, faz a tokenização e criação da TCM.
# Aplica o preprocessamento.
xx <- x
xx <- xx[nchar(xx) >= 100]
xx <- preprocess(xx)
# Faz a tokenização de cada documento.
tokens <- space_tokenizer(xx)
str(tokens, list.len = 4)## List of 4803
## $ : chr [1:529] "cerca" "mil" "integrantes" "movimento" ...
## $ : chr [1:66] "prefeitura" "ponta" "grossa" "lamenta" ...
## $ : chr [1:208] "inscricoes" "vestibular" "universidade" "federal" ...
## $ : chr [1:181] "anos" "associacao" "amigos" "hc" ...
## [list output truncated]# Cria iterador.
iter <- itoken(tokens)
class(iter)## [1] "itoken" "iterator" "iter" "abstractiter"
## [5] "R6"# Cria o vocabulário em seguida elimina palavras de baixa ocorrência.
# vocab <- create_vocabulary(iter, ngram = c(1, 2)) # Bigramas.
vocab <- create_vocabulary(iter, ngram = c(1, 1))
vocab <- prune_vocabulary(vocab, term_count_min = 3)
str(vocab)## Classes 'text2vec_vocabulary' and 'data.frame': 37675 obs. of 3 variables:
## $ term : chr "apropriadas" "brejeiro" "kuchler" "mirror" ...
## $ term_count: int 3 3 3 3 3 3 3 3 3 3 ...
## $ doc_count : int 3 3 3 3 3 3 3 3 3 2 ...
## - attr(*, "ngram")= Named int 1 1
## ..- attr(*, "names")= chr "ngram_min" "ngram_max"
## - attr(*, "document_count")= int 4803
## - attr(*, "stopwords")= chr
## - attr(*, "sep_ngram")= chr "_"# Cria a matriz de co-ocorrência de termos.
vectorizer <- vocab_vectorizer(vocab)
tcm <- create_tcm(it = iter,
vectorizer = vectorizer,
skip_grams_window = 5)
str(tcm)## Formal class 'dgTMatrix' [package "Matrix"] with 6 slots
## ..@ i : int [1:3572051] 36511 31712 27149 32629 12526 37031 37485 7812 2784 33194 ...
## ..@ j : int [1:3572051] 37601 37084 37638 37533 37442 37206 37595 37509 33674 36913 ...
## ..@ Dim : int [1:2] 37675 37675
## ..@ Dimnames:List of 2
## .. ..$ : chr [1:37675] "apropriadas" "brejeiro" "kuchler" "mirror" ...
## .. ..$ : chr [1:37675] "apropriadas" "brejeiro" "kuchler" "mirror" ...
## ..@ x : num [1:3572051] 0.2 0.667 0.25 0.4 1.5 ...
## ..@ factors : list()# Esparsidade da TCM.
1 - length(tcm@x)/prod(tcm@Dim)## [1] 0.9974834#-----------------------------------------------------------------------
# Ajuta o GloVe.
# Inicializa objeto (arquitetura de POO R6).
glove <- GlobalVectors$new(word_vectors_size = 50,
vocabulary = vocab,
x_max = 10)
# Ajuste a rede neuronal e determinação dos word vectors.
# wv_main <- glove$fit_transform(tcm, n_iter = 25)
wv_main <- glove$fit_transform(tcm)
wv_context <- glove$components
word_vectors <- wv_main + t(wv_context)#-----------------------------------------------------------------------
# Núvem de palavras.
tgt <- rbind(word_vectors["vestibular", ])
sim <- sim2(x = word_vectors, y = tgt, method = "cosine")
freq <- head(sort(sim[, 1], decreasing = TRUE), n = 300)
cbind(head(freq, n = 10))## [,1]
## vestibular 1.0000000
## fase 0.6745261
## resultado 0.6724820
## aprovados 0.6578090
## prova 0.6503547
## candidatos 0.6310969
## curso 0.6165435
## primeira 0.6049426
## provas 0.6028138
## ultimo 0.6005549# Termos mais similares.
oldpar <- par()
par(mar = c(0, 0, 0, 0))
wordcloud(words = names(freq),
freq = freq^2,
random.order = FALSE,
rot.per = 0,
colors = tail(brewer.pal(9, "Blues"), n = 5))
par(oldpar)
# Gráfico de barras.
freq %>%
enframe() %>%
top_n(value, n = 50) %>%
ggplot() +
geom_col(mapping = aes(x = reorder(name, value), y = value)) +
coord_flip()
# tgt <- rbind(word_vectors["estatistica", ])
# tgt <- rbind(word_vectors["professor", ])
tgt <- rbind(word_vectors["ufpr", ])
sim <- sim2(x = word_vectors, y = tgt, method = "cosine")
freq <- head(sort(sim[, 1], decreasing = TRUE), n = 300)
cbind(head(freq, n = 10))## [,1]
## ufpr 1.0000000
## universidade 0.7784661
## parana 0.7410673
## federal 0.7218121
## instituicao 0.7101859
## segundo 0.6673120
## reitoria 0.5937226
## curso 0.5903542
## desde 0.5902145
## alunos 0.5845133# Termos mais similares.
oldpar <- par()
par(mar = c(0, 0, 0, 0))
wordcloud(words = names(freq),
freq = freq^2,
random.order = FALSE,
rot.per = 0,
colors = tail(brewer.pal(9, "Reds"), n = 5))
par(oldpar)6 Agrupamento de documentos
- Abordagens para similaridade entre documentos com
text2vec: http://text2vec.org/similarity.html.
#-----------------------------------------------------------------------
# Lê os documentos de arquivo JSON.
u <- jsonlite::fromJSON("http://leg.ufpr.br/~walmes/data/respostas-sobre-agrupamento.json")
u <- unlist(u)
str(u)## Named chr [1:17] " i - k-médias: aprendizado nao-supervisionado que atribui ou agrupamentos às observações. O método calcula cen"| __truncated__ ...
## - attr(*, "names")= chr [1:17] "1544113608" "1544113622" "1544113634" "1544113697" ...#-----------------------------------------------------------------------
# Cria a matriz de coocorrência.
# Aplica o preprocessamento.
xx <- u
xx <- preprocess(xx)
# Faz a tokenização de cada documento.
tokens <- space_tokenizer(xx)
str(tokens, list.len = 4)## List of 17
## $ : chr [1:172] "i" "k" "medias" "aprendizado" ...
## $ : chr [1:148] "k" "means" "e" "algoritmo" ...
## $ : chr [1:118] "k" "medias" "e" "um" ...
## $ : chr [1:186] "algoritmo" "k" "medias" "e" ...
## [list output truncated]# Cria iterador.
iter <- itoken(tokens)
class(iter)## [1] "itoken" "iterator" "iter" "abstractiter"
## [5] "R6"# Cria o vocabulário em seguida elimina palavras de baixa ocorrência.
# vocab <- create_vocabulary(iter, ngram = c(1, 2)) # Bigramas.
vocab <- create_vocabulary(iter, ngram = c(1, 1))
vocab <- prune_vocabulary(vocab, term_count_min = 3)
str(vocab)## Classes 'text2vec_vocabulary' and 'data.frame': 251 obs. of 3 variables:
## $ term : chr "formando" "situacoes" "dividindo" "comecando" ...
## $ term_count: int 3 3 3 3 3 3 3 3 3 3 ...
## $ doc_count : int 2 2 3 3 3 1 3 2 2 1 ...
## - attr(*, "ngram")= Named int 1 1
## ..- attr(*, "names")= chr "ngram_min" "ngram_max"
## - attr(*, "document_count")= int 17
## - attr(*, "stopwords")= chr
## - attr(*, "sep_ngram")= chr "_"# Cria a matriz de co-ocorrência de termos.
vectorizer <- vocab_vectorizer(vocab)
tcm <- create_tcm(it = iter,
vectorizer = vectorizer,
skip_grams_window = 5)
str(tcm)## Formal class 'dgTMatrix' [package "Matrix"] with 6 slots
## ..@ i : int [1:4294] 158 210 113 201 128 155 99 70 160 228 ...
## ..@ j : int [1:4294] 248 246 204 204 244 231 242 187 246 229 ...
## ..@ Dim : int [1:2] 251 251
## ..@ Dimnames:List of 2
## .. ..$ : chr [1:251] "formando" "situacoes" "dividindo" "comecando" ...
## .. ..$ : chr [1:251] "formando" "situacoes" "dividindo" "comecando" ...
## ..@ x : num [1:4294] 0.2 1.5 0.25 0.25 0.2 ...
## ..@ factors : list()# Esparsidade da TCM.
1 - length(tcm@x)/prod(tcm@Dim)## [1] 0.9318424#-----------------------------------------------------------------------
# Ajuta o GloVe.
# Inicializa objeto (arquitetura de POO R6).
glove <- GlobalVectors$new(word_vectors_size = 15,
vocabulary = vocab,
x_max = 10)
# Ajuste a rede neuronal e determinação dos word vectors.
wv_main <- glove$fit_transform(tcm, n_iter = 25)## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 1, expected cost 0.0884
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 2, expected cost 0.0595
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 3, expected cost 0.0503
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 4, expected cost 0.0442
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 5, expected cost 0.0397
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 6, expected cost 0.0361
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 7, expected cost 0.0331
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 8, expected cost 0.0305
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 9, expected cost 0.0283
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 10, expected cost 0.0264
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 11, expected cost 0.0247
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 12, expected cost 0.0233
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 13, expected cost 0.0220
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 14, expected cost 0.0209
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 15, expected cost 0.0199
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 16, expected cost 0.0190
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 17, expected cost 0.0182
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 18, expected cost 0.0175
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 19, expected cost 0.0169
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 20, expected cost 0.0163
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 21, expected cost 0.0157
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 22, expected cost 0.0152
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 23, expected cost 0.0148
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 24, expected cost 0.0144
## INFO [2019-12-06 18:08:26] 2019-12-06 18:08:26 - epoch 25, expected cost 0.0140wv_context <- glove$components
word_vectors <- wv_main + t(wv_context)
dim(word_vectors)## [1] 251 15head(rownames(word_vectors))## [1] "formando" "situacoes" "dividindo" "comecando" "criterio" "util"word_vectors["agrupamento", ]## [1] 1.722317815 -0.739219636 0.952169221 -0.308006555 -0.742602855
## [6] -0.116682172 0.293162912 0.928785685 0.732971221 -0.320867747
## [11] 1.146681726 -1.030373007 0.009728789 0.762796387 1.228638887#-----------------------------------------------------------------------
# Criar os vetores dos documentos usando média.
# https://ai.intelligentonlinetools.com/ml/text-clustering-word-embedding-machine-learning/
# https://www.quora.com/How-can-I-use-word2vec-or-GLOVE-for-document-classification-in-to-predefined-categories
# http://xplordat.com/2018/09/27/word-embeddings-and-document-vectors-part-1-similarity/
# Obtém os vetores dos documentos fazendo a média dos vetores das
# palavras.
doc_vectors <- sapply(tokens,
simplify = FALSE,
FUN = function(tk) {
i <- na.omit(match(tk,
rownames(word_vectors)))
colMeans(word_vectors[i, ])
})
doc_vectors <- do.call(rbind, doc_vectors)
dim(doc_vectors)## [1] 17 15rownames(doc_vectors) <- names(u)
#-----------------------------------------------------------------------
# Faz a análise de agrupamento.
d <- dist(doc_vectors, method = "euclidean")
hc <- hclust(d, method = "complete")
plot(hc, hang = -1)
# Exibe os textos que são próximos.
# txt <- c("1544113622", "1544113746")
txt <- c("1544113756", "1544113842")
u[txt] %>%
walk(function(x) cat(str_wrap(x, width = 60), "\n\n"))## i) K-médias: é um algoritmo de agrupamento interativo. Tem
## como função de classificação a distância do objeto ao centro
## do grupo. Minimiza a somo de todas as distâncias euclidianas
## entre cada objeto e o seu centroide, segundo o critério
## dos mínimos quadrados. O contexto mais apropriado para esse
## algoritmo é o 1, porque o k-médias classifica objetos num
## determinado número pré-definido K de grupos, ou seja, antes
## do algoritmo ser iniciado, te que ser escolhido o número de
## grupos. ii) Agrupamento Hierárquico: Existem dois métodos,
## os Algoritmos Aglomerativos e os Algoritmos Divisivos.
## São técnicas simples onde os dados são particionados
## sucessivamente, produzindo uma representação hierárquica
## dos agrupamentos. É um método que não precisa definir o
## número de grupos a priori. A análise é feita através de um
## dendograma, pois é por ele que se pode inferir no número de
## agrupamentos adequados. Esses métodos requerem uma matriz
## contendo as métricas de distância entre os agrupamentos em
## cada estágio do algoritmo. O contexto mais apropriado para
## esse algoritmo é o 2, porque a representação hierárquica
## dos agrupamentos facilita a visualização sobre a formação
## dos agrupamentos em cada estágio onde ela ocorreu e com
## que grau de semelhança entre eles. iii) DBSCAN: A ideia
## chave desse método é que, para cada ponto de um cluster,
## a vizinhança para um dado raio contém, no mínimo, certo
## número de pontos, ou seja, a densidade da vizinhança tem que
## exceder um limiar. O método encontra clusters verificando a
## vizinhança epsilon de cada ponto da base de dados, começando
## por um objeto arbitrário p. Se p é um ponto central, um novo
## cluster com p é criado. Se p é um ponto de fronteira, nenhum
## ponto é alcançável por densidade a partir de p e o método
## visita o próximo ponto na base. O processo termina quando
## mais nenhum outro ponto pode ser adicionado a algum cluster.
## O contexto mais apropriado para esse algoritmo é o 3,
## porque pontos que não são diretamente atingíveis por algum
## ponto central são classificados como ruído. E também ele é
## efetivo para identificar clusters de formata arbitrário e de
## diferentes tamanhos, identificar e separar ruídos dos dados
## e detectar clusters “naturais”, sem qualquer informação
## preliminar sobre os grupos.
##
## No contexto 1, a melhor algoritmo seria o K-médias, pois tem
## como função de classificação a distância do objeto ao centro
## do grupo, ou seja, minimiza a soma de todas as distâncias
## euclidianas entre cada objeto e o seu centroide, segundo
## o critério dos mínimos quadrados. Sendo assim o k-médias
## classifica objetos num determinado número pré-definido K
## de grupos, ou seja, antes do algoritmo ser iniciado, te
## que ser escolhido o número de grupos. No contexto 2, o
## melhor algoritmo seria o Agrupamento Hierárquico. Existem
## dois métodos, os Algoritmos Aglomerativos e os Algoritmos
## Divisivos. Essas são técnicas simples onde os dados são
## particionados sucessivamente, produzindo uma representação
## hierárquica dos agrupamentos. Além disso é um método que
## não precisa definir o número de grupos a priori. A análise
## é feita através de um dendograma, pois é assim que se pode
## inferir no número de agrupamentos adequados. Esses métodos
## requerem uma matriz contendo as métricas de distância entre
## os agrupamentos em cada estágio do algoritmo. Sendo assim,
## a representação hierárquica dos agrupamentos facilita a
## visualização de modo que é possível verificar a formação
## dos agrupamentos em cada estágio onde ela ocorreu e com
## que grau de semelhança entre eles. No contexto 3, o melhor
## algoritmo seria o DBSCAN. Nesse caso,a ideia chave é que,
## para cada ponto de um cluster, a vizinhança para um dado
## raio contém, no mínimo, certo número de pontos, ou seja, a
## densidade da vizinhança tem que exceder um limiar. O método
## encontra clusters verificando a vizinhança epsilon de cada
## ponto da base de dados, começando por um objeto arbitrário
## p. Se p é um ponto central, um novo cluster com p é criado.
## Se p é um ponto de fronteira, nenhum ponto é alcançável por
## densidade a partir de p e o método visita o próximo ponto
## na base. O processo termina quando mais nenhum outro ponto
## pode ser adicionado a algum cluster. Sendo assim, os pontos
## que não são diretamente atingíveis por algum ponto central
## são classificados como ruído. É efetivo para identificar
## clusters de formata arbitrário e de diferentes tamanhos,
## identificar e separar ruídos dos dados e detectar clusters
## “naturais”, sem qualquer informação preliminar sobre os
## grupos.Serviços online para verificar a diferença entre textos:
- https://countwordsfree.com/comparetexts.
- https://text-compare.com/.
- https://www.diffchecker.com/diff.
#-----------------------------------------------------------------------
# Versões dos pacotes e data do documento.
devtools::session_info()## ─ Session info ──────────────────────────────────────────────────────────
## setting value
## version R version 3.6.1 (2019-07-05)
## os Ubuntu 16.04.6 LTS
## system x86_64, linux-gnu
## ui X11
## language en_US
## collate en_US.UTF-8
## ctype pt_BR.UTF-8
## tz America/Sao_Paulo
## date 2019-12-06
##
## ─ Packages ──────────────────────────────────────────────────────────────
## package * version date lib source
## assertthat 0.2.1 2019-03-21 [3] CRAN (R 3.6.1)
## backports 1.1.4 2019-04-10 [3] CRAN (R 3.6.1)
## broom 0.5.2 2019-04-07 [3] CRAN (R 3.6.1)
## callr 3.3.1 2019-07-18 [3] CRAN (R 3.6.1)
## cellranger 1.1.0 2016-07-27 [3] CRAN (R 3.6.1)
## cli 1.1.0 2019-03-19 [3] CRAN (R 3.6.1)
## codetools 0.2-16 2018-12-24 [4] CRAN (R 3.5.2)
## colorspace 1.4-1 2019-03-18 [3] CRAN (R 3.6.1)
## crayon 1.3.4 2017-09-16 [3] CRAN (R 3.6.1)
## curl 4.0 2019-07-22 [3] CRAN (R 3.6.1)
## data.table 1.12.2 2019-04-07 [3] CRAN (R 3.6.1)
## desc 1.2.0 2018-05-01 [3] CRAN (R 3.6.1)
## devtools 2.1.0 2019-07-06 [3] CRAN (R 3.6.1)
## digest 0.6.21 2019-09-20 [3] CRAN (R 3.6.1)
## dplyr * 0.8.3 2019-07-04 [3] CRAN (R 3.6.1)
## evaluate 0.14 2019-05-28 [3] CRAN (R 3.6.1)
## fansi 0.4.0 2018-10-05 [3] CRAN (R 3.6.1)
## forcats * 0.4.0 2019-02-17 [3] CRAN (R 3.6.1)
## foreach 1.4.4 2017-12-12 [3] CRAN (R 3.6.1)
## formatR 1.7 2019-06-11 [3] CRAN (R 3.6.1)
## fs 1.3.1 2019-05-06 [3] CRAN (R 3.6.1)
## futile.logger 1.4.3 2016-07-10 [3] CRAN (R 3.6.1)
## futile.options 1.0.1 2018-04-20 [3] CRAN (R 3.6.1)
## generics 0.0.2 2018-11-29 [3] CRAN (R 3.6.1)
## ggplot2 * 3.2.0 2019-06-16 [3] CRAN (R 3.6.1)
## glue 1.3.1 2019-03-12 [3] CRAN (R 3.6.1)
## gtable 0.3.0 2019-03-25 [3] CRAN (R 3.6.1)
## haven 2.1.1 2019-07-04 [3] CRAN (R 3.6.1)
## hms 0.5.0 2019-07-09 [3] CRAN (R 3.6.1)
## htmltools 0.4.0 2019-10-04 [3] CRAN (R 3.6.1)
## httr 1.4.0 2018-12-11 [3] CRAN (R 3.6.1)
## iterators 1.0.10 2018-07-13 [3] CRAN (R 3.6.1)
## janeaustenr 0.1.5 2017-06-10 [3] CRAN (R 3.6.1)
## jsonlite * 1.6 2018-12-07 [3] CRAN (R 3.6.1)
## knitr * 1.23 2019-05-18 [3] CRAN (R 3.6.1)
## labeling 0.3 2014-08-23 [3] CRAN (R 3.6.1)
## lambda.r 1.2.4 2019-09-18 [3] CRAN (R 3.6.1)
## lattice 0.20-38 2018-11-04 [4] CRAN (R 3.5.1)
## lazyeval 0.2.2 2019-03-15 [3] CRAN (R 3.6.1)
## lubridate 1.7.4 2018-04-11 [3] CRAN (R 3.6.1)
## magrittr 1.5 2014-11-22 [3] CRAN (R 3.6.1)
## Matrix 1.2-17 2019-03-22 [4] CRAN (R 3.6.1)
## memoise 1.1.0 2017-04-21 [3] CRAN (R 3.6.1)
## mlapi 0.1.0 2017-12-17 [3] CRAN (R 3.6.1)
## modelr 0.1.4 2019-02-18 [3] CRAN (R 3.6.1)
## munsell 0.5.0 2018-06-12 [3] CRAN (R 3.6.1)
## nlme 3.1-140 2019-05-12 [3] CRAN (R 3.6.1)
## NLP * 0.2-0 2018-10-18 [3] CRAN (R 3.6.1)
## pillar 1.4.2 2019-06-29 [3] CRAN (R 3.6.1)
## pkgbuild 1.0.3 2019-03-20 [3] CRAN (R 3.6.1)
## pkgconfig 2.0.2 2018-08-16 [3] CRAN (R 3.6.1)
## pkgload 1.0.2 2018-10-29 [3] CRAN (R 3.6.1)
## prettyunits 1.0.2 2015-07-13 [3] CRAN (R 3.6.1)
## processx 3.4.1 2019-07-18 [3] CRAN (R 3.6.1)
## ps 1.3.0 2018-12-21 [3] CRAN (R 3.6.1)
## purrr * 0.3.2 2019-03-15 [3] CRAN (R 3.6.1)
## R6 2.4.0 2019-02-14 [3] CRAN (R 3.6.1)
## RColorBrewer * 1.1-2 2014-12-07 [3] CRAN (R 3.6.1)
## Rcpp 1.0.3 2019-11-08 [3] CRAN (R 3.6.1)
## RcppParallel 4.4.3 2019-05-22 [3] CRAN (R 3.6.1)
## readr * 1.3.1 2018-12-21 [3] CRAN (R 3.6.1)
## readxl 1.3.1 2019-03-13 [3] CRAN (R 3.6.1)
## remotes 2.1.0 2019-06-24 [3] CRAN (R 3.6.1)
## rlang 0.4.0 2019-06-25 [3] CRAN (R 3.6.1)
## rmarkdown * 1.14 2019-07-12 [3] CRAN (R 3.6.1)
## rprojroot 1.3-2 2018-01-03 [3] CRAN (R 3.6.1)
## rstudioapi 0.10 2019-03-19 [3] CRAN (R 3.6.1)
## rvest 0.3.4 2019-05-15 [3] CRAN (R 3.6.1)
## scales 1.0.0 2018-08-09 [3] CRAN (R 3.6.1)
## sessioninfo 1.1.1 2018-11-05 [3] CRAN (R 3.6.1)
## slam 0.1-45 2019-02-26 [3] CRAN (R 3.6.1)
## SnowballC 0.6.0 2019-01-15 [3] CRAN (R 3.6.1)
## stringi 1.4.3 2019-03-12 [3] CRAN (R 3.6.1)
## stringr * 1.4.0 2019-02-10 [3] CRAN (R 3.6.1)
## testthat 2.2.0 2019-07-22 [3] CRAN (R 3.6.1)
## text2vec * 0.5.1 2018-01-11 [3] CRAN (R 3.6.1)
## tibble * 2.1.3 2019-06-06 [3] CRAN (R 3.6.1)
## tidyr * 0.8.3 2019-03-01 [3] CRAN (R 3.6.1)
## tidyselect 0.2.5 2018-10-11 [3] CRAN (R 3.6.1)
## tidytext * 0.2.2 2019-07-29 [3] CRAN (R 3.6.1)
## tidyverse * 1.2.1 2017-11-14 [3] CRAN (R 3.6.1)
## tm * 0.7-6 2018-12-21 [3] CRAN (R 3.6.1)
## tokenizers 0.2.1 2018-03-29 [3] CRAN (R 3.6.1)
## usethis 1.5.1 2019-07-04 [3] CRAN (R 3.6.1)
## utf8 1.1.4 2018-05-24 [3] CRAN (R 3.6.1)
## vctrs 0.2.0 2019-07-05 [3] CRAN (R 3.6.1)
## withr 2.1.2 2018-03-15 [3] CRAN (R 3.6.1)
## wordcloud * 2.6 2018-08-24 [3] CRAN (R 3.6.1)
## xfun 0.8 2019-06-25 [3] CRAN (R 3.6.1)
## xml2 1.2.0 2018-01-24 [3] CRAN (R 3.6.1)
## yaml 2.2.0 2018-07-25 [3] CRAN (R 3.6.1)
## zeallot 0.1.0 2018-01-28 [3] CRAN (R 3.6.1)
##
## [1] /home/walmes/R/x86_64-pc-linux-gnu-library/3.6
## [2] /usr/local/lib/R/site-library
## [3] /usr/lib/R/site-library
## [4] /usr/lib/R/librarySys.time()## [1] "2019-12-06 18:08:27 -03"
Mineração de Texto |
leg.ufpr.br/~walmes/ensino/mintex/ |