A Epimed Solutions é líder no mercado de gestão de informações clínicas, especializada no desenvolvimento de sistemas, e tem como objetivo melhorar a qualidade e a eficiência do atendimento hospitalar. Foi fundada em 2007 por médicos intensivistas com ampla experiência em estudos de risco e prognóstico. Neste artigo, vamos analisar os tweets da empresa, plotar gráficos, frequencias e vamos realizar no final uma analise de sentimento dos textos Essa analise foi baseada no projeto http://www.linguateca.pt/Repositorio/ReLi/ , os dicionários e termos foram baixados pela ferramenta R e salvei o arquivo no diretório
Vamos começar nossa análise, vou carregar o arquivo de sentimentos e logo depois vamos pesquisar pelo o usuario Epimed no twitter
setwd("D:/Cursos/PreparacaoCarreiraCientista/R-Bigdata/Projeto1")
polaridades <- read_csv('parte2/polaridades_pt.csv')
setup_twitter_oauth(consumer_key, consumer_secret, access_token, access_secret);
## [1] "Using direct authentication"
tweets<-userTimeline('Epimed', n=1000)
df <- twListToDF(tweets)
colnames(df)
## [1] "text" "favorited" "favoriteCount" "replyToSN"
## [5] "created" "truncated" "replyToSID" "id"
## [9] "replyToUID" "statusSource" "screenName" "retweetCount"
## [13] "isRetweet" "retweeted" "longitude" "latitude"
O comando ‘colnames’ nos dá uma ideia básica dos dados que o twitter retorna, já sabemos nesse ponto que podemos analisar informações muito uteis como datas, retweets, favorited e por ai vai. vou agora guardar esses dados para que possamos analisar mais tarde
epCorpus <- corpus(df, text_field='text')
Criamos um objeto chamado corpus, que possui os textos dos posts e todas variáveis. Vamos através do corpus criar um Document Feature Matrix o qual extrairemos as tags mais usadas nos tweets
user_dfm <- dfm_select(tweet_dfm, ('@*'))
topuser <- names(topfeatures(user_dfm, 50))
head(topuser,20)
## [1] "@epimed" "@addthis" "@hosp_einstein" "@uolmais"
## [5] "@amib_oficial" "@iqg_online"
A epimed não cita muitos usuários nos seus tweets, mas mesmo assim vamos plotar um grafico para vermos visualmente
user_fcm <- fcm(user_dfm, tri = F)
user_fcm <- fcm_select(user_fcm, topuser)
textplot_network(user_fcm, min_freq = 0.1, edge_color = 'orange', edge_alpha = 0.8, edge_size = 5)
A única relação que notamos foi @hosp_eistein com o próprio usuário @epimed.
Vamos agora analisar as palavras mais usadas nos posts da Epimed Solutions.
removeURL <- function(x) gsub("http[^[:space:]]*", "", x)
dfmwords <- dfm_remove(tweet_dfm, valuetype='regex', pattern='http[^[:space:]]*')
dfmwords <- dfmwords %>% dfm(remove = c(stopwords('portuguese'),'t.co'), remove_punct = TRUE) %>% dfm_trim(verbose = FALSE)
textplot_wordcloud(dfmwords, min.freq = 5, random.order = FALSE,
rot.per = .6,
colors = RColorBrewer::brewer.pal(8,"Dark2"))
### Frequencia dos termos mais usados
allfeats <- textstat_frequency(dfmwords)
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))
Identificando e fazendo um score em multi-expressões, ou colocações adjacentes de tamanho fixo dos textos
col <- textstat_collocations(epCorpus, size = 2:4, min_count = 2)
head(col)
## collocation count count_nested length lambda z
## 1 sistema epimed 36 36 2 5.069100 15.64032
## 2 acesse https 25 1 2 6.458996 14.61587
## 3 veja mais 24 9 2 4.349616 14.01584
## 4 medicina intensiva 11 11 2 6.592212 11.15876
## 5 para o 21 21 2 2.988765 10.81079
## 6 na UTI 12 12 2 3.913067 10.40152
#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))
tokenInfo <- summary(epCorpus)
tokenInfo <- tokenInfo %>%
mutate(month = format(created, "%m"),year =format(created, "%Y")) %>%
group_by(month,year) %>%
arrange(created) %>%
summarise(total = n())
ggplot(data=tokenInfo[1:12,], aes(x =month, y = total, fill=factor(year))) +
geom_line() + geom_bar(stat="identity") + ylab('Posts') + xlab('Mês')
A imagem mostra que depois de junho de 2016 não tivemos mais posts
gg <- ggplot(summary(epCorpus)[1:100,], aes(x = as.Date(yday(created), "1970-01-01"), y = Tokens,
color = factor(year(created))))
gg +geom_line() +
scale_x_date(date_breaks="months", date_labels="%b") +
labs(x="Mês",colour="")
library(maps)
user <- getUser("Epimed")
friends <- user$getFriends()
followers <- user$getFollowers()
followers_df = rbindlist(lapply(followers,as.data.frame))
followers_df<-subset(followers_df, location!="")
#Install key package helpers:
source("https://raw.githubusercontent.com/LucasPuente/geocoding/master/geocode_helpers.R")
#Install modified version of the geocode function
#(that now includes the api_key parameter):
source("https://raw.githubusercontent.com/LucasPuente/geocoding/master/modified_geocode.R")
geocode_apply<-function(x){
geocode(x, source = "google", output = "all", api_key="AIzaSyDLsb3zib53cEwAIOP-0n6RJriZEM4iwL0")
}
geocode_results<-sapply(followers_df$location, geocode_apply, simplify = F)
condition_a <- sapply(geocode_results, function(x) x["status"]=="OK")
geocode_results<-geocode_results[condition_a]
condition_b <- lapply(geocode_results, lapply, length)
condition_b2<-sapply(condition_b, function(x) x["results"]=="1")
geocode_results<-geocode_results[condition_b2]
source("https://raw.githubusercontent.com/LucasPuente/geocoding/master/cleaning_geocoded_results.R")
results_b<-lapply(geocode_results, as.data.frame)
#Then, to simplify things, you should extract out only the columns you need to generate a map of this data.
results_c<-lapply(results_b,function(x) subset(x, select=c("results.formatted_address",
"results.geometry.location")))
results_d<-lapply(results_c,function(x) data.frame(Location=x[1,"results.formatted_address"],
lat=x[1,"results.geometry.location"],
lng=x[2,"results.geometry.location"]))
results_e<-rbindlist(results_d)
results_e$username <- geocode_results$name
results_e$Location <- sapply(results_e$Location, function(x) readr::parse_character(x, locale = readr::locale('pt')))
results_f<-results_e[,Original_Location:=names(results_d)]
require(maps)
require(leaflet)
leaflet() %>%
addTiles() %>%
addCircles(data = results_f, lat = ~ lat, lng = ~ lng, popup = results_f$Location, label=results_f$Original_Location)
##albers_proj<-map("world", proj="albers", param=c(10, 10),
# col="#999999", fill=T, bg=NA, lwd=3, add=FALSE, resolution=1)
#map("world", proj="albers", param=c(10, 10),
# col="#999999", fill=FALSE, bg=NA, lwd=0.2, add=FALSE, resolution=0)
#points(mapproject(results_f$lng, results_f$lat), col=NA, bg="#00000030", pch=21, cex=1.0)
#Add a title:
#mtext("Mapa de seguidores da @Epimed", side = 3, line = -3.5, outer = T, cex=1.5, font=3)
Traçar um objeto kwic produz um gráfico de dispersão lexical que nos permite visualizar as ocorrências de termos particulares ao longo do texto. Nós chamamos essas parcelas de “raios-x” devido à sua semelhança com os dados produzidos pelo recurso de “raio-x” da Amazon para livros de Kindle.
head(kwic(epCorpus, pattern = c('uti') ))
##
## [text5, 16] Dados no Sistema Epimed Monitor | UTI |
## [text9, 1] | UTI |
## [text43, 4] Sistema Epimed Monitor | UTI |
## [text62, 7] de Prevenção da Infecção na | UTI |
## [text70, 12] mortalidade após a alta da | UTI |
## [text77, 4] Sistema Epimed Monitor | UTI |
##
## Adulto. Acesse https:
## Geral do Hospital Samel recebe
## Neonatal e Pediátrica. Acesse
## Acesse http://
## . Leia mais em http
## Neonatal e Pediátrico é utilizado
#epCorpus[epCorpus$documents$texts %like% 'saúde']
head(textstat_readability(epCorpus),1)
## ARI ARI.simple Bormuth Bormuth.GP Coleman Coleman.C2
## text1 11.82789 63.97368 -1.443046 7417869 36.23421 44.78684
## Coleman.Liau Coleman.Liau.grade Coleman.Liau.short Dale.Chall
## text1 23.32312 16.67332 16.67368 -37.555
## Dale.Chall.old Dale.Chall.PSK Danielson.Bryan Danielson.Bryan.2
## text1 19.8977 15.3834 7.131044 65.96006
## Dickes.Steiwer DRP ELF Farr.Jenkins.Paterson Flesch
## text1 -361.1087 244.3046 4 -40.23376 23.53987
## Flesch.PSK Flesch.Kincaid FOG FOG.PSK FOG.NRI FORCAST
## text1 7.875674 12.33605 18.53684 6.181367 0.0675 11.31579
## FORCAST.RGL Fucks Linsear.Write LIW nWS nWS.2 nWS.3
## text1 10.87737 57.5 14 51.60526 12.09287 12.71679 11.61167
## nWS.4 RIX Scrabble SMOG SMOG.C SMOG.simple SMOG.de Spache
## text1 10.93967 4 1.981481 13.81667 13.35291 13.24695 8.246951 10.0085
## Spache.old Strain Traenkle.Bailer Traenkle.Bailer.2 Wheeler.Smith
## text1 10.7785 5.85 -374.7856 -347.6163 40
## meanSentenceLength meanWordSyllables
## text1 9.5 2.052632
s2 <- textstat_simil(dfmwords, c("sepse", "performance"), method = "cosine",
margin = "features")
head(as.matrix(s2), 10)
## sepse performance
## sepse 1.00000000 0.0
## performance 0.00000000 1.0
## curso 0.05913124 0.0
## capacitação 0.00000000 0.4
## gerenciamento 0.00000000 0.0
## eventos 0.00000000 0.0
## adversos 0.00000000 0.0
## segurança 0.00000000 0.0
## paciente 0.00000000 0.0
## acesse 0.05415304 0.0
Outro recurso interessante é que podemos agrupar por assuntos, vou demonstar a ideia agrupando por saúde e hospital, que não é funcional mas mostra que recursos podemos estudar.
myDict <- dictionary(list(hospital = c("uti", "infecção", "hospitalar","enfermagem","pacientes", "neonatais"),
saude = c("saúde", "terapia", "cuidados", "medicina", "qualidade","performance")))
dfmGroup <- epCorpus %>% dfm(remove = c(stopwords('portuguese'),'t.co'), dictionary = myDict,
remove_punct = TRUE) %>% dfm_trim(verbose = FALSE)
head(dfmGroup,20)
## Document-feature matrix of: 20 documents, 2 features (87.5% sparse).
## 20 x 2 sparse Matrix of class "dfm"
## features
## docs hospital saude
## text1 0 0
## text2 0 0
## text3 0 0
## text4 0 0
## text5 1 0
## text6 0 0
## text7 0 0
## text8 0 0
## text9 1 1
## text10 0 0
## text11 0 1
## text12 0 0
## text13 0 0
## text14 0 0
## text15 0 0
## text16 0 1
## text17 0 0
## text18 0 0
## text19 0 0
## text20 0 0
feats <- textstat_frequency(dfmGroup)
feats$feature <- with(feats, reorder(feature, -frequency))
ggplot(feats, aes(x=feature, y=frequency, fill=feature)) + geom_bar(stat="identity") +
xlab("Termos") + ylab("Frequência") + coord_flip() +
theme(axis.text=element_text(size=7))
epidf <- dplyr::tibble(word =df$text, date=df$created, id=rownames(df))
str(epidf)
## Classes 'tbl_df', 'tbl' and 'data.frame': 372 obs. of 3 variables:
## $ word: chr "Curso de Capacitação em Gerenciamento dos Eventos Adversos e Segurança do Paciente. Acesse https://t.co/yoJZWK"| __truncated__ "Confira a programação de cursos pré-congresso do XXI CBMI que acontecerá no mês de novembro. Acesse https://t.co/UWkM4t4Ryn" "Inscrições abertas para Curso de Antimicrobianos da AECIHERJ que acontecerá no RJ. Confira a programação! https"| __truncated__ "Confira a programação da Sessão Científica da SOTIERJ que acontece no próximo dia 31 de maio, no Rio de Janeiro"| __truncated__ ...
## $ date: POSIXct, format: "2016-05-23 19:50:38" "2016-05-20 19:44:40" ...
## $ id : chr "1" "2" "3" "4" ...
epitokens <- epidf %>% unnest_tokens(word,word)
epitokens
## # A tibble: 6,202 x 3
## word date id
## <chr> <dttm> <chr>
## 1 curso 2016-05-23 19:50:38 1
## 2 de 2016-05-23 19:50:38 1
## 3 capacitação 2016-05-23 19:50:38 1
## 4 em 2016-05-23 19:50:38 1
## 5 gerenciamento 2016-05-23 19:50:38 1
## 6 dos 2016-05-23 19:50:38 1
## 7 eventos 2016-05-23 19:50:38 1
## 8 adversos 2016-05-23 19:50:38 1
## 9 e 2016-05-23 19:50:38 1
## 10 segurança 2016-05-23 19:50:38 1
## # ... with 6,192 more rows
Vamos retirar palavras desnecessárias dos textos e manter somente as palavras do dicionário de sentimentos
epitokensclean <- epitokens %>% anti_join(data.frame(word=quanteda::stopwords('portuguese')))
epitokensclean <- epitokens %>% anti_join(data.frame(word=c('t.co','rt','de')))
sentJoin <- epitokensclean %>%
inner_join(polaridades, by='word')
head(sentJoin)
## # A tibble: 6 x 6
## word date id polaridade tipo sentimento
## <chr> <dttm> <chr> <int> <chr> <chr>
## 1 segurança 2016-05-23 19:50:38 1 1 noclass positivo
## 2 paciente 2016-05-23 19:50:38 1 1 noclass positivo
## 3 já 2016-05-16 20:26:37 6 1 noclass positivo
## 4 novo 2016-05-03 17:28:23 10 1 adjetivo positivo
## 5 livre 2016-04-22 17:11:57 13 1 noclass positivo
## 6 paciente 2016-04-13 16:59:45 17 1 noclass positivo
sentJoin %>%
count(sentimento) %>%
ggplot(aes(sentimento,n , fill = sentimento)) +
geom_bar(stat = "identity", show.legend = FALSE)
Quais foram as frequências de palavras positivas e negativas?
sents <- sentJoin %>%
count(word, sentimento, sort = TRUE) %>%
acast(word ~ sentimento, value.var = "n", fill = 0)
comparison.cloud(sents,colors = c("#F8766D", "#00BFC4"),max.words = 100)
bottom10tw <- head(sentJoin %>%
count(id, sentimento) %>%
spread(sentimento, n, fill = 0) %>%
mutate(score = positivo - negativo) %>%
arrange(score),8)['id']
epidf %>% filter(id %in% as.vector(bottom10tw$id))
## # A tibble: 8 x 3
## word
## <chr>
## 1 Prevenção central de linha de corrente sanguínea associadas Infecções. Conf
## 2 Pilotos ensinam médicos a evitar erros usando métodos criados para reduzir
## 3 Hoje é o Dia Mundial do Diabetes. Saiba mais sobre os sintomas e riscos: h
## 4 CITIN acontecerá no próximo fim de semana na sede da AMIB. Saiba mais: http
## 5 #Atualização #Infectologia - Descalonamento antibioticoterapia em pacientes
## 6 "#Pneumonia#VMI#UTI\nPneumonia Asssociada a Ventilação Mecânica ainda é um
## 7 "Leiam na edição : \"Prevalência e desfechos das infecções nas UTIs brasile
## 8 Indicadores Monitorados: taxas e frequência de infecções, sítio de infecção
## # ... with 2 more variables: date <dttm>, id <chr>
toptw <- head(sentJoin %>%
count(id, sentimento) %>%
spread(sentimento, n, fill = 0) %>%
mutate(score = positivo - negativo) %>%
arrange(desc(score)),8)['id']
epidf %>% filter(id %in% as.vector(toptw$id))
## # A tibble: 8 x 3
## word
## <chr>
## 1 Prêmio Epimed, categoria Case sobre Qualidade e Segurança do Paciente. Aces
## 2 #EpimedMonitor #DicaEpimed Tutorial de como realizar o checklist do pacient
## 3 #EpimedMonitor Novo cliente Epimed na região do Grande ABC - São Paulo: Ho
## 4 "#Solidariedade \nCruz Vermelha e Metrô recolhem doações para vítimas das c
## 5 "Fique Atento! \nNovo Telefone Suporte Epimed Monitor \n(21) 3550-5128 ou (
## 6 @iqg_online É uma honra para a Epimed ser parceira do Programa Brasileiro d
## 7 A Epimed lança o NAS – Nursing Activities Score o mais moderno e abrangent
## 8 O curso de gestão e qualidade em UTI realizado no final de semana passado n
## # ... with 2 more variables: date <dttm>, id <chr>
E por último neste artigo vamos analisar o texto com o Algoritmo Naive Bayes( https://en.wikipedia.org/wiki/Naive_Bayes_classifier )
sentimentToScore <- sample_n(data.frame(text=df$text),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] Epimed atingiu a marca de 320 mil pacientes no sistema de UTIs de adultos e 12,6 mil pacientes nos sistemas de UTIs neonatais e pediátricas
## [2] Dica Epimed Monitor: Visualização do tempo entre a decisão da alta e a saída do paciente da unidade disponível nos relatórios tabulares.
## [3] Campanha de Vacinação contra a Gripe não terá nova prorrogação\nLeia em http://t.co/guqLDmtjNB
## [4] Nota Técnica sobre medidas a serem adotadas na assistência a pacientes suspeitos de infecção pelo vírus Ebola. http://t.co/8B0oF1jTAz
## [5] Instituto Latino Americano de Sepse (ILAS) lança livro "Sepse: um problema de saúde pública". Veja mais em http://t.co/POY8Gsvbz5
## [6] #CBMI Data limite para submissão de trabalhos para o CBMI 2013 será dia 13 de julho, fique atento! Acesse: http://t.co/PeQaKO9o9F
## [7] PUC-Rio e CBA firmam parceria para oferecer curso de especialização para profissionais que atuam na área de saúde. http://t.co/tneJzKlEK6
## [8] #AMIB#CURSO#SEPSE Amib abre inscrições para curso de Sepse em parceria com o ILAS, veja mais !!\nhttp://t.co/n5LR61KZ
## [9] CBA abre inscrições para o Curso em Qualidade em Saúde: Gestão e Acreditação. Acesse https://t.co/ehCO3GkmSi https://t.co/FR72TQDZZE
## [10] Melhora mais rápida da qualidade da assistência,em hospitais: http://t.co/Wk38Z1or9Z Para isso, o Epimed faz a monitoração dos indicadores!
## 372 Levels: "Estratégias para a Prevenção de Infecções Relacionadas à\nAssistência à Saúde em Hospitais de Cuidados Agudos" Leia :\nhttp://t.co/0F4fCOzR ...
#MAIS POSITIVAS...
s<-head(scoredDf %>% arrange(desc(`POS/NEG`)),10)
s[,1]
## [1] Hospital Nossa Senhora das Graças promove Seminário de Segurança em Curitiba. A Epimed apoia este evento!! Veja mais: http://t.co/QDkDDx4kfh
## [2] Simpósio "Pensar a UTI" no Rio de Janeiro. Próximo dia 4 de julho no CBA. Veja mais informações : http://t.co/OUEzP5sBl2.
## [3] O uso de escores de gravidade em UTI. Uma revisão sobre as versões mais recentes de SAPS, APACHE e MPM. http://t.co/0yUbEq65Id
## [4] Veja seu trabalho científico no site da Epimed! Conheça esta área destinada a publicações em nosso site. Veja mais: ttp://goo.gl/1ynGRp
## [5] Entrevista com o Futuro Presidente da AMIB: RDC7 e UTI segura: http://www.medcenter.com/Medscape/Login.aspx?langtype=1046
## [6] #SEPSE Reconhecimento tardio aumenta a mortalidade na Sepse. Veja artigo que destaca esta importância. http://t.co/EArSveiV0T
## [7] Artigo sobre "Aumento de casos de infecções causadas por enterobactérias resistentes à carbapenens (ERC)" http://t.co/hgl3xo61WN
## [8] Participe do Prêmio Epimed Solutions de Pesquisa e Gestão da Qualidade em UTI. Últimos dias para inscrição! Acesse: http://t.co/RZdKe81LHY
## [9] A Epimed apoia o projeto Fundamentals for Care, desenvolvido pelo Consórcio Brasileiro de Acreditação. Acesse https://t.co/zvMABZwPiv
## [10] Link- Artigo Qualidade em UTI 2010\nma unidade de terapia intensiva (UTI) como ...\nlildbi.bireme.br/lildbi/docsonline/lilacs/20100300/889.pdf
## 372 Levels: "Estratégias para a Prevenção de Infecções Relacionadas à\nAssistência à Saúde em Hospitais de Cuidados Agudos" Leia :\nhttp://t.co/0F4fCOzR ...
Continuamos com mais analises no proximo artigo…