Prof. Walmes Marques Zeviani
27 Abr 2017
library(tm)
# Carregar uma lista de listas chamada `ufpr` com notícias envolvendo a
# UFPR entre 2016-09-05 até 2017-03-31.
load(file = "ufpr_news/ufpr-news.RData")
class(ufpr)## [1] "list"length(ufpr)## [1] 8305names(ufpr[[1]])## [1] "id_noticia" "str_midia" "str_veiculo"
## [4] "str_tipo_veiculo" "str_cidade" "str_estado"
## [7] "str_pais" "str_secao" "ts_publicacao"
## [10] "str_titulo" "conteudo_texto"# Texto das notícias.
texnot <- sapply(ufpr, FUN = "[[", "conteudo_texto")
# Outras informações junto com o título.
L <- lapply(ufpr,
FUN = "[",
c("id_noticia",
"str_midia",
"str_veiculo",
"str_tipo_veiculo",
"str_cidade",
"str_estado",
"str_pais",
"str_secao",
"ts_publicacao",
"str_titulo"))
L <- lapply(L,
FUN = function(x) {
x <- x[!sapply(x, is.null)]
as.data.frame(x, stringsAsFactors = FALSE)
})
da <- do.call(plyr::rbind.fill, L)
# Encurta os nomes.
names(da) <- gsub("^[^_]*_", "", names(da))
# Cria a variável dia da notícia como data.
da$dia <- strptime(da$publicacao, "%Y-%m-%d")
# Estrutura.
str(da)## 'data.frame': 8305 obs. of 11 variables:
## $ noticia : chr "3224492166" "3224505660" "3224514102" "3224600172" ...
## $ midia : chr "Online" "Online" "Online" "Online" ...
## $ veiculo : chr "Gazeta do Povo - Economia" "JM News" "Sobre Vestibular" "Ação Voluntária" ...
## $ tipo_veiculo: chr "GRANDES REGIONAIS" "REGIONAL" "ESPECIALIZADO" "ON LINE" ...
## $ cidade : chr "Curitiba" "Ponta Grossa" "São Paulo" "Curitiba" ...
## $ estado : chr "PARANÁ" "PARANÁ" "SÃO PAULO" "PARANÁ" ...
## $ pais : chr "Brasil" "Brasil" "Brasil" "Brasil" ...
## $ secao : chr "AUTOMÓVEIS" "HOME" "HOME" "NOTÍCIAS" ...
## $ publicacao : chr "2016-09-05 00:14:18" "2016-09-05 02:18:35" "2016-09-05 04:18:13" "2016-09-05 12:34:05" ...
## $ titulo : chr "MST ergue acampamento em frente ao Incra de Curitiba para exigir reforma agrária" "PG perde a urbanista Silvia Contin" "Vestibular UFPR 2016 está com as inscrições abertas" "05/09/2016 | Amigos do HC busca voluntários para atuar no maior hospital do Paraná" ...
## $ dia : POSIXlt, format: "2016-09-05" ...library(lattice)
library(latticeExtra)
# Gráficos de pareto sobre os metadados.
tb <- sort(xtabs(~cidade, data = da), decreasing = TRUE)
barchart(tb[1:30])
tb <- sort(xtabs(~tipo_veiculo, data = da), decreasing = TRUE)
barchart(tb)
tb <- sort(xtabs(~secao, data = da), decreasing = TRUE)
barchart(tb[1:30])
#-----------------------------------------------------------------------
# Criando um Corpus.
# Usar uma amostra apenas dos títulos para entender.
# db <- subset(da, dia == "2017-02-02")
db <- subset(da, dia == "2017-03-15")
cps <- VCorpus(VectorSource(x = db$titulo),
readerControl = list(language = "pt",
load = TRUE))
# str(cps)
# Classe e métodos para a classe.
class(cps)## [1] "VCorpus" "Corpus"cps## <<VCorpus>>
## Metadata: corpus specific: 0, document level (indexed): 0
## Content: documents: 45methods(class = "VCorpus")## [1] as.list as.VCorpus content
## [4] c format inspect
## [7] length meta<- meta
## [10] names<- names print
## [13] TermDocumentMatrix tm_filter tm_index
## [16] tm_map [ [[<-
## [19] [[
## see '?methods' for accessing help and source code# Classe e métodos para a classe.
class(cps[[1]])## [1] "PlainTextDocument" "TextDocument"methods(class = "PlainTextDocument")## [1] as.character content<- content
## [4] format meta<- meta
## [7] print removeNumbers removePunctuation
## [10] removeWords stemDocument stripWhitespace
## [13] tm_term_score words
## see '?methods' for accessing help and source code# Conteúdo do elemento.
content(cps[[1]])## [1] "A?educação a distância não é mais o patinho feio do ensino superior"# Meta dados do elemento.
meta(cps[[1]])## author : character(0)
## datetimestamp: 2017-05-31 01:04:16
## description : character(0)
## heading : character(0)
## id : 1
## language : pt
## origin : character(0)# Adicionando metadados para todos os elementos.
# Com "indexed" (default) indica que ficara como tabela mas mantendo
# indexação com os elementos. É melhor para desempenho.
meta(cps, tag = "ts", type = "indexed") <- db$publicacao
meta(cps, tag = "cidade") <- db$cidade
meta(cps[[2]])## author : character(0)
## datetimestamp: 2017-05-31 01:04:16
## description : character(0)
## heading : character(0)
## id : 2
## language : pt
## origin : character(0)head(meta(cps))## ts cidade
## 1 2017-03-15 00:02:00 Curitiba
## 2 2017-03-15 00:55:42 Umuarama
## 3 2017-03-15 04:34:50 São Paulo
## 4 2017-03-15 06:42:38 São Paulo
## 5 2017-03-15 08:22:53 Curitiba
## 6 2017-03-15 08:23:50 Curitiba# "local" indica que ficará dentro de cada elemento
meta(cps, tag = "ts", type = "local") <- db$publicacao
meta(cps[[2]])## author : character(0)
## datetimestamp: 2017-05-31 01:04:16
## description : character(0)
## heading : character(0)
## id : 2
## language : pt
## origin : character(0)
## ts : 2017-03-15 00:55:42# Passa texto para caixa baixa.
cps <- tm_map(cps, FUN = content_transformer(tolower))
lapply(cps[1:4], content)## $`1`
## [1] "a?educação a distância não é mais o patinho feio do ensino superior"
##
## $`2`
## [1] "luta contra devastação das possíveis barragens no rio piquiri continua"
##
## $`3`
## [1] "pr: justiça declara legal greve desta quarta-feira"
##
## $`4`
## [1] "torre atto vai coletar dados na amazônia"# Remove pontuação e números
cps <- tm_map(cps, FUN = removePunctuation)
cps <- tm_map(cps, FUN = removeNumbers)
lapply(cps[1:4], content)## $`1`
## [1] "aeducação a distância não é mais o patinho feio do ensino superior"
##
## $`2`
## [1] "luta contra devastação das possíveis barragens no rio piquiri continua"
##
## $`3`
## [1] "pr justiça declara legal greve desta quartafeira"
##
## $`4`
## [1] "torre atto vai coletar dados na amazônia"# Remove espaços em branco extra.
cps <- tm_map(cps, FUN = stripWhitespace)
lapply(cps[1:4], content)## $`1`
## [1] "aeducação a distância não é mais o patinho feio do ensino superior"
##
## $`2`
## [1] "luta contra devastação das possíveis barragens no rio piquiri continua"
##
## $`3`
## [1] "pr justiça declara legal greve desta quartafeira"
##
## $`4`
## [1] "torre atto vai coletar dados na amazônia"# Remove as stopwords.
stopwords("portuguese")## [1] "de" "a" "o" "que"
## [5] "e" "do" "da" "em"
## [9] "um" "para" "com" "não"
## [13] "uma" "os" "no" "se"
## [17] "na" "por" "mais" "as"
## [21] "dos" "como" "mas" "ao"
## [25] "ele" "das" "à" "seu"
## [29] "sua" "ou" "quando" "muito"
## [33] "nos" "já" "eu" "também"
## [37] "só" "pelo" "pela" "até"
## [41] "isso" "ela" "entre" "depois"
## [45] "sem" "mesmo" "aos" "seus"
## [49] "quem" "nas" "me" "esse"
## [53] "eles" "você" "essa" "num"
## [57] "nem" "suas" "meu" "às"
## [61] "minha" "numa" "pelos" "elas"
## [65] "qual" "nós" "lhe" "deles"
## [69] "essas" "esses" "pelas" "este"
## [73] "dele" "tu" "te" "vocês"
## [77] "vos" "lhes" "meus" "minhas"
## [81] "teu" "tua" "teus" "tuas"
## [85] "nosso" "nossa" "nossos" "nossas"
## [89] "dela" "delas" "esta" "estes"
## [93] "estas" "aquele" "aquela" "aqueles"
## [97] "aquelas" "isto" "aquilo" "estou"
## [101] "está" "estamos" "estão" "estive"
## [105] "esteve" "estivemos" "estiveram" "estava"
## [109] "estávamos" "estavam" "estivera" "estivéramos"
## [113] "esteja" "estejamos" "estejam" "estivesse"
## [117] "estivéssemos" "estivessem" "estiver" "estivermos"
## [121] "estiverem" "hei" "há" "havemos"
## [125] "hão" "houve" "houvemos" "houveram"
## [129] "houvera" "houvéramos" "haja" "hajamos"
## [133] "hajam" "houvesse" "houvéssemos" "houvessem"
## [137] "houver" "houvermos" "houverem" "houverei"
## [141] "houverá" "houveremos" "houverão" "houveria"
## [145] "houveríamos" "houveriam" "sou" "somos"
## [149] "são" "era" "éramos" "eram"
## [153] "fui" "foi" "fomos" "foram"
## [157] "fora" "fôramos" "seja" "sejamos"
## [161] "sejam" "fosse" "fôssemos" "fossem"
## [165] "for" "formos" "forem" "serei"
## [169] "será" "seremos" "serão" "seria"
## [173] "seríamos" "seriam" "tenho" "tem"
## [177] "temos" "tém" "tinha" "tínhamos"
## [181] "tinham" "tive" "teve" "tivemos"
## [185] "tiveram" "tivera" "tivéramos" "tenha"
## [189] "tenhamos" "tenham" "tivesse" "tivéssemos"
## [193] "tivessem" "tiver" "tivermos" "tiverem"
## [197] "terei" "terá" "teremos" "terão"
## [201] "teria" "teríamos" "teriam"cps <- tm_map(cps, FUN = removeWords, words = stopwords("portuguese"))
lapply(cps[1:4], content)## $`1`
## [1] "aeducação distância é patinho feio ensino superior"
##
## $`2`
## [1] "luta contra devastação possíveis barragens rio piquiri continua"
##
## $`3`
## [1] "pr justiça declara legal greve desta quartafeira"
##
## $`4`
## [1] "torre atto vai coletar dados amazônia"haver <- grep("^h", stopwords("portuguese"), value = TRUE)
# Idiomas suportados no algoritmo de Porter.
SnowballC::getStemLanguages()## [1] "danish" "dutch" "english" "finnish"
## [5] "french" "german" "hungarian" "italian"
## [9] "norwegian" "porter" "portuguese" "romanian"
## [13] "russian" "spanish" "swedish" "turkish"# Como fica a radicalização, "poda" ou aparação.
SnowballC::wordStem(haver)## [1] "hei" "há" "havemo" "hão"
## [5] "houv" "houvemo" "houveram" "houvera"
## [9] "houvéramo" "haja" "hajamo" "hajam"
## [13] "houvess" "houvéssemo" "houvessem" "houver"
## [17] "houvermo" "houverem" "houverei" "houverá"
## [21] "houveremo" "houverão" "houveria" "houveríamo"
## [25] "houveriam"SnowballC::wordStem(haver, language = "portuguese")## [1] "hei" "há" "hav" "hã" "houv" "houv"
## [7] "houv" "houv" "houv" "haj" "haj" "haj"
## [13] "houv" "houvéss" "houv" "houv" "houv" "houv"
## [19] "houv" "houv" "houv" "houv" "houv" "houv"
## [25] "houv"# Mantem apenas os prefixos.
cps2 <- tm_map(cps, FUN = stemDocument, language = "portuguese")
lapply(cps2[1:4], content)## $`1`
## [1] "aeducação distância é patinho feio ensino superior"
##
## $`2`
## [1] "luta contra devastação possívei barragen rio piquiri continua"
##
## $`3`
## [1] "pr justiça declara legal greve desta quartafeira"
##
## $`4`
## [1] "torr atto vai coletar dado amazônia"# Matriz de documentos e termos.
dtm <- DocumentTermMatrix(cps)
tdm <- TermDocumentMatrix(cps)
# Detalhes.
tdm## <<TermDocumentMatrix (terms: 191, documents: 45)>>
## Non-/sparse entries: 284/8311
## Sparsity : 97%
## Maximal term length: 17
## Weighting : term frequency (tf)# Classe e métodos.
class(dtm)## [1] "DocumentTermMatrix" "simple_triplet_matrix"methods(class = "DocumentTermMatrix")## [1] as.DocumentTermMatrix as.TermDocumentMatrix
## [3] c dimnames<-
## [5] Docs [
## [7] findAssocs findMostFreqTerms
## [9] inspect nDocs
## [11] nTerms plot
## [13] print t
## [15] Terms tm_term_score
## see '?methods' for accessing help and source codemethods(class = "TermDocumentMatrix")## [1] as.DocumentTermMatrix as.TermDocumentMatrix
## [3] c dimnames<-
## [5] Docs findAssocs
## [7] findMostFreqTerms inspect
## [9] nDocs nTerms
## [11] plot print
## [13] [ Terms
## [15] tm_term_score t
## see '?methods' for accessing help and source code# Número de documentos e termos (vocabulário).
dim(dtm)## [1] 45 191dim(tdm)## [1] 191 45nTerms(tdm)## [1] 191nDocs(tdm)## [1] 45inspect(tdm[1:15, 1:20])## <<TermDocumentMatrix (terms: 15, documents: 20)>>
## Non-/sparse entries: 6/294
## Sparsity : 98%
## Maximal term length: 11
## Weighting : term frequency (tf)
## Sample :
## Docs
## Terms 1 11 2 3 4 5 6 7 8 9
## abertas 0 0 0 0 0 0 0 0 0 0
## abraves 0 0 0 0 0 0 0 0 0 0
## abre 0 0 0 0 0 0 0 0 0 0
## acesso 0 0 0 0 0 0 0 0 0 0
## acolhimento 0 0 0 0 0 0 0 0 0 0
## aeducação 1 0 0 0 0 0 0 0 0 0
## amanhece 0 0 0 0 0 1 0 0 0 1
## amazônia 0 0 0 0 1 0 0 0 0 0
## anos 0 1 0 0 0 0 0 0 0 0
## arquitetura 0 0 0 0 0 0 0 1 0 0# Cédulas com valor positivo.
y <- sum(tdm > 0)
y## [1] 284# Total de cédulas da matriz.
t <- prod(dim(tdm))
t## [1] 8595# Esparsidade (proporção de cédulas com 0 na matriz).
100 * (t - y)/t## [1] 96.69575# Converte para matriz ordinária.
m <- as.matrix(tdm)
# Reordenar matriz por frequencia dos termos.
m <- m[order(apply(m, MARGIN = 1, sum), decreasing = TRUE), ]
m <- t(m)
# Visualiza a matriz de documentos e termos. Cuidado com as dimensões.
levelplot(m,
xlab = "Documentos",
ylab = "Termos",
col.regions = gray.colors,
scales = list(x = list(rot = 90))) +
layer(panel.abline(h = 2:ncol(m) - 0.5,
v = 2:nrow(m) - 0.5,
col = "white"))
# Termos com frequencia superior a um valor.
mft <- findFreqTerms(tdm, lowfreq = 4)
mft## [1] "cpa" "curitiba" "ônibus" "ufpr"# Termos associados a um valor acima de um limite.
findAssocs(dtm, terms = mft, corlimit = 0.5)## $cpa
## abertas anbima cea certificação
## 1 1 1 1
## curso cursos especialização investimento
## 1 1 1 1
## matrículas
## 1
##
## $curitiba
## amanhece circular frota mínima ruas terminais
## 0.55 0.55 0.55 0.55 0.55 0.55
## vazios voltam
## 0.55 0.55
##
## $ônibus
## circular frota mínima voltam
## 0.69 0.69 0.69 0.69
##
## $ufpr
## numeric(0)findAssocs(dtm, terms = "curitiba", corlimit = 0.5)## $curitiba
## ônibus amanhece circular frota mínima ruas
## 0.57 0.55 0.55 0.55 0.55 0.55
## terminais vazios voltam
## 0.55 0.55 0.55# Remove termos esparsos para uma dada máxima esparsidade permitida.
rst <- removeSparseTerms(tdm, sparse = 0.92)
dim(rst)## [1] 3 45tdm## <<TermDocumentMatrix (terms: 191, documents: 45)>>
## Non-/sparse entries: 284/8311
## Sparsity : 97%
## Maximal term length: 17
## Weighting : term frequency (tf)rst## <<TermDocumentMatrix (terms: 3, documents: 45)>>
## Non-/sparse entries: 14/121
## Sparsity : 90%
## Maximal term length: 8
## Weighting : term frequency (tf)m <- as.matrix(rst)
m <- m[order(apply(m, MARGIN = 1, sum), decreasing = TRUE), ]
levelplot(m,
ylab = "Documentos",
xlab = "Termos",
col.regions = gray.colors,
scales = list(x = list(rot = 90))) +
layer(panel.abline(h = 2:ncol(m) - 0.5,
v = 2:nrow(m) - 0.5,
col = "white"))
library(wordcloud)
library(RColorBrewer)
m <- as.matrix(tdm)
v <- sort(rowSums(m), decreasing = TRUE)
d <- data.frame(word = names(v), freq = v)
head(d, 10)## word freq
## curitiba curitiba 6
## cpa cpa 4
## ônibus ônibus 4
## ufpr ufpr 4
## ciência ciência 3
## congresso congresso 3
## emoção emoção 3
## exposição exposição 3
## leite leite 3
## luz luz 3wordcloud(words = d$word,
freq = d$freq,
min.freq = 1,
max.words = 200,
random.order = FALSE,
# rot.per = 0.35,
colors = brewer.pal(8, "Dark2"))