Projeto Analise Sentimentos Final
Giuliano Lemes Pereira
16 de dezembro de 2017
Term Documents Matrix
Uma das mais comuns estruturas que lidamos na mineração de texto é o DTM ou Document Term Matrix, é uma matriz que cada linha representa um documento, cada coluna representa um termo cada valor representa o numero de ocorrencias daquele termo. Na primeira parte do artigo ( http://rpubs.com/giuice/analisesentimentos1 ) , mineiramos stopwords, montamos os vocabulários de sentimentos, usamos várias técnicas para tokenizar nossos tweets e salvamos todos os dados, decidi não carregar os arquivos salvos, pois tweets são muito pequenos e a quantidade de dados ficou a desejar, portanto vou carregar novamente puxando novas empresas, como facebook, linkedin e classificar esses dados
setwd("D:/Cursos/PreparacaoCarreiraCientista/R-Bigdata/Projeto1")
#Carregando as polaridades salvas na primeira parte do artigo
polaridades_pt <- read_csv('parte2/polaridades_pt.csv')
stopwordslist <- read_csv('stopwordsfinal.csv')
stopwordslist## # A tibble: 265 x 2
## X1 x
## <int> <chr>
## 1 1 a
## 2 2 ainda
## 3 3 alem
## 4 4 ambas
## 5 5 ambos
## 6 6 antes
## 7 7 ao
## 8 8 aonde
## 9 9 aos
## 10 10 apos
## # ... with 255 more rowsSe está trabalhando com text mining em português prefira usar o readr pra salvar e abrir arquivos pois já implementa o padrão utf-8, somente assim não tive problemas com acentuação.
Acessando twitter
consumer_key <- "297e14M3druKiH9WRw4PiGMbq"
consumer_secret <- "PspZCHvEEwBJR4SeMDZJ4wVFp3ZKthGvkTGrSwY5V0JPnTwDuB"
access_token <- "15862395-ulKt4LiDiJGR7Am4qmfK1hF2E0ySJ8LfPZB52QtDX"
access_secret <- "UB7sYvfpRR3ZcqNOUDKc7qYpAMTAKpr5R4XdcybSoCVLR"twitter_tag <- "#microsoft|#facebook|#google|#apple|#amazon|#linkedin"
# autorizando
setup_twitter_oauth(consumer_key, consumer_secret, access_token, access_secret);## [1] "Using direct authentication"tweets <- searchTwitter(twitter_tag, lang = 'pt', resultType="mixed", n=5000);
tweetxt <- sapply(tweets, function(x) x$getText())
tibble(tweetxt)## # A tibble: 2,706 x 1
## tweetxt
## <chr>
## 1 "Já que a série será antes do filme A sociedade do anel, faria sentido mant
## 2 Um #facebook mais leve no #smartphone? https://t.co/7F3ZviHe8O
## 3 "Aplicação Móvel\n#Portugal #Lisboa #Porto #webhouse #Braga #Criatividade #
## 4 "RT @MidiaDigitalCOM: #Facebook despenca como fonte de acesso a conteúdo jo
## 5 "RT @MidiaDigitalCOM: #Facebook despenca como fonte de acesso a conteúdo jo
## 6 "RT @MidiaDigitalCOM: #Facebook despenca como fonte de acesso a conteúdo jo
## 7 "RT @MidiaDigitalCOM: #Facebook despenca como fonte de acesso a conteúdo jo
## 8 "RT @MidiaDigitalCOM: #Facebook despenca como fonte de acesso a conteúdo jo
## 9 "RT @MidiaDigitalCOM: #Facebook despenca como fonte de acesso a conteúdo jo
## 10 "RT @MidiaDigitalCOM: #Facebook despenca como fonte de acesso a conteúdo jo
## # ... with 2,696 more rowsremoveURL <- function(x) gsub("http[^[:space:]]*", "", x)
tweetxtUtf <- readr::parse_character(tweetxt, locale = readr::locale('pt')) # sapply(tweetxt, function(x) iconv(x, "UTF-8"))
tweetxtUtf <- sapply(tweetxtUtf, function(x) stri_trans_tolower(x,'pt'))
tweetxtUtf <- gsub("(RT|via)((?:\\b\\W*@\\w+)+)", " ", tweetxtUtf);
tweetxtUtf <- str_replace(tweetxtUtf,"RT @[a-z,A-Z]*: ","")
tweetxtUtf <- gsub("@\\w+", "", tweetxtUtf)
tweetxtUtf <- removeURL(tweetxtUtf)
tweetxtUtf <- str_replace_all(tweetxtUtf,"@[a-z,A-Z]*","")
tweetxtUtf <- gsub("[^[:alnum:][:blank:]]", " ", tweetxtUtf)
tweetxtUtf <- gsub("[[:digit:]]", "", tweetxtUtf)
tweetxtUtfUnique <- tweetxtUtf %>% unique()
tibble(tweetxtUtfUnique) ## # A tibble: 1,865 x 1
## tweetxtUtfUnique
## <chr>
## 1 já que a série será antes do filme a sociedade do anel faria sentido mante
## 2 um facebook mais leve no smartphone
## 3 aplicação móvel portugal lisboa porto webhouse braga criatividade ma
## 4 rt facebook despenca como fonte de acesso a conteúdo jornalistico goog
## 5 facebook despenca como fonte de acesso a conteúdo jornalistico google g
## 6 rt como fazer p bloquear conteúdos indesejados n facebook redessociais
## 7 amazon expande atuação no país e passa a vender itens de casa e cozinha
## 8 fiz uma assinatura no amazonprime e horas depois tentaram fazer uma compra
## 9 facebook lança botão para silenciar gente chata por dias
## 10 imac pro mil reais apple
## # ... with 1,855 more rowsTrabalhando com a TM Package
A maneira padrao de se converter para um corpus tm_corpus <- Corpus(VectorSource(twclean$tweet)) Mas vou usar outras opções aqui para demontrar como podemos atingir os mesmos objetivos em R com ações diferentes
Criando o corpus
É muito importante aplicar a função enc2native ao trabalhar com o tm, se deixar de aplica-la o TM vai derreter suas palavras acentuadas na criação de TermoDocument ou DocumentTerm
library(tm)
tweetencoded <- sapply(tweetxtUtfUnique,enc2native)
df <- data.frame(text=tweetencoded)
head(df)## text
## já que a série será antes do filme a sociedade do anel faria sentido manter amazon gandalf já que a série será antes do filme a sociedade do anel faria sentido manter amazon gandalf
## um facebook mais leve no smartphone um facebook mais leve no smartphone
## aplicação móvel portugal lisboa porto webhouse braga criatividade marketing google web imaginação aplicação móvel portugal lisboa porto webhouse braga criatividade marketing google web imaginação
## rt facebook despenca como fonte de acesso a conteúdo jornalistico google games rt facebook despenca como fonte de acesso a conteúdo jornalistico google games
## facebook despenca como fonte de acesso a conteúdo jornalistico google games facebook despenca como fonte de acesso a conteúdo jornalistico google games
## rt como fazer p bloquear conteúdos indesejados n facebook redessociais privacidade bloquear rt como fazer p bloquear conteúdos indesejados n facebook redessociais privacidade bloquear#Criando um id para o documento, isso vai ser util na conversão
df$doc_id <- row.names(df)
head(df)## text
## já que a série será antes do filme a sociedade do anel faria sentido manter amazon gandalf já que a série será antes do filme a sociedade do anel faria sentido manter amazon gandalf
## um facebook mais leve no smartphone um facebook mais leve no smartphone
## aplicação móvel portugal lisboa porto webhouse braga criatividade marketing google web imaginação aplicação móvel portugal lisboa porto webhouse braga criatividade marketing google web imaginação
## rt facebook despenca como fonte de acesso a conteúdo jornalistico google games rt facebook despenca como fonte de acesso a conteúdo jornalistico google games
## facebook despenca como fonte de acesso a conteúdo jornalistico google games facebook despenca como fonte de acesso a conteúdo jornalistico google games
## rt como fazer p bloquear conteúdos indesejados n facebook redessociais privacidade bloquear rt como fazer p bloquear conteúdos indesejados n facebook redessociais privacidade bloquear
## doc_id
## já que a série será antes do filme a sociedade do anel faria sentido manter amazon gandalf já que a série será antes do filme a sociedade do anel faria sentido manter amazon gandalf
## um facebook mais leve no smartphone um facebook mais leve no smartphone
## aplicação móvel portugal lisboa porto webhouse braga criatividade marketing google web imaginação aplicação móvel portugal lisboa porto webhouse braga criatividade marketing google web imaginação
## rt facebook despenca como fonte de acesso a conteúdo jornalistico google games rt facebook despenca como fonte de acesso a conteúdo jornalistico google games
## facebook despenca como fonte de acesso a conteúdo jornalistico google games facebook despenca como fonte de acesso a conteúdo jornalistico google games
## rt como fazer p bloquear conteúdos indesejados n facebook redessociais privacidade bloquear rt como fazer p bloquear conteúdos indesejados n facebook redessociais privacidade bloqueartm_corpus <- Corpus(DataframeSource(df))
inspect(tm_corpus[1:4])## <<SimpleCorpus>>
## Metadata: corpus specific: 1, document level (indexed): 0
## Content: documents: 4
##
## já que a série será antes do filme a sociedade do anel faria sentido manter amazon gandalf
## já que a série será antes do filme a sociedade do anel faria sentido manter amazon gandalf
## um facebook mais leve no smartphone
## um facebook mais leve no smartphone
## aplicação móvel portugal lisboa porto webhouse braga criatividade marketing google web imaginação
## aplicação móvel portugal lisboa porto webhouse braga criatividade marketing google web imaginação
## rt facebook despenca como fonte de acesso a conteúdo jornalistico google games
## rt facebook despenca como fonte de acesso a conteúdo jornalistico google games#criando o dtm usando palavras que tem mais de 3 letras e uma frequencia >19
dtm <- DocumentTermMatrix(tm_corpus, control=list(wordLengths=c(4, 20),language=locale('pt'), stopwords=stopwords('portuguese'),
bounds = list(global = c(30,500))))
dtm## <<DocumentTermMatrix (documents: 1865, terms: 30)>>
## Non-/sparse entries: 2725/53225
## Sparsity : 95%
## Maximal term length: 9
## Weighting : term frequency (tf)#podemos ver os termos mais frequentes
findFreqTerms(dtm)## [1] "amazon" "facebook" "google" "marketing" "fazer"
## [6] "brasil" "compra" "apple" "linkedin" "twitter"
## [11] "pode" "está" "instagram" "youtube" "android"
## [16] "shazam" "microsoft" "aqui" "mundo" "página"
## [21] "preço" "você" "agora" "macos" "iphone"
## [26] "hoje" "sobre" "iphonex" "novo" "link"ttm_results <- t(as.matrix(dtm)) %*% as.matrix(dtm)
head(ttm_results)## Terms
## Terms amazon facebook google marketing fazer brasil compra apple
## amazon 290 0 11 0 1 3 2 5
## facebook 0 695 9 12 14 10 2 4
## google 11 9 571 12 4 32 2 14
## marketing 0 12 12 56 0 2 0 0
## fazer 1 14 4 0 30 1 1 4
## brasil 3 10 32 2 1 66 1 34
## Terms
## Terms linkedin twitter pode está instagram youtube android shazam
## amazon 0 0 1 9 4 10 9 0
## facebook 6 35 12 27 42 15 5 0
## google 0 3 2 9 1 20 14 0
## marketing 8 0 0 0 1 0 0 0
## fazer 1 1 1 1 0 0 0 0
## brasil 0 2 2 2 0 2 0 1
## Terms
## Terms microsoft aqui mundo página preço você agora macos iphone hoje
## amazon 0 8 6 0 9 1 1 1 0 3
## facebook 0 5 5 32 0 18 16 0 0 12
## google 5 8 12 0 2 22 5 3 6 3
## marketing 0 1 3 0 1 1 0 0 0 2
## fazer 3 0 0 0 0 5 2 0 4 0
## brasil 2 2 5 2 8 1 0 3 6 2
## Terms
## Terms sobre iphonex novo link
## amazon 2 0 1 15
## facebook 6 1 6 2
## google 15 0 6 0
## marketing 4 0 0 0
## fazer 1 0 0 0
## brasil 1 4 0 0#Provavelmente você terá que instalar a package igraph se não tiver
library(igraph)
#construindo um grafico da matriz acima
g <- graph.adjacency(ttm_results, weighted=T, mode = 'undirected')
g <- simplify(g)
#setando o label e degree dos vertices
V(g)$label <- V(g)$name
V(g)$degree <- degree(g)
E(g)$color <- ifelse(E(g)$wheight > 15, "lightblue", "red")
set.seed(2000)
layout1 <- layout_on_sphere(g)
#plot(g, layout=layout1)
#tkplot(g, layout=layout.drl)
#plot(g, layout=layout.kamada.kawai)
plot(g, layout=layout.fruchterman.reingold)
#melhorando a apresentação de acordo com o peso dos termos
V(g)$label.cex <- 2.2 * V(g)$degree / max(V(g)$degree)+ .2
V(g)$label.color <- rgb(0, 0, .2, .8)
V(g)$frame.color <- NA
egam <- (log(E(g)$weight)+.4) / max(log(E(g)$weight)+.4)
E(g)$color <- rgb(.5, .5, 0, egam)
E(g)$width <- egam
plot(g, layout=layout1)
Usando a package Quanteda
#Apresentarei a vocês agora uma outra maneira de criar matrizes de termo e documentos
#Note que no quanteda não precisa fazer um encode de todo o texto
library(quanteda)
#vou qualificar os dados para futuramente fazer alguma coisa com isso
twdf <- tibble(tweet = tweetxtUtfUnique)
twdf$whois <- NA
twdf$whois[twdf$tweet %like% 'facebook'] <- 'facebook'
twdf$whois[twdf$tweet %like% 'microsoft'] <- 'microsoft'
twdf$whois[twdf$tweet %like% 'google'] <- 'google'
twdf$whois[twdf$tweet %like% 'apple'] <- 'apple'
twdf$whois[twdf$tweet %like% 'amazon'] <- 'amazon'
twdf$whois[twdf$tweet %like% 'linkedin'] <- 'linkedin'
twdf$whois[is.na(twdf$whois) ] <- 'semtag'
freq <- twdf %>% count(whois, sort = T) %>% select( whois,freq = n)
freq## # A tibble: 7 x 2
## whois freq
## <chr> <int>
## 1 facebook 461
## 2 apple 387
## 3 google 363
## 4 semtag 258
## 5 amazon 220
## 6 microsoft 113
## 7 linkedin 63#hist(freq$freq)
#plot(density(freq$freq))
pie(table(twdf$whois))
barplot(table(twdf$whois))
distMatrix <- as.matrix(dist(freq$freq))
plot(density(distMatrix))
#criando o dtm
dfq <- data.frame(id=row.names(twdf),
text=twdf$tweet, whois = factor(twdf$whois))
myCorpus <- corpus(twdf, text_field = 'tweet',
metacorpus = list(source = "tweets da amazon, google e microsoft"))
myCorpus## Corpus consisting of 1,865 documents and 1 docvar.Testando a legibilidade dos textos, uma função muito util para text-mining
head(textstat_readability(myCorpus),2)## ARI ARI.simple Bormuth Bormuth.GP Coleman Coleman.C2
## text1 7.572353 56.17647 -2.811558 57177309.1 22.25588 25.34412
## text2 5.120000 51.00000 -0.634064 193531.7 47.55000 64.05000
## Coleman.Liau Coleman.Liau.grade Coleman.Liau.short Dale.Chall
## text1 54.78217 8.053416 8.054118 -42.73
## text2 52.54197 8.667241 8.666667 -35.14
## Dale.Chall.old Dale.Chall.PSK Danielson.Bryan Danielson.Bryan.2
## text1 20.2697 15.8304 5.62305 84.5611
## text2 19.7241 15.1748 6.19450 69.4570
## Dickes.Steiwer DRP ELF Farr.Jenkins.Paterson Flesch
## text1 -339.6374 381.1558 9 -48.01953 35.30941
## text2 -254.5643 163.4064 2 -36.54100 59.74500
## Flesch.PSK Flesch.Kincaid FOG FOG.PSK FOG.NRI FORCAST
## text1 7.416759 12.557647 16.21176 6.889375 0.625 12.94118
## text2 5.847233 6.416667 15.73333 4.894382 -1.200 10.00000
## FORCAST.RGL Fucks Linsear.Write LIW nWS nWS.2 nWS.3
## text1 12.66529 74 16 34.64706 8.796224 8.840988 9.095865
## text2 9.43000 30 8 39.33333 8.721533 9.496867 9.905267
## nWS.4 RIX Scrabble SMOG SMOG.C SMOG.simple SMOG.de Spache
## text1 9.278671 3 1.690141 14.55459 14.04419 13.95445 8.954451 10.916
## text2 9.047267 2 1.833333 11.20814 10.93047 10.74597 5.745967 9.585
## Spache.old Strain Traenkle.Bailer Traenkle.Bailer.2 Wheeler.Smith
## text1 11.836 9.3 -346.1112 -208.4278 90
## text2 10.285 3.0 -247.9125 -246.4472 20
## meanSentenceLength meanWordSyllables
## text1 17 1.823529
## text2 6 1.666667#observando
summary(myCorpus,6)## Corpus consisting of 1865 documents, showing 6 documents:
##
## Text Types Tokens Sentences whois
## text1 15 17 1 amazon
## text2 6 6 1 facebook
## text3 12 12 1 google
## text4 12 12 1 google
## text5 11 11 1 google
## text6 11 12 1 facebook
##
## Source: tweets da amazon, google e microsoft
## Created: Sat Dec 16 18:10:43 2017
## Notes:#para acessar qq parte da matriz use a função texts
texts(myCorpus)[28:30]## text28
## "o amor não se vê com os olhos mas com o coração william shakespeare poesia estrelasdobrasil caldeirão g "
## text29
## "três músicos três visões tv cultura alternativa músicadeimproviso músicaaovivo facebook transmissãoaovivo "
## text30
## " aromatherapy essential oils products spa massage therapy medicine remedies guide tips herbs amazon app "summary(corpus_subset(myCorpus, whois == 'amazon'),6)## Corpus consisting of 220 documents, showing 6 documents:
##
## Text Types Tokens Sentences whois
## text1 15 17 1 amazon
## text7 16 18 1 amazon
## text8 16 18 1 amazon
## text14 3 3 1 amazon
## text18 6 6 1 amazon
## text23 6 6 1 amazon
##
## Source: tweets da amazon, google e microsoft
## Created: Sat Dec 16 18:10:43 2017
## Notes:#A função kwic (keywords in context) procura o texto e nos mostra uma forma visual da matrix
kwic(myCorpus,'virtual')##
## [text211, 6] já tomou remédio hj redessociais | virtual |
## [text1684, 5] rt rt priz em | virtual |
## [text1856, 4] rt priz em | virtual |
## [text1859, 3] priz em | virtual |
##
## mrx facebook instagram twitter mrxlovers
## diva music radio spotify soundcloud
## diva music radio spotify soundcloud
## diva music radio spotify soundcloud#com o quanteda tambem podemos tokenizar o texto, vamos pegar por exemplo nossos tweets originais
temptok <- tokens(tweetxtUtfUnique)
#note o objeto token
temptok[1:5]## tokens from 5 documents.
## text1 :
## [1] "já" "que" "a" "série" "será"
## [6] "antes" "do" "filme" "a" "sociedade"
## [11] "do" "anel" "faria" "sentido" "manter"
## [16] "amazon" "gandalf"
##
## text2 :
## [1] "um" "facebook" "mais" "leve" "no"
## [6] "smartphone"
##
## text3 :
## [1] "aplicação" "móvel" "portugal" "lisboa"
## [5] "porto" "webhouse" "braga" "criatividade"
## [9] "marketing" "google" "web" "imaginação"
##
## text4 :
## [1] "rt" "facebook" "despenca" "como"
## [5] "fonte" "de" "acesso" "a"
## [9] "conteúdo" "jornalistico" "google" "games"
##
## text5 :
## [1] "facebook" "despenca" "como" "fonte"
## [5] "de" "acesso" "a" "conteúdo"
## [9] "jornalistico" "google" "games"O Document-feature matrix
remove(temptok)
#Agora vamos usar a principal funçao do quanteda a dfm, que transforma o corpus em um
#documento termo matriz e ao contrario da funçao tokens ela aplica varios funções de limpeza como
#retirar pontuação, converter para minusculo, para saber mais consulte a documentação
myDfm <- dfm(myCorpus, stem = F)
myDfm## Document-feature matrix of: 1,865 documents, 5,824 features (99.8% sparse).topfeatures(myDfm,20)## de facebook o apple e a no google
## 798 551 533 466 464 455 445 437
## do que para em da amazon rt mais
## 360 301 255 254 249 242 202 181
## um com na é
## 174 174 154 141Pode-se tamber criar o documento como na Package TM já fazendo o stem e stopwords
stopwors2 <- c('the','r','é','c','?','!','of','rt','pra')
myDfm <- dfm(myCorpus, groups='whois', remove = c(quanteda::stopwords("portuguese"),stopwors2,tm::stopwords('portuguese')),
stem = F, remove_punct = TRUE)
#note que com a opão groups ele agrupou pela nossa classificação
myDfm## Document-feature matrix of: 7 documents, 5,670 features (79.8% sparse).## para acessar os termos mais usados
topfeatures(myDfm, 20) ## facebook apple google amazon microsoft ios iphone
## 551 466 437 242 129 110 89
## gt linkedin macos brasil instagram shazam marketing
## 80 67 67 66 58 57 48
## android dia compra twitter sobre app
## 47 47 46 41 41 40#as top features estão bem mais uteis agora...#e finalmente chegamos na nossa já conhecida wordcloud
set.seed(100)
textplot_wordcloud(myDfm, min.freq = 15, random.order = FALSE,
rot.per = .6,
colors = RColorBrewer::brewer.pal(8,"Dark2"))
Frequencia do texto
allfeats <- textstat_frequency(myDfm)
allfeats$feature <- with(allfeats, reorder(feature, -frequency))
ggplot(head(allfeats,20), aes(x=feature, y=frequency, fill=frequency)) + geom_bar(stat="identity") +
xlab("Termos") + ylab("Frequência") + coord_flip() +
theme(axis.text=element_text(size=7))
Quais os termos mais frequentes?
col <- textstat_collocations(myCorpus , size = 2:4, min_count = 2)
head(col)## collocation count count_nested length lambda z
## 1 no google 91 91 2 2.950038 22.45634
## 2 gt gt 35 35 2 6.042400 22.10317
## 3 iphone x 32 32 2 6.617886 20.49300
## 4 compra shazam 24 24 2 6.646472 19.33694
## 5 no facebook 83 83 2 2.546452 19.30552
## 6 macos ios 54 54 2 8.272475 17.70834#col <- with(col, reorder(collocation, count))
ggplot(col[order(col$count, decreasing = T),][1:25,],
aes(x=reorder(collocation,count), y=factor(count), fill=factor(count))) + geom_bar(stat="identity") +
xlab("Expressões") + ylab("Frequência") + coord_flip() +
theme(axis.text=element_text(size=7))
Vendo as palavras relacionadas do agrupamentos que criamos
Lendo o help do quanteda achei várias funções que achei de grande utilidade, veja como exemplo a textstat_keyness, que Calcula “keyness”, uma pontuação para recursos que ocorrem diferencialmente em diferentes categorias. Aqui, as categorias são definidas por referência a um índice de documento “alvo” no dfm, com o grupo de referência composto por todos os outros documentos. maravilhoso…
tstatkeyness <- textstat_keyness(myDfm, target = 'linkedin')
head(tstatkeyness,15)## chi2 p n_target n_reference
## linkedin 1912.37634 0.000000e+00 67 0
## vazam 116.05150 0.000000e+00 5 0
## perfil 100.69839 0.000000e+00 9 10
## senhas 95.22662 0.000000e+00 5 1
## bilhão 95.22662 0.000000e+00 5 1
## prática 87.55587 0.000000e+00 4 0
## webanalytics 87.55587 0.000000e+00 4 0
## emprego 87.55587 0.000000e+00 4 0
## netflix 87.50314 0.000000e+00 7 6
## marketers 59.32137 1.343370e-14 3 0
## ilovewebmetrics 59.32137 1.343370e-14 3 0
## logins 59.32137 1.343370e-14 3 0
## gestão 43.26082 4.790812e-11 3 1
## currículo 43.26082 4.790812e-11 3 1
## atenção 33.63823 6.637533e-09 3 2#e agora plotando!
textplot_keyness(tstatkeyness)
#dfm_sort(myDfm)[, 1:20]
textstat_simil(myDfm, c('microsoft','linkedin'))## microsoft linkedin
## microsoft 1.000000e+00 4.398576e-05
## linkedin 4.398576e-05 1.000000e+00
## amazon 2.424570e-03 -6.355098e-04
## facebook 4.599934e-03 9.127781e-02
## google 1.776859e-02 8.506950e-03
## apple 6.379573e-03 2.245573e-03
## semtag 5.299791e-02 6.727757e-02Plotando score wordfish(escala não supervisionada)
## wordfish
wfm <- textmodel_wordfish(myDfm)
textplot_scale1d(wfm)
Plotando Escala 1D
# plot estimated word positions
textplot_scale1d(wfm, margin = "features",
highlighted = c("google", "microsoft", "amazon",
"apple","linkedin"))
Plotando Xray
textplot_xray(kwic(myCorpus[1:40], "microsoft"),
kwic(myCorpus[1:40], "amazon"),
kwic(myCorpus[1:40], "facebook"),
kwic(myCorpus[1:40], "apple"))
Calculando a diversidade complexidade dos textos
textstat_lexdiv(myDfm, "all",drop=T) %>% arrange(desc(U))## TTR C R CTTR U S Maas
## 1 0.6270122 0.9404808 31.64393 22.375639 57.22574 0.9499293 0.1321917
## 2 0.5276302 0.9152053 22.88967 16.185437 38.61821 0.9253020 0.1609177
## 3 0.4897210 0.9097431 25.55950 18.073293 38.06031 0.9233491 0.1620928
## 4 0.4518744 0.9040751 28.39267 20.076651 37.49157 0.9212120 0.1633177
## 5 0.5637982 0.9171724 17.92666 12.676060 36.27718 0.9214141 0.1660287
## 6 0.4284439 0.8956162 24.83866 17.563588 33.78369 0.9125260 0.1720467
## 7 0.5708955 0.9107993 13.21719 9.345962 30.59578 0.9069391 0.1807878
## lgV0 lgeV0
## 1 9.425733 21.70355
## 2 7.436822 17.12392
## 3 7.527381 17.33244
## 4 7.607849 17.51772
## 5 6.915784 15.92418
## 6 7.100196 16.34880
## 7 6.020892 13.86362Exibindo colocations, fazendo um score de termos
#vamos pegar os tweets crus sem nenhum processo, apenas com encode
twraw <- readr::parse_character(tweetxt, locale = readr::locale('pt'))
mytoken <- tokens(twraw,
remove_numbers=T,remove_symbols=T,
remove_twitter=T, remove_url=T)
head(mytoken)## tokens from 6 documents.
## text1 :
## [1] "Já" "que" "a" "série" "será"
## [6] "antes" "do" "filme" "A" "sociedade"
## [11] "do" "anel" "," "faria" "sentido"
## [16] "manter" "#Amazon" "#Gandalf"
##
## text2 :
## [1] "Um" "#facebook" "mais" "leve" "no"
## [6] "#smartphone" "?"
##
## text3 :
## [1] "Aplicação" "Móvel" "#Portugal" "#Lisboa"
## [5] "#Porto" "#webhouse" "#Braga" "#Criatividade"
## [9] "#marketing" "#Google" "#web" "#Imaginação"
## [13] "." "." "."
##
## text4 :
## [1] "RT" "@MidiaDigitalCOM" ":"
## [4] "#Facebook" "despenca" "como"
## [7] "fonte" "de" "acesso"
## [10] "a" "conteúdo" "jornalistico"
## [13] "#Google" "#games"
##
## text5 :
## [1] "RT" "@MidiaDigitalCOM" ":"
## [4] "#Facebook" "despenca" "como"
## [7] "fonte" "de" "acesso"
## [10] "a" "conteúdo" "jornalistico"
## [13] "#Google" "#games"
##
## text6 :
## [1] "RT" "@MidiaDigitalCOM" ":"
## [4] "#Facebook" "despenca" "como"
## [7] "fonte" "de" "acesso"
## [10] "a" "conteúdo" "jornalistico"
## [13] "#Google" "#games"mytoken <- tokens_remove(mytoken, stopwords('portuguese'))
head(textstat_collocations(mytoken,size = 5, min_count = 5))## collocation count count_nested length
## 1 #web #youtube #apple #macos #ios 5 0 5
## 2 alguns aparelhos anos #apple #polaroid 6 0 5
## 3 serviço autorizado apple #greenfix #apple 23 0 5
## 4 veja alguns aparelhos anos #apple 6 0 5
## 5 #google recebi primeiro selo @localguides 16 0 5
## 6 grupos #facebook marketing online #socialmedia 8 0 5
## lambda z
## 1 5.870513 0.8448463
## 2 5.569991 0.7639838
## 3 5.573926 0.7561767
## 4 5.375423 0.7453455
## 5 5.199295 0.7042822
## 6 4.417491 0.6365540Criando um grafico das relações entre as tags
myrawCorpus <- corpus(twraw)
tweetdfm <- dfm(myrawCorpus, remove_punct = TRUE)
tagdfm <- dfm_select(tweetdfm, ('#*'))
toptag <- names(topfeatures(tagdfm, 50))
head(toptag)## [1] "#facebook" "#google" "#apple" "#amazon" "#microsoft"
## [6] "#emelec"tagfcm <- fcm(tagdfm)
head(tagfcm)## Feature co-occurrence matrix of: 6 by 6 features.
## 6 x 6 sparse Matrix of class "fcm"
## features
## features #amazon #gandalf #facebook #smartphone #portugal #lisboa
## #amazon 0 1 0 0 1 0
## #gandalf 0 0 0 0 0 0
## #facebook 0 0 1 59 1 0
## #smartphone 0 0 0 0 0 0
## #portugal 0 0 0 0 0 2
## #lisboa 0 0 0 0 0 0toptagfcm <- fcm_select(tagfcm, toptag)
textplot_network(toptagfcm, min_freq = 0.1, edge_alpha = 0.8, edge_size = 5)
Criando um grafico das relações de usuários
userdfm <- dfm_select(tweetdfm, ('@*'))
topuser <- names(topfeatures(userdfm, 200))
userfcm <- fcm(userdfm)
userfcm <- fcm_select(userfcm, topuser)
textplot_network(userfcm, min_freq = 0.1, edge_color = 'blue', edge_alpha = 0.8, edge_size = 5)
Criando um DTM com nossas polaridades como dicionario
positivas <- polaridades_pt %>% filter(sentimento == 'positivo') %>% select(word)
negativas <- polaridades_pt %>% filter(sentimento == 'negativo') %>% select(word)
dic <- dictionary(list(positivas=as.character(positivas$word), negativas=as.character(negativas$word)))
bySentimento <- dfm(myCorpus, dictionary = dic)
library(tidytext)
scorebygroup <- tidy(bySentimento %>%
dfm_group(groups='whois') )
scorebygroup## # A tibble: 14 x 3
## document term count
## <chr> <chr> <dbl>
## 1 amazon positivas 84
## 2 apple positivas 213
## 3 facebook positivas 297
## 4 google positivas 170
## 5 linkedin positivas 53
## 6 microsoft positivas 57
## 7 semtag positivas 212
## 8 amazon negativas 148
## 9 apple negativas 284
## 10 facebook negativas 281
## 11 google negativas 226
## 12 linkedin negativas 51
## 13 microsoft negativas 77
## 14 semtag negativas 252library(ggplot2)library(scales)
scorebygroup %>%
ggplot(aes(document, count)) +
geom_point() +
geom_smooth() +
facet_wrap(~ term) +
scale_y_continuous(labels = percent_format()) +
ylab("Frequência por polaridade") +
aes(color = term) + scale_color_manual(values = c("red", "green"))
scorebygroup %>%
ggplot(aes(term, count)) +
geom_bar(stat = 'identity') +
geom_smooth() +
facet_wrap(~ document) +
scale_y_continuous(labels = percent_format()) +
ylab("Frequência por polaridade") +
aes(fill= term,color = term) + scale_color_manual(values = c("red", "green"))
Procurando por frequencia
bySentimento## Document-feature matrix of: 1,865 documents, 2 features (55.5% sparse).CreatePercentile <- function(x) {
x$FreqTotal <- cumsum(x$frequency)
TotalType <- sum(x$frequency)
WordCoverage = NULL
for (i in 1:10) {
WordCoverage <- rbind(WordCoverage, c(max(x$rank[x$FreqTotal <= i/10 *
TotalType]), i/10))
}
Percentile <- c(WordCoverage[, 2])
TextNum <- c(WordCoverage[, 1])
WordCoverage <- data.frame(Percentile, TextNum)
return(WordCoverage)
}
facebookCorpus <- corpus_subset(myCorpus, whois=='facebook')
googleCorpus <- corpus_subset(myCorpus, whois=='google')
microsoftCorpus <- corpus_subset(myCorpus, whois=='microsoft')
#teste <- dfm(myCorpus, dictionary = dic, groups = 'whois')
facedfm <- dfm(facebookCorpus, stem = F)
googledfm <- dfm(googleCorpus, stem = F)
micdfm <- dfm(microsoftCorpus, stem=F)
facefreq <- textstat_frequency(facedfm)
googlefreq <- textstat_frequency(googledfm)
micfreq <- textstat_frequency(micdfm)
facecover <-CreatePercentile(facefreq)
googlecover <-CreatePercentile(googlefreq)
miccover <-CreatePercentile(micfreq)
faceg <- ggplot(facecover, aes(Percentile * 100, TextNum)) + geom_point() +
geom_line() + xlab("Cover") + ylab("# of Text ") + ggtitle("facebook")
googleg <- ggplot(googlecover, aes(Percentile * 100, TextNum)) + geom_point() +
geom_line() + xlab("Cover") + ylab("# of Text ") + ggtitle("google")
micg <- ggplot(miccover, aes(Percentile * 100, TextNum)) + geom_point() +
geom_line() + xlab("Cover") + ylab("# of Text ") + ggtitle("microsoft")
library(grid)
library(gridExtra)
grid.arrange(faceg, googleg, micg, ncol = 3)
Frequência relativa por empresa
gf <- myCorpus %>%
dfm(remove = stopwords("portuguese"), remove_punct = TRUE) %>%
dfm_weight(type = "relfreq")
# Calculando a frequencia relativa pelas empresas de tecnologia
freq_weight <- textstat_frequency(gf, n = 10, groups = "whois")
ggplot(data = freq_weight, aes(x = nrow(freq_weight):1, y = frequency)) +
geom_point() +
facet_wrap(~ group, scales = "free") +
coord_flip() +
scale_x_continuous(breaks = nrow(freq_weight):1,
labels = freq_weight$feature) +
labs(x = NULL, y = "Relative frequency")
Plotando um dendograma com quantide
#data(data_corpus_SOTU, package = "quantedaData")
dendoDfm <- dfm(myCorpus,
stem = TRUE, groups = 'whois', remove_punct = TRUE,
remove = stopwords("portuguese"))
trimDfm <- dfm_trim(dendoDfm, min_count = 5, min_docfreq = 3)
distMat <- textstat_dist(dfm_weight(trimDfm, "relfreq"))
myCluster <- hclust(distMat)
myCluster$labels <- docnames(trimDfm)
# plot as a dendrogram
plot(myCluster, xlab = "", sub = "", main = "Distancia euclidiana na frequencia de tokens normalizada")
Procurando por similaridades
sim <- textstat_simil(myDfm, c("xbox"), method = "cosine", margin = "features")
lapply(as.list(sim), head, 20)## $xbox
## youtubers banco sql mstechsummit linguagem
## 0.9886524 0.9886524 0.9886524 0.9886524 0.9816908
## meetup pokemon up fps outsystems
## 0.9816908 0.9816908 0.9816908 0.9816908 0.9816908
## mesa jornada último milhão atualizações
## 0.9816908 0.9816908 0.9766725 0.9614120 0.9614120
## projeto net one últimas azure
## 0.9593508 0.9557200 0.9504695 0.9445699 0.9390975lista <- lapply(as.list(sim), head, 20)
dotchart(lista$xbox, xlab = "metodo cosine")
Trabalhando com modelos Topicos
library(topicmodels)
quantdfm <- dfm(myCorpus,
remove_punct = TRUE, remove_numbers = TRUE, tolower = T, remove = stopwords("portuguese"))
quantdfm <- dfm_trim(quantdfm, min_count = 10, max_docfreq = 10, verbose = TRUE)
mylda <- LDA(convert(quantdfm, to = "topicmodels"), k = 20)
#str(mylda)
#mylda@documents
head(get_terms(mylda,6))## Topic 1 Topic 2 Topic 3 Topic 4 Topic 5
## [1,] "canal" "pessoa" "alguns" "clientes" "grande"
## [2,] "seguir" "fez" "aplicativos" "chega" "fez"
## [3,] "chegando" "saber" "chega" "chrome" "anúncios"
## [4,] "grande" "h" "h" "chegando" "seguir"
## [5,] "chrome" "chrome" "seguir" "fez" "market"
## [6,] "futebol" "seguir" "botão" "botão" "chrome"
## Topic 6 Topic 7 Topic 8 Topic 9 Topic 10
## [1,] "toda" "cloud" "conhecimento" "saber" "en"
## [2,] "futebol" "chrome" "pessoa" "chegando" "botão"
## [3,] "chrome" "bem" "botão" "chrome" "chrome"
## [4,] "anúncios" "seguir" "fez" "seguir" "chegando"
## [5,] "grande" "chegando" "chega" "autorizado" "seguir"
## [6,] "empreendedorismo" "futebol" "seguir" "grande" "h"
## Topic 11 Topic 12 Topic 13 Topic 14 Topic 15
## [1,] "olha" "termos" "dados" "empreendedorismo" "comigo"
## [2,] "futebol" "autorizado" "en" "autorizado" "h"
## [3,] "chega" "seguir" "chegando" "chega" "chrome"
## [4,] "canal" "h" "chrome" "termos" "seguir"
## [5,] "seguir" "en" "toda" "grande" "aplicativos"
## [6,] "autorizado" "futebol" "seguir" "chrome" "fez"
## Topic 16 Topic 17 Topic 18 Topic 19 Topic 20
## [1,] "macbook" "ebooks" "mac" "timemachine" "bem"
## [2,] "anúncios" "market" "aplicativos" "h" "chrome"
## [3,] "timemachine" "alguns" "chegando" "fez" "chega"
## [4,] "grande" "chrome" "timemachine" "botão" "anúncios"
## [5,] "en" "chegando" "chrome" "aplicativos" "chegando"
## [6,] "aplicativos" "autorizado" "chega" "anúncios" "grande"Analise de Sentimentos
Análise de Sentimentos com Tidy
O tidy é uma ferramenta poderosa para text mining, junto com o dplyer pode-se fazer tudo que vimos antes apenas usando a intuição é claro um bacground em T-SQL ajuda muito, mas o tidy é bem intuitivo #### Mapeando para tokenizar
#salvando o dataframe para não ter discrepancias nos comentários
#twdf %>% write_csv(path='parte2/twittersentimentaldata.csv')
twdf <- read_csv('d://Cursos/PreparacaoCarreiraCientista/R-Bigdata/Projeto1/parte2/twittersentimentaldata.csv')
twdf$id <- rownames(twdf)
tw <- twdf %>% mutate(document = id,word=tweet) %>% select(document,word,whois)
#note que a coluna document carrega a identificação de cada texto
str(tw)## Classes 'tbl_df', 'tbl' and 'data.frame': 1625 obs. of 3 variables:
## $ document: chr "1" "2" "3" "4" ...
## $ word : chr "rt que celebra emelec via facebook" "ganhei pontos e alcancei o nível do por compartilhar meu conhecimento local no google" "apple crisp recipe follow" "meu novo aplicativo para android já disponível na playstore baixem é gratuito google gratis app free go" ...
## $ whois : chr "facebook" "google" "apple" "google" ...tdm <- tw %>% unnest_tokens(word,word) Removendo as stopwords
tdm <- tdm %>% anti_join(data.frame(word= stopwords('portuguese')))
tdm <- tdm %>% anti_join(data.frame(word= stopwors2))
head(tdm)## # A tibble: 6 x 3
## document word whois
## <chr> <chr> <chr>
## 1 1 celebra facebook
## 2 1 emelec facebook
## 3 1 via facebook
## 4 1 facebook facebook
## 5 2 ganhei google
## 6 2 pontos google#tdm <- tdm %>% group_by(document) %>% mutate(word_per_doc = n())
#tdm <- tdm %>% group_by(whois) %>% mutate(word_per_whois = n()) Plotando as primeiras impressões
library(tidyr)
sentJoin <- tdm %>%
inner_join(polaridades_pt, by='word')
sentJoin %>%
count(sentimento) %>%
ggplot(aes(sentimento,n , fill = sentimento)) +
geom_bar(stat = "identity", show.legend = FALSE)
sentJoin %>%
count(whois, index = document, sentimento) %>%
spread(sentimento, n, fill = 0) %>%
mutate(score = positivo - negativo) %>%
ggplot(aes(index, score, fill = whois)) +
geom_bar(stat = "identity", show.legend = FALSE) +
facet_wrap(~whois, ncol = 2, scales = "free_x")
De cara sem fazer nenhuma conta matemática, da pra perceber que os usuários não estão muito satisfeitos com a apple, mas não da pra afirmar nada aqui vamos fazer um ajuste nos dados para plotar a porcentagem
scored <- sentJoin %>%
count(whois,sentimento) %>%
spread(sentimento, n, fill = 0) %>%
mutate(score = positivo -negativo) %>%
mutate(scoreperc = (positivo / (positivo + negativo)) * 100)
ggplot(scored, aes(whois,scoreperc , fill = whois)) +
geom_bar(stat = "identity", show.legend = T) 
Como era esperado realmente o nivel de satisfação da apple usando nosso algoritmo está menor que os outros, os usuários do google e linkedin tiveram as maiores porcentagens de satisfação, apesar de muito pouco dado do linkedin aqui.
Quais são nossos tops sentimentos?
word_counts <- sentJoin %>%
count(word, sentimento, sort = TRUE) %>%
ungroup()
word_counts %>%
filter(n > 5) %>%
mutate(n = ifelse(sentimento == "negativo", -n, n)) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(word, n, fill = sentimento)) +
geom_bar(stat = "identity") +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
ylab("Contribution to sentiment")
E finalmente nossa wordcloud de sentimentos
library(reshape2)
library(wordcloud)
sentJoin %>%
count(word, sentimento, sort = TRUE) %>%
acast(word ~ sentimento, value.var = "n", fill = 0) %>%
comparison.cloud(colors = c("#F8766D", "#00BFC4"),
max.words = 60)
Sentimentos mais negativos
bottom8tw <- head(sentJoin %>%
count(document, sentimento) %>%
spread(sentimento, n, fill = 0) %>%
mutate(score = positivo - negativo) %>%
arrange(score),8)['document']
twdf %>% filter(id %in% as.vector(bottom8tw$document))## # A tibble: 8 x 3
## tweet
## <chr>
## 1 rt como evitar a armadilha de viver em sua própria bolha no facebook
## 2 comprar um iphone vale pena a partir do momento que você tem dinheiro porq
## 3 pior merda que a apple fez foi tirar essa entrada do fone de ouvido dos te
## 4 o bug do milênio será culpa da apple atualização do ios tá fudendo o celul
## 5 quando se trata de redes sociais eu ando morrendo de preguiça de acessar o
## 6 horário reservado para o apocalipse para o facebook liga na rederecord
## 7 horário reservado para o apocalipse para o facebook liga na rederecord
## 8 está aí um relatório irrelevante com um mundo cada vez mais globalizado q
## # ... with 2 more variables: whois <chr>, id <chr>Sentimentos mais Positivos
top8 <- head(sentJoin %>%
count(document, sentimento) %>%
spread(sentimento, n, fill = 0) %>%
mutate(score = positivo - negativo) %>%
arrange(desc(score)),8)['document']
twdf %>% filter(id %in% as.vector(top8$document))## # A tibble: 8 x 3
## tweet
## <chr>
## 1 meu novo aplicativo para android já disponível na playstore baixem é
## 2 meu novo aplicativo para android já disponível na playstore baixem é
## 3 inspiração da criação da canção ousadia e alegria do otaldoaovivo no fa
## 4 facebook messengerkids projetado para ser compatível com a lei de proteção
## 5 o melhor modo de viver em paz é nutrir o amor próprio cute blackmen foll
## 6 o regulamento completo da promoção está disponível no meu site oficial b
## 7 novo aplicativo do google ajuda a economizar o seu g veja como funcion
## 8 buscando atender micro empresas o google meu negócio permite criar um site
## # ... with 2 more variables: whois <chr>, id <chr>Analise de Sentimentos usando Naive Bayes
Em minhas procuras por packages de analise de sentimento , me deparei com a sentR que parece ser bem simples de usar e implementa a classificação Naive Bayes
#devtool::install_github('mananshah99/sentR')
require(sentR)
sentimentToScore <- sample_n(data.frame(text=twdf$tweet),100)
# 2. Aplicando o metodo de classificação Naive Bayes
out <- classify.naivebayes(sentimentToScore$text)
scoredDf <- cbind(sentimentToScore,out, stringsAsFactors=F)
scoredDf$`POS/NEG` <- as.numeric(scoredDf$`POS/NEG`)
s <-head(scoredDf %>% arrange(`POS/NEG`) %>% select(text),10)
#mais negativas segundo o naive bayes
s[,1]## [1] timemachine mac app store já está crackeada apple crack macbook
## [2] facebook shoppíng díscount servíce reaches brítaín market shopping discount britain discount facebook solo ads
## [3] boa galera nos sigam no twitter acessem nosso canal no youtube grupo rizzueto nosso site rizzueto samba
## [4] atenção se és um bot não tires nenhuma selfie está a solicitar a alguns utilizadores que tirem self
## [5] bdasolutions marca presença no mstechsummit novidades microsoft de cloud dataanalytics azure ia
## [6] apple watch greenfix centro de serviço autorizado apple greenfix apple
## [7] a apple vice presidente craig federighi também mais de um vicepresidente
## [8] a briga entre google e amazon ficou ainda mais grave
## [9] vipeer alarmes som insulfilm acessórios automotivo no google
## [10] faz uma semana q deletei a minha conta do facebook e não consigo opinar sobre rsrs
## 1613 Levels: a amazon fez uma seleção de produtos para ajudar a todos que desejam presentear nas festas de final de ano confir ...Mais positivas segundo Naive Bayes
#MAIS POSITIVAS...
s<-head(scoredDf %>% arrange(desc(`POS/NEG`)) %>% select(text),10)
s[,1]## [1] esse facebook ta zuado tenho q baixar foto uma por uma serio q nao tem como selecionar varias ao mesmo tempo
## [2] in love com o doodle de hoje google googledoodle doodle
## [3] querida se ele é meu me manda um exemplar apple iphonex
## [4] comunicado servicio e box mailboxesetcve peoplepossible gift shopping venezuela life comprasporinternet
## [5] teve uma mudança grande no google e pouca gente percebeu
## [6] investigar a causa única é encontrar um ponto pacífico deus como único criador sua inclusiva e amorosa natureza
## [7] saudades do tempo em que a apple fazia bons hardwares de verdade na foto as baterias de um macbook pro retina
## [8] calendar gloriagiacosa info com dm facebook
## [9] link amp help precisa de uma ferramenta que ajude a gerir várias redessociais sugerimos que experimente então o
## [10] atencao prestadores de servico da apple e iphone eu não aguento mais esse wi fi ligando sozinhoooo
## 1613 Levels: a amazon fez uma seleção de produtos para ajudar a todos que desejam presentear nas festas de final de ano confir ...Bonus - O Pacote SentimentAnalysis
O pacote SentimentAnalysis é uma poderosa ferramenta que facilita a análise do sentimento dos conteúdos textuais em R. Esta implementação utiliza vários dicionários existentes, como QDAP, Harvard IV e Loughran-McDonald. Além disso, pode-se criar dicionários personalizados.
library(SentimentAnalysis)
dictionaryPortuguese <- SentimentDictionaryBinary(positivas$word,
negativas$word)
twdf$id <- row.names(twdf)
sentiment <- analyzeSentiment(twdf$tweet,
language="portuguese",
rules=list("PtSentiment"=list(ruleSentiment, dictionaryPortuguese),
"Ratio"=list(ruleSentimentPolarity,dictionaryPortuguese),
"Words"=list(ruleWordCount)))
#sentiment
plotSentiment(sentiment)
sentiment$id <- row.names(sentiment)
worstfeelings <- sentiment[order(sentiment$PtSentiment),][1:10,]
bestfeelings <- sentiment[order(-sentiment$PtSentiment),][1:10,]
##Topdown 10 Ruins
twdf[twdf$id %in% worstfeelings$id,]## # A tibble: 10 x 3
## tweet
## <chr>
## 1 rt como evitar a armadilha de viver em sua própria bolha no facebook
## 2 culpa do facebook compram os apps e os tornam piores
## 3 perfis falsos podem ter sido usados para influenciar eleições brasileiras
## 4 pior merda que a apple fez foi tirar essa entrada do fone de ouvido dos te
## 5 a pesar de todo google
## 6 porque o google discorda de vc
## 7 não se esqueça que vc pode tirar suas dúvidas c os palestrantes no estande
## 8 o bug do milênio será culpa da apple atualização do ios tá fudendo o celul
## 9 uma estória do mundo amazon ebook livro literatura
## 10 como controlar o ódio google
## # ... with 2 more variables: whois <chr>, id <chr>Bem relevante o retorno e olha que não configuramos outras funções do SentimentAnalysis como ruleratio e rulepolarity que aumentaria a eficácia dos resultados.
#top 10
twdf[twdf$id %in% bestfeelings$id,]## # A tibble: 10 x 3
## tweet
## <chr>
## 1 meu novo aplicativo para android já disponível na playstore baixem é
## 2 querida se ele é meu me manda um exemplar apple iphonex
## 3 inspiração da criação da canção ousadia e alegria do otaldoaovivo no fa
## 4 google lança app que libera espaço no android economia chega a gb
## 5 muito bom google lança versão do android para smartphones baratos
## 6 google adiciona novo recurso de segurança ao android
## 7 google lança correção de dezembro para o android
## 8 google amor
## 9 procurando um bom profissional pois eu estou procurando uma boa empresa
## 10 olá amigo são as maravilhas do google precisa de ajuda com o gmail gh
## # ... with 2 more variables: whois <chr>, id <chr>Bonus: Machine Learning com RTextTools
Vou usar os twitters acima e classifica-los como positivos ou negativos até o numero 100, vamos testar a acurácia com vários algoritmos fornecidos pela package RTextTools
## Usando diferentes algoritimos para testar Classificando
library(RTextTools)
library(ptstem)
classificados <- NULL
classificados <- read_csv('d://Cursos/PreparacaoCarreiraCientista/R-Bigdata/Projeto1/parte2/twitterclassificado.csv')
#pegando somente os que eu classifiquei manualmente, afinal..
classificados <- classificados[1:70,]
classificados$class.text[classificados$class.text== -1] <- 0
classificados$whois <- NULL
#renomeando colunas para converter em corpus, assim evitando a perda de acentuação
classificados$doc_id <- row.names(classificados)
classificados <- rename(classificados, text = tweet)
classificados$text <- sapply(classificados$text, function(x) ptstem(x, algorithm = "hunspell", complete = T))
classificados$text <- sapply(classificados$text,enc2native)
corp <- VCorpus(DataframeSource(classificados), readerControl = list(language='pt'))
corp <- tm_map(corp, stripWhitespace)
doc_matrix <- DocumentTermMatrix(corp)
set.seed(1234)
container <- create_container(doc_matrix, classificados$class.text, trainSize=1:55,
testSize=56:70, virgin=FALSE)
#removendo nnet
allalgos <- print_algorithms()## [1] "BAGGING" "BOOSTING" "GLMNET" "MAXENT" "NNET" "RF"
## [7] "SLDA" "SVM" "TREE"algos <- allalgos[! allalgos == 'NNET']
models <- train_models(container, algorithms=algos)
results <- classify_models(container, models)
# mostrando resultados
analytics <- create_analytics(container, results)
summary(analytics)## ENSEMBLE SUMMARY
##
## n-ENSEMBLE COVERAGE n-ENSEMBLE RECALL
## n >= 1 1.00 0.60
## n >= 2 1.00 0.60
## n >= 3 1.00 0.60
## n >= 4 1.00 0.60
## n >= 5 0.87 0.69
## n >= 6 0.73 0.64
## n >= 7 0.60 0.56
## n >= 8 0.40 0.50
##
##
## ALGORITHM PERFORMANCE
##
## SVM_PRECISION SVM_RECALL SVM_FSCORE
## 0.365 0.500 0.420
## SLDA_PRECISION SLDA_RECALL SLDA_FSCORE
## 0.320 0.320 0.320
## LOGITBOOST_PRECISION LOGITBOOST_RECALL LOGITBOOST_FSCORE
## 0.280 0.225 0.250
## BAGGING_PRECISION BAGGING_RECALL BAGGING_FSCORE
## 0.365 0.500 0.420
## FORESTS_PRECISION FORESTS_RECALL FORESTS_FSCORE
## 0.365 0.500 0.420
## GLMNET_PRECISION GLMNET_RECALL GLMNET_FSCORE
## 0.345 0.410 0.375
## TREE_PRECISION TREE_RECALL TREE_FSCORE
## 0.320 0.320 0.320
## MAXENTROPY_PRECISION MAXENTROPY_RECALL MAXENTROPY_FSCORE
## 0.450 0.445 0.445Poderiamos tambêm fazer um cross_validate para testar qual algoritimo usar:
getAccuracy <- function(container, nfold, algoritmos){
c <- 0
d <- data.frame(algoritmo=as.numeric(0), meanAccuracy= as.numeric(0), deviation=as.numeric(0))
for(i in algoritmos){
print(paste('processando: ', i))
ma <- cross_validate(container,nfold,algorithm =i)
if(c == 0) {
d$algoritmo <- i
d$meanAccuracy <- ma$meanAccuracy
d$deviation <- sd(unlist(ma[[1]]))
c <- 1
}else {
d<-rbind(d, data.frame(algoritmo=i, meanAccuracy = ma$meanAccuracy, deviation=sd(unlist(ma[[1]]))))
}
}
return(d)
}
d <- getAccuracy(container,10, algos) ## [1] "processando: BAGGING"
## Fold 1 Out of Sample Accuracy = 0.5
## Fold 2 Out of Sample Accuracy = 0.8888889
## Fold 3 Out of Sample Accuracy = 1
## Fold 4 Out of Sample Accuracy = 0.5
## Fold 5 Out of Sample Accuracy = 1
## Fold 6 Out of Sample Accuracy = 0.5
## Fold 7 Out of Sample Accuracy = 0.6666667
## Fold 8 Out of Sample Accuracy = 0.7142857
## Fold 9 Out of Sample Accuracy = 0.75
## Fold 10 Out of Sample Accuracy = 0.75
## [1] "processando: BOOSTING"
## Fold 1 Out of Sample Accuracy = 1
## Fold 2 Out of Sample Accuracy = 0.75
## Fold 3 Out of Sample Accuracy = 0.8
## Fold 4 Out of Sample Accuracy = 0.4
## Fold 5 Out of Sample Accuracy = 0.625
## Fold 6 Out of Sample Accuracy = 0.5714286
## Fold 7 Out of Sample Accuracy = 0.5
## Fold 8 Out of Sample Accuracy = 0.7272727
## Fold 9 Out of Sample Accuracy = 1
## Fold 10 Out of Sample Accuracy = 0.75
## [1] "processando: GLMNET"
## Fold 1 Out of Sample Accuracy = 7.666667
## Fold 2 Out of Sample Accuracy = 4.375
## Fold 3 Out of Sample Accuracy = 3.1
## Fold 4 Out of Sample Accuracy = 3.3
## Fold 5 Out of Sample Accuracy = 5.111111
## Fold 6 Out of Sample Accuracy = 4.75
## Fold 7 Out of Sample Accuracy = 16
## Fold 8 Out of Sample Accuracy = 5.714286
## Fold 9 Out of Sample Accuracy = 7.5
## Fold 10 Out of Sample Accuracy = 9.2
## [1] "processando: MAXENT"# que temos erros no glmnet..longer object length is not a multiple of shorter object length
d## algoritmo meanAccuracy deviation
## 1 BAGGING 0.72698413 0.19284789
## 2 BOOSTING 0.71237013 0.19617713
## 3 GLMNET 6.67170635 3.82289542
## 4 MAXENT 0.03857143 0.09234904
## 5 RF 0.67825397 0.23819434
## 6 SLDA 0.69607143 0.17103501
## 7 SVM 0.66320346 0.19778437
## 8 TREE 0.59424603 0.29906066Conclusão
Notamos que não existe uma formula mágica para fazer analise de sentimentos em textos, principalmente textos de twitter, os quais as vezes, não fazem praticamente sentido nenhum, nem para humanos, porém conseguimos alcançar algum sucesso usando nosso dicionário lexical de polarides, no proximo artigo vou me aprofundar mais em um metodo que utiliza os pesos dos sentimentos , com os pesos de um classificador Naive Bayes.